'
' 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 ===
' ====================
Nessun commento:
Posta un commento