leggi gestione parametri - vbs

'

' gestione di un filme parametri

' ricerca tramite espressione regolare.

' il file parametri ha la struttura di un file xml.

'

option explicit

'

dim strHTML, archivioparametri, jparametri

archivioparametri= "C:\db-parametri.txt"

call leggifileparametri(archivioparametri)

'

jparametri = lavoraparametri(strHTML, "anno", "trova", "")

jparametri = lavoraparametri(strHTML, "anno", "aggiorna", "1999")

jparametri = lavoraparametri(strHTML, "anno", "trova", "1900") ' nel caso non esista

jparametri = lavoraparametri(strHTML, time, "trova", "orario attuale")

'

' ===============

'

function lavoraparametri(sTxt, pnomecampo, pazione, pvaloredefault)

dim oRegex, criterio, retval, agg, nuovovalore

set oRegex = CreateObject("vbscript.regexp")

oRegex.Global = 1

oRegex.Multiline = 1

oRegex.IgnoreCase = 1

'

retval = ""

criterio = "<" & pnomecampo & ">((?:.|\n|\r)*?)</" & pnomecampo & ">"

nuovovalore = "<" & pnomecampo & ">" & pvaloredefault & "</" & pnomecampo & ">"

'

oRegex.Pattern = criterio

If oRegex.Test(sTxt) = true Then

if pazione = "trova" then

retval = oRegex.Execute(sTxt).item(0).SubMatches.item(0)

lavoraparametri = retval

end if

if pazione = "aggiorna" then

agg = oRegex.Replace(strHTML, nuovovalore)

call SovraScriviFile(archivioparametri, agg)

call leggifileparametri(archivioparametri)

end if

else

agg = strHTML & nuovovalore

call SovraScriviFile(archivioparametri, agg)

call leggifileparametri(archivioparametri)

end if

'

'

end function

'

' =========

'

sub leggifileparametri(parchivio)

dim filesys, readfile, jtxt

set filesys = CreateObject ("Scripting.FileSystemObject")



If (filesys.FileExists(parchivio)) Then

'msg = filespec & " esiste."

set readfile = filesys.OpenTextFile(parchivio, 1, false)

strHTML = readfile.ReadAll

Else

'msg = filespec & " Non esiste."

Set readfile = filesys.CreateTextFile(pArchivio, TRUE)

jtxt = "<vuoto>mancano paramenti</vuoto>"

readfile.WriteLine(jtxt)

End If

'

readfile.close

'

end sub

'

' ========= sovra scrive file ===================

'

Sub SovraScriviFile(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

' ==================

'

allinea archivi prima nota legge archivio - vbs

'

option explicit

'

dim cartellabase, cartelladascansionare, a

cartellabase = "C:\azioniprogrammate\archivio_digitale_verifica_esistenza_fatture\"

cartelladascansionare = "C:\ARCHIVIO_DIGITALE_2015\"

'

dim dblog, slog

dblog = cartellabase & "test-report.txt"

'call SovraScriviFile(dblog, " ")

'

dim ArrayOfTerms(), contadati

contadati = 0

'

a = ShowFolderList(cartelladascansionare, "pdf")

'

call ordina

'

' ===

'

Function ShowFolderList(folderspec, ptipo)

Dim fso, f, f1, s, sf, sfiles

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder(folderspec)

Set sf = f.SubFolders

For Each f1 in sf

For Each sfiles in fso.GetFolder(f1.Path).Files

If lcase(fso.GetExtensionName(sfiles.Path)) = lcase(ptipo) then

'slog = sfiles.Path

' call ScriviFileJollyAppend(dblog, slog)

'

's = trim(RicercaRisultato(sfiles.Path, "^\d{4}_"))

s = trim(RicercaRisultato(sfiles.Name, "^\d{4}_"))

if len(s) > 0 then

slog = s & vbcrlf & sfiles.Name ' sfiles.Path

'call ScriviFileJollyAppend(dblog, slog)

'add lines

contadati = contadati + 1

redim preserve ArrayOfTerms(contadati)



ArrayOfTerms(contadati) = sfiles.Name

end if

'

End If

Next

Next

'

'

End Function

'

' ===

'

sub ordina()

dim a, j, temp

for a = UBound(ArrayOfTerms) - 1 To 0 Step -1

for j= 0 to a

if ArrayOfTerms(j)>ArrayOfTerms(j+1) then

temp=ArrayOfTerms(j+1)

ArrayOfTerms(j+1)=ArrayOfTerms(j)

ArrayOfTerms(j)=temp

end if

next

next

'

dblog = cartellabase & "db-fatture-esistenti.txt"

call SovraScriviFile(dblog, " ")

dim nrft

'

'

for a = 1 to UBound(ArrayOfTerms)

slog = ArrayOfTerms(a)

nrft = left(slog, 4)

slog = nrft

call ScriviFileJollyAppend(dblog, slog)

next

'

end sub

'

' ============

'

Function RicercaRisultato(strVal, comecercare) 'As String

Dim sParts, sPart, rPart 'As Object

Set rPart = CreateObject("VBScript.RegExp")

rPart.Global = True

rPart.IgnoreCase = True

rPart.pattern = comecercare '

'get the results

Set sParts = rPart.Execute(strVal)

'get the first match

For Each sPart In sParts

RicercaRisultato = sParts(0)

Exit For

Next 'sPart

Set sParts = Nothing

End Function

'

' === sovra scrive file ===================

'

Sub SovraScriviFile(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

' ==================

'

Sub ScriviFileJollyAppend(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(pNomeArchivio)) Then

'msg = filespec & " esiste."

Set rifefile = fso.OpenTextFile(pNomeArchivio, 8)

Else

'msg = filespec & " Non esiste."

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

End If

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

' =========

'

sistema protocollo fatture acquisto - vbs

'

' vbs - trova il numero di protocollo delle fatture d'acquisto.

' scansiona cartella archivio digitale delle fatture di acquisto.

' le fatture sono i file pdf inviati dai fornitori, il nome del file è quello attribuito da fornitore.

' tramite una espressione regolare trova il numero della fattura di acquisto presente nel nome del file,

' sempre che il fornitore vi inserisca questa informazione.

' il criterio di ricerca è archiviato in un file con il nome della cartella, la manca presenza

' di questo file evita che il programma effettui la ricerca.

' con il numero di fattura si effettua una ricerca nella contabilità aziendale per trovare il numero

' con cui è stato protocollato il documento.

' il conto fornitore è stato trovato da un precedente programma, che convertendo il file pdf

' in testo, ricerca la partita iva del fornitore nella anagrafica aziendale.

'

option explicit

'

dim dbcartella, dbannosql, dbpercorsobase, dbstringasql, dbcartelladascansionare

dim dbjollylog, slog, archiviocontofornitore, esito, a, contofornitore

dim annosql, percorsobase, stringasqlbase, tcriterio, criterioricerca

dim nomefornitore, cartellainlavoro, nomefileinricerca, dbcartellaricerca

Dim filenellacartella, tchiave, tchiavi, risultato, tquantek

Set filenellacartella = CreateObject("Scripting.Dictionary")

filenellacartella.CompareMode = vbTextCompare

' ==========================

dbcartella = "C:\sistema-protocollo\"

dbcartellaricerca = "C:\sistema-protocollo\ricerca\"

dbpercorsobase = dbcartella & "db-percorso-base.txt"

dbannosql = dbcartella & "db-anno-sql.txt"

dbstringasql = dbcartella & "db-stringa-sql.txt"

dbcartelladascansionare = dbcartella & "db-cartelle-da-scansionare.txt"

archiviocontofornitore = "fornitore-conto-anagrafica.txt"

'

dbjollylog = "C:\sistema-protocollo\log-jolly.txt"

' ---

esito = 0

'

' ===============

' carica anno

annosql = leggiparametri(dbannosql)

' ========================

' leggi path base

percorsobase = leggiparametri(dbpercorsobase)

' =======

' leggi stringasqlbase

stringasqlbase = leggiparametri(dbstringasql)

'

if esito = 0 then

esito = 0

call leggielencocartelledascansionare(dbcartelladascansionare)

end if

'

slog = "Terminato: " & Time

call ScriviFileJollyAppend(dbjollylog, slog)

' msgbox "terminato"

'

' =========

'

sub leggielencocartelledascansionare(Pfiledaleggere)

dim objFSO, objFile, strLine

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile(pfiledaleggere, 1)

'

Do While objFile.AtEndOfStream = False

strLine = trim(objFile.ReadLine)

if len(strLine) > 0 then

nomefornitore = strLine

cartellainlavoro = percorsobase & strLine & "\"

'

set filenellacartella = ShowFileListTipo(cartellainlavoro, ".pdf")

'

tchiavi = filenellacartella.Keys

For Each tchiave In tchiavi

tcriterio = "\d{4}_" & trim(nomefornitore) & ".pdf"

risultato = RimouvoCodificati(tchiave, tcriterio)

Next

'

criterioricerca = leggiparametri(dbcartellaricerca & "ricerca-" & nomefornitore & ".txt")

'

tchiavi = filenellacartella.Keys

For Each tchiave In tchiavi

nomefileinricerca = tchiave

risultato = TrovaValore(tchiave, criterioricerca)

risultato = TrovaValore(risultato, "\d+")

if len(risultato) > 0 then

contofornitore = leggiparametri(cartellainlavoro & archiviocontofornitore)

call recuperadatiSQL(risultato)

if len(trim(contofornitore)) = 0 then

slog = cartellainlavoro & vbcrlf & archiviocontofornitore & vbcrlf & "contofornitore: " & contofornitore

call ScriviFileJollyAppend("C:\sistema-protocollo\manca-conto-fornitore.txt", slog)

end if



end if

Next

'

end if

Loop

'

'

end sub

' ========

' === estrae dati dal database ===

' ========

sub recuperadatiSQL(valoredatrovare)

dim SQLConn, conn, adoCmd, stringasql

dim rsj, estratti

dim nrdoc, partita, jnrdoc, lunghezza

' stringa di conn

SQLConn = "DSN=ODBC;DSN=#????#;UID=#????#;Database=#????#"

'

set conn = createobject("ADODB.Connection")

conn.open sqlconn

' time out

Set adoCmd = CreateObject("ADODB.Command")

adoCmd.CommandTimeout = 45

adoCmd.ActiveConnection = conn

'

stringasql = stringasqlbase

stringasql = replace(stringasql, "#contofornitore#", contofornitore)

stringasql = replace(stringasql, "#annoesercizio#", annosql)

stringasql = replace(stringasql, "#numerodacercare#", valoredatrovare)

'

if len(trim(contofornitore)) = 0 then

exit sub

end if

'

set rsj=CreateObject("ADODB.recordset")

rsj.Open stringasql, conn, 3, 3

estratti = rsj.RecordCount

'

if estratti = 1 then

nrdoc = trim(rsj(2).value)

'

jnrdoc = "000000000" & nrdoc

lunghezza = len(valoredatrovare)

jnrdoc = right(jnrdoc, lunghezza)

'

partita = "0000" & trim(rsj(3).value)

partita = right(partita,4)

if nrdoc = valoredatrovare then

call rinominafile(partita)

else

if jnrdoc = valoredatrovare then

call rinominafile(partita)

end if

end if

end if

'

end sub

'

'================

'

Sub rinominafile(nuovonome)

dim FSO, strFile, strRename

Set FSO = CreateObject("Scripting.FileSystemObject")

strFile = cartellainlavoro & nomefileinricerca

strRename = cartellainlavoro & nuovonome & "_" & nomefornitore & ".PDF"

If FSO.FileExists(strFile) Then

If FSO.FileExists(strRename) = False THEN

FSO.MoveFile strFile, strRename

' msgbox strFile & vbcrlf & strRename

slog = "proposta rinomina: " & strFile & " : " & strRename

call ScriviFileJollyAppend("C:\sistema-protocollo\log-proposta-rinomina.txt", slog)

else

slog = "fattura doppia: " & strFile & ":" & strRename

call ScriviFileJollyAppend("C:\sistema-protocollo\log-fatture-doppie.txt", slog)

end if

End If

Set FSO = Nothing

End Sub

'

' ========

'

Function TrovaValore(strVal, comecercare) 'As String

Dim sParts, sPart, rPart 'As Object

Set rPart = CreateObject("VBScript.RegExp")

rPart.Global = True

rPart.IgnoreCase = True

rPart.pattern = comecercare '

'get the results

Set sParts = rPart.Execute(strVal)

'get the first match

For Each sPart In sParts

TrovaValore = sParts(0)

Exit For

Next 'sPart

Set sParts = Nothing

End Function

'

' ========

'

function RimouvoCodificati(strVal, comecercare) 'As String

Dim sParts, sPart, rPart 'As Object

Set rPart = CreateObject("VBScript.RegExp")

rPart.Global = True

rPart.IgnoreCase = True

rPart.pattern = comecercare '

'get the results

Set sParts = rPart.Execute(strVal)

'get the first match

For Each sPart In sParts

risultato = spart

if trim(strval) = trim(spart) then

filenellacartella.Remove(strVal)

end if

Next 'sPart

Set sParts = Nothing

End function

'

' ========================

'

Sub ElencaDizionario(pdizionario)

Dim dizionarioj, chiavi, chiave, quantek

Set dizionarioj = CreateObject("Scripting.Dictionary")

dizionarioj.CompareMode = vbTextCompare

set dizionarioj = pdizionario

chiavi = dizionarioj.Keys

quantek = dizionarioj.count

'

For Each chiave In chiavi

call ScriviFileJollyAppend("C:\sistema-protocollo\a-d3.txt", chiave)

Next

'

End Sub

'

' ====================

'

Function ShowFileListTipo(folderspec, tipofile)

'

Dim fso, f, f1, fc, s, snome, suffisso, tchiavi, tquantek

'

Dim Tfilenellacartella

Set Tfilenellacartella = CreateObject("Scripting.Dictionary")

Tfilenellacartella.CompareMode = vbTextCompare

'

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder(folderspec)

Set fc = f.Files

For Each f1 In fc

snome = f1.Name

'

if len(ucase(snome)) > len(ucase(tipofile)) then

suffisso = right(snome, len(tipofile))

if ucase(suffisso) = ucase(tipofile) then

if ucase(trim(f1.Name)) = trim(ucase("fatturetutte.pdf")) then

else

If Tfilenellacartella.Exists(f1.Name) = False Then

Tfilenellacartella.Add f1.Name, True

End If

end if

end if

end if

Next

'

set ShowFileListTipo = Tfilenellacartella

tchiavi = Tfilenellacartella.Keys

tquantek = Tfilenellacartella.count

'

End Function

'

' ======================

'

function leggiparametri(sFilePathAndName)

dim sFileContents, oFS, oTextStream

Set oFS = CreateObject("Scripting.FileSystemObject")

If oFS.FileExists(sFilePathAndName) = True Then

Set oTextStream = oFS.OpenTextFile(sFilePathAndName,1)

sFileContents = trim(oTextStream.ReadAll)

oTextStream.Close

Set oTextStream = nothing

else

esito = esito + 1

End if

Set oFS = nothing

leggiparametri = sFileContents

'

if len(sFileContents) = 0 then

esito = esito + 1

end if

'

end function

'

' ========================

'

Sub ScriviFileJollyAppend(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(pNomeArchivio)) Then

'msg = filespec & " esiste."

Set rifefile = fso.OpenTextFile(pNomeArchivio, 8)

Else

'msg = filespec & " Non esiste."

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

End If

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

' ====================

' === ===

' ====================================

estrae valori database in base al numero di id - vbs

'

' vbs - estrae valori, utilizzando stringhe sql da un database

' in base al numero di id

'

option explicit

'

dim esito, contenutoletto, numeroreport, dataprecedentereport

' cartella in cui sono contenuti i file con i paramentri e le stringe sql necessarie.

dim dbcartellaprocedura

dbcartellaprocedura = "C:\articoli-nuovi\"

'

dim dblog, slog

dblog = dbcartellaprocedura & "log-lavori.txt"

'

dim stringasql, idarticolo, pFilePathAndName

' data ultimo report - se non esiste utilizza la data odierna

pFilePathAndName = dbcartellaprocedura & "db-data-ultimo-report.txt"

call LeggioCreaFileParametri(pFilePathAndName, date)

dataprecedentereport = contenutoletto

'

' legge la stringa sql e l'id dell'ultimo articolo estratto

'

pFilePathAndName = dbcartellaprocedura & "db-stringa-sql.txt"

stringasql = leggiparametri(pFilePathAndName)

' - legge o crea il numeratore dei report

pFilePathAndName = dbcartellaprocedura & "db-numero-report.txt"

call LeggioCreaFileParametri(pFilePathAndName, 1)

numeroreport = contenutoletto + 1

call SovraScriviFile(pFilePathAndName, numeroreport)

dblog = dbcartellaprocedura & "nuovi-articoli-report-" & numeroreport & ".txt"

'

pFilePathAndName = dbcartellaprocedura & "db-id-articolo.txt"

call LeggioCreaFileParametri(pFilePathAndName, 600000)

idarticolo = leggiparametri(pFilePathAndName)

'

' legge gli articoli dall id

stringasql = replace(stringasql, "#id_articolo#", idarticolo)

call recuperadatiSQL(stringasql)

'

' memorizza ultimo id estratto

'

pFilePathAndName = dbcartellaprocedura & "db-stringa-sql-max-id-articolo.txt"

stringasql = leggiparametri(pFilePathAndName)

stringasql = replace(stringasql, "#id_articolo#", idarticolo)

idarticolo = recuperainfoSQL(stringasql)

'

if len(trim(idarticolo)) > 0 then

pFilePathAndName = dbcartellaprocedura & "db-id-articolo.txt"

call SovraScriviFile(pFilePathAndName, idarticolo)

'

pFilePathAndName = dbcartellaprocedura & "db-data-ultimo-report.txt"

call SovraScriviFile(pFilePathAndName, date)

' === prepara il messaggio da inviare ai destinatari email =============

dim msg

msg = ""

msg = msg & "elenco articoli codificati " & vbcrlf

msg = msg & "dalla data del: " & dataprecedentereport & vbcrlf

msg = msg & "alla data del: " & date & vbcrlf

msg = msg & leggiparametri(dblog)

'

dblog = dbcartellaprocedura & "db-messaggio-corpo.txt"

call SovraScriviFile(dblog, msg)

'

dblog = dbcartellaprocedura & "db-messaggio-oggetto.txt"

slog = "report nuovi articoli numero: " & numeroreport

call SovraScriviFile(dblog, slog)

'

' === invia messaggio clienti

Dim objShell, pattesa, prgvbs

Set objShell = Wscript.CreateObject("WScript.Shell")

'

prgvbs = "C:\articoli-nuovi\invia-messaggii-email-utenti.vbs"

pattesa = objShell.Run(prgvbs, 1, true)

Set objShell = Nothing

'

else

'msgbox "niente da aggiornare"

end if

'

' ==================

'

function recuperainfoSQL(pstringasql)

dim SQLConn, conn, adoCmd, stringasql

dim rsj, estratti, risultati, i

stringasql = pstringasql

' stringa di conn

SQLConn = "DSN=ODBC;DSN=#vostro#database#;UID=#vostra#password#;Database=#vostro#database#"

'

set conn = createobject("ADODB.Connection")

conn.open sqlconn

' time out

Set adoCmd = CreateObject("ADODB.Command")

adoCmd.CommandTimeout = 45

adoCmd.ActiveConnection = conn

'

set rsj=CreateObject("ADODB.recordset")

rsj.Open stringasql, conn, 3, 3

estratti = rsj.RecordCount

'

Do until rsj.Eof

risultati = ""

For i = 0 to RSj.Fields.Count - 1

risultati = rsj(i).Value

Next

slog = risultati

rsj.MoveNext

Loop

'

recuperainfoSQL = risultati

'

end function

' ========

' === estrae dati dal database ===

' ========

sub recuperadatiSQL(pstringasql)

dim SQLConn, conn, adoCmd, stringasql

dim rsj, estratti, risultati, i, nrcampi

stringasql = pstringasql

' stringa di conn

SQLConn = "DSN=ODBC;DSN=#vostro#database#;UID=#vostra#password#;Database=#vostro#database#"

'

set conn = createobject("ADODB.Connection")

conn.open sqlconn

' time out

Set adoCmd = CreateObject("ADODB.Command")

adoCmd.CommandTimeout = 45

adoCmd.ActiveConnection = conn

'

set rsj=CreateObject("ADODB.recordset")

rsj.Open stringasql, conn, 3, 3

estratti = rsj.RecordCount

'

nrcampi = RSj.Fields.Count - 1

'

Do until rsj.Eof

risultati = ""

For i = 0 to RSj.Fields.Count - 1

risultati = risultati & trim(rsj(i).Name) & ":" & vbtab & rsj(i).Value & vbcrlf

Next

slog = risultati

call ScriviFileJollyAppend(dblog, slog)

rsj.MoveNext

Loop

'

'

end sub

'

' =============================

'

function leggiparametri(sFilePathAndName)

dim sFileContents, oFS, oTextStream

Set oFS = CreateObject("Scripting.FileSystemObject")

If oFS.FileExists(sFilePathAndName) = True Then

Set oTextStream = oFS.OpenTextFile(sFilePathAndName,1)

sFileContents = trim(oTextStream.ReadAll)

oTextStream.Close

Set oTextStream = nothing

else

esito = esito + 1

End if

Set oFS = nothing

leggiparametri = sFileContents

'

if len(sFileContents) = 0 then

esito = esito + 1

end if

'

end function

'

' ======================

'

Sub SovraScriviFile(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

' ======================

'

Sub LeggioCreaFileParametri(sFileName, valoredefault)

'

dim objFSO, objFile, strLine

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(sFilename) Then

'esistefile = "si"

Set objFile = objFSO.OpenTextFile(sFileName, 1)

'contenutoletto = objFile.Readall

contenutoletto = objFile.ReadLine

Else

'esistefile = "no"

contenutoletto = valoredefault

Set objFile = objFSO.CreateTextFile(sFileName, TRUE)

objFile.WriteLine(valoredefault)

End If

'

Set objFile = Nothing

Set objFSO = Nothing

'

End sub

'

' ========

'

Sub ScriviFileJollyAppend(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(pNomeArchivio)) Then

'msg = filespec & " esiste."

Set rifefile = fso.OpenTextFile(pNomeArchivio, 8)

Else

'msg = filespec & " Non esiste."

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

End If

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

' ====================

' === fine ===

' ====================

vbs invia messaggii email utenti - vbs

'

' vbs - invia circoloare email

' indirizzi contenuti in un file di testo

option explicit

'

dim dbelencoutenti, toggetto, tcorpo, contenutoletto, dbarchiviomsg, dboggetto

'

Dim EmailValidator : Set EmailValidator = GetEmailValidator() ' per verificare indirizzo email

'

dbelencoutenti="C:\articoli-nuovi\db-email-utenti-da-avvisare.txt"

dbarchiviomsg="C:\articoli-nuovi\db-messaggio-corpo.txt"

dboggetto="C:\articoli-nuovi\db-messaggio-oggetto.txt"



' corpo del messaggio

call leggitutto(dbarchiviomsg)

tcorpo = contenutoletto

' oggetto messaggio

call leggitutto(dboggetto)

toggetto = contenutoletto

' legge elenco indirizzi email

call leggielenco(dbelencoutenti)

' ====

sub leggielenco(filedaleggere)

dim objFSO, objFile, strLine

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile(filedaleggere, 1)

'

Do While objFile.AtEndOfStream = False

strLine = objFile.ReadLine

if EmailValidator.Test(strline) = true then

call invaemail(strLine)

'msgbox strline

end if

Loop

'

objFile.Close

Set objFSO = Nothing

Set objFile = Nothing

'

end sub

' ====

'

sub invaemail(indirizzoemail)

dim objEmail

Set objEmail = CreateObject("CDO.Message")

objEmail.From = "articoli-nuovi@#vostro-dominio#.#suffisso#"

objEmail.To = indirizzoemail

objEmail.Subject = toggetto

objEmail.Textbody = tcorpo

objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' 1

objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = " #vostro#server#di#posta#"

objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objEmail.Configuration.Fields.Update

objEmail.Send

'

end sub

'

'

Function GetEmailValidator()

Set GetEmailValidator = CreateObject("VBScript.RegExp") 'New RegExp

GetEmailValidator.Pattern = "^((?:[A-Z0-9_%+-]+\.?)+)@((?:[A-Z0-9-]+\.)+[A-Z]{2,4})$"

GetEmailValidator.IgnoreCase = True

End Function

'

' =========

sub leggitutto(pfiledaleggere)

'

dim objFSO, objFile

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(pfiledaleggere) Then

'esistefile = "si"

Set objFile = objFSO.OpenTextFile(pfiledaleggere, 1)

contenutoletto = objFile.Readall

objFile.Close

Else

'esistefile = "no"

contenutoletto = ""

End If

Set objFSO = Nothing

'

end sub

' ====



'

copa file a intervalli periodici - vbs

'

Option Explicit

' vbs - copia ad intervalli predefini i file elencati in un file di testo

' fnomearchivio: contiene il path completro dei file da copiare.

' fileultimalettura: contiene la data dell'ultima copia eseguita.

' cartelladovescrivere: il mome della cartella dove copiare i file.

' dopogiorni: in giorni la periodicità della copia

'

dim fileultimalettura, contenutoletto, dataultimocontrollo, dataoggi, differenzagiorni, dopogiorni, fnomearchivio, cartelladovescrivere

fileultimalettura = "C:\installazioni-in-lavorazione\data-ultima-copia.txt"

' solo copia - configurazione

fnomearchivio = "C:\installazioni-in-lavorazione\elenco-file-installazione.txt"

cartelladovescrivere = "C:\cartella-di-sincronizzazione\installazioni-da-distribuire\"

dopogiorni = 7 ' il numero dei giorni di attesa prima di una nuova copia

dataoggi = Now ' data odierna

' = legge il file parametri - se non esiste lo crea con il valore di default passato

Call LeggioCreaFileParametri(fileultimalettura, dataoggi)

'

dataultimocontrollo = contenutoletto

'

differenzagiorni = DateDiff("y", dataultimocontrollo, dataoggi)

if differenzagiorni >= dopogiorni then

'Msgbox "da fare"

call leggielenco(fnomearchivio)

Call ScriviFileJolly(fileultimalettura, dataoggi)

end if

'

' === legge i nomi dei file da copiare ===

sub leggielenco(filedaleggere)

dim objFSO, objFile, strLine, nomearchivio

'

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile(filedaleggere, 1)

'

Do While objFile.AtEndOfStream = False

strLine = trim(objFile.ReadLine)

if len(strLine) > 0 then

nomearchivio = objFSO.GetFileName(strLine)

objFSO.CopyFile strLine, cartelladovescrivere & nomearchivio

end if

'

Loop

'

end sub

' ==== ====

Sub LeggioCreaFileParametri(sFileName, valoredefault)

'

dim objFSO, objFile, strLine

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(sFilename) Then

'esistefile = "si"

Set objFile = objFSO.OpenTextFile(sFileName, 1)

'contenutoletto = objFile.Readall

contenutoletto = objFile.ReadLine

Else

'esistefile = "no"

contenutoletto = valoredefault

Set objFile = objFSO.CreateTextFile(sFileName, TRUE)

objFile.WriteLine(valoredefault)

End If

'

Set objFile = Nothing

Set objFSO = Nothing

'

End sub

' ==== ====

Sub ScriviFileJolly(NomeArchivio, cosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

Set rifefile = fso.CreateTextFile(NomeArchivio, TRUE)

rifefile.WriteLine(cosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

' === ==================

spegni il computer - vbs

'

option explicit

'

'' -s SHUTDOWN (spegne computer)' -r REBOOT (riavvia)' -t (secondi di attesa prima dello spegnimento o del riavvio)



dim objShell

Set objShell = WScript.CreateObject("WScript.Shell")

objShell.run ("shutdown -s -t 0")