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

' ====



'