Option Explicit
Sub Main
Dim sRetMsg,sFileZipLoc,sDirEspZip,sFileTxtEstr
Dim sDataLastEstr,IdAnnuale,nEstrTot
sFileZipLoc = GetDirectoryAppData & "temp\estrazioni.zip"
sDirEspZip = GetDirectoryAppData & "temp\"
sFileTxtEstr = sDirEspZip & "storico.txt"
nEstrTot = EstrazioniArchivio
Call EliminaFile(sFileZipLoc)
Call EliminaFile(sFileTxtEstr)
If DownloadFileWget("https://www.lottomatica.it/STORICO_ESTRAZIONI_LOTTO/storico.zip",sFileZipLoc,sRetMsg) Then
If ScompattaFile(sFileZipLoc,sDirEspZip,sFileTxtEstr,sRetMsg) Then
If FileEsistente(sFileTxtEstr)Then
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
IdAnnuale = IndiceAnnuale(nEstrTot)
If AggiornaEstrazioni(sFileTxtEstr,sDataLastEstr,IdAnnuale) Then
Scrivi "Fine aggiornamento lotto"
End If
Else
MsgBox "Il file " & vbCrLf & sFileTxtEstr & vbCrLf & "non è stato trovato , verificare il file zip scaricato" & vbCrLf & sFileZipLoc
End If
Else
MsgBox sRetMsg,vbCritical
End If
Else
MsgBox sRetMsg,vbCritical
End If
End Sub
Function AggiornaEstrazioni(sFileTxtEstr,sDataLastEstr,IdAnnuale)
Dim k,i,e,sData,sDataLetta,sTmp,nEstrTrov,nEstrAgg,sLastDataEstr,idAnn,idRuota,sFileBd,nRigheTot
Dim bErrore
ReDim aRighe(0)
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sLastDataEstr = sDataLastEstr
idAnn = IdAnnuale
Call LeggiRigheFileDiTesto(sFileTxtEstr,aRighe)
nRigheTot = UBound(aRighe)
For k = 0 To nRigheTot
sDataLetta = Mid(aRighe(k),1,10)
ReDim aNumeri(11,5)
If ConvertiData(sDataLetta,sData) Then
If FormattaStringa(sData,"yyyymmdd") > FormattaStringa(sDataLastEstr,"yyyymmdd") Then
If Year(sData) = Year(sLastDataEstr) Then
idAnn = idAnn + 1
Else
idAnn = 1
End If
sLastDataEstr = sData
nEstrTrov = nEstrTrov + 1
i = k
sTmp = Left(aRighe(i),10)
Do While sTmp = sDataLetta
ReDim aValue(0)
Call SplitByChar(aRighe(i),vbTab,aValue)
If UBound(aValue) = 6 Then
idRuota = SiglaRuotatoIdRuota(aValue(1))
If idRuota > 0 And idRuota <= 11 Then
For e = 1 To 5
If IsNumeric(aValue(e + 1)) Then
aNumeri(idRuota,e) = Int(Trim(aValue(e + 1)))
Else
bErrore = True
Exit For
End If
Next
Else
bErrore = True
Exit Do
End If
Else
bErrore = True
Exit Do
End If
If bErrore Then Exit Do
i = i + 1
If i <= nRigheTot Then
sTmp = Left(aRighe(i),10)
Else
Exit Do
End If
Loop
If bErrore Then
MsgBox "Errore formato riga file storico.txt " & vbCrLf & "riga : " & i & vbCrLf & aRighe(i)
Exit For
End If
If VerificaNumeri(aNumeri,sData) = False Then
MsgBox "Errore i numeri dell'estrazione " & sData & " non sono conformi"
Exit For
End If
k = i - 1
If SalvaEstrazione(aNumeri,sData,idAnn,sFileBd) Then
nEstrAgg = nEstrAgg + 1
End If
End If
End If
Call Messaggio("Righe lette :" & k & " Estr aggiornate : " & nEstrAgg)
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(0,UBound(aRighe),k)
Next
If bErrore Then
Call Scrivi("La procedura ha presentato errori nessuna estrazione dopo l'errore è stata aggiunta")
End If
Call Scrivi("Aggiornate : " & nEstrAgg )
AggiornaEstrazioni = Not bErrore
End Function
Function VerificaNumeri(aNumeri,sData)
Dim k,e,sDataNaz,nUpper
sDataNaz = "20050504"
If FormattaStringa(sData,"yyyymmdd") >= sDataNaz Then
nUpper = 11
Else
nUpper = 10
End If
For k = 1 To nUpper
For e = 1 To 5
If aNumeri(k,e) <= 0 Or aNumeri(k,e) > 90 Then
VerificaNumeri = False
Exit Function
End If
Next
Next
VerificaNumeri = True
End Function
Function SiglaRuotatoIdRuota(s)
Dim k
Select Case UCase(s)
Case "BA"
SiglaRuotatoIdRuota = 1
Case "CA"
SiglaRuotatoIdRuota = 2
Case "FI"
SiglaRuotatoIdRuota = 3
Case "GE"
SiglaRuotatoIdRuota = 4
Case "MI"
SiglaRuotatoIdRuota = 5
Case "NA"
SiglaRuotatoIdRuota = 6
Case "PA"
SiglaRuotatoIdRuota = 7
Case "RM"
SiglaRuotatoIdRuota = 8
Case "TO"
SiglaRuotatoIdRuota = 9
Case "VE"
SiglaRuotatoIdRuota = 10
Case "RN"
SiglaRuotatoIdRuota = 11
End Select
End Function
Function ConvertiData(sData,sRetData)
ReDim aV(0)
sRetData = ""
Call SplitByChar(sData,"/",aV)
If UBound(aV) = 2 Then
If Len(aV(0)) = 4 Then
sRetData = aV(2) & "/" & aV(1) & "/" & aV(0)
ConvertiData = IsDate(sRetData)
ElseIf Len(aV(2)) = 4 Then
sRetData = aV(0) & "/" & aV(1) & "/" & aV(2)
ConvertiData = IsDate(sData)
End If
End If
End Function
Function DownloadFileWget(sUrl,sFileLocale,sRetMsg)
Dim sFileBat,sCommand,sPercorsoWget,nTimeoutSec,DataIni
sPercorsoWget = GetDirectoryAppData & "wget.exe"
sCommand = """" & sPercorsoWget & """" & " -O " & """" & sFileLocale & """" & " --no-check-certificate " & sUrl
sFileBat = GetDirectoryAppData & "Download.bat"
nTimeoutSec = 30
sRetMsg = ""
If FileEsistente(sPercorsoWget) Then
Call Messaggio("Download file zip estrazioni")
Call ScriviFile(sFileBat,sCommand,True,False)
Call LanciaFile(sFileBat,True)
DataIni = Now
Do While FileEsistente(sFileLocale) = False
If DateDiff("s",DataIni,Now) > nTimeoutSec Then Exit Do
Loop
If FileEsistente(sFileLocale) Then
sRetMsg = "File scaricato"
DownloadFileWget = True
Else
sRetMsg = "ERRORE ! Il file non è stato scaricato"
End If
Else
sRetMsg = "Il file wget.exe versione 1.19.4 deve essere presente nel percorso " & GetDirectoryAppData
End If
End Function
Function ScompattaFile(sFileZip,sDirDest,sFileTxtEstr,sRetMsg)
On Error Resume Next
Dim FilesInZip,objShell,sDataIni
sRetMsg = ""
Call Messaggio("Scompatta file zip estrazioni")
Set objShell = CreateObject("Shell.Application")
sDataIni = Now
Do While FileEsistente(sFileTxtEstr) = False
If DateDiff("s",sDataIni,Now) > 30 Then Exit Do
Set FilesInZip = objShell.NameSpace(sFileZip).items
objShell.NameSpace(sDirDest).CopyHere(FilesInZip)
Loop
Set FilesInZip = Nothing
Set objShell = Nothing
If Err <> 0 Then
sRetMsg = Err.Description
Err.Clear
Else
ScompattaFile = True
End If
End Function