Modifica script di Joe per aggiornamento estrazioni da www.brightstarlottery.it (se non era già stato fatto) Buon Anno

[Mauro-emme]

Option Explicit
Sub Main
Dim sFileZip, sFileTxt, sFileBd, sLink, sPathArc
Dim nEstrTot, sDataLastEstr, Ia, nSalvate
Dim aRighe, k, sDataEstr, aEstr, r, e, parti, rigaAttuale

' Configurazione percorsi
sLink = "www.brightstarlottery.it"
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sPathArc = GetDirectoryAppData & "ArcTemp\"
sFileZip = sPathArc & "storico.zip"
sFileTxt = sPathArc & "storico01-oggi.txt"

nSalvate = 0
Scrivi "Aggiornamento Archivio Lotto - 31/12/2025", 1

If CreaDirectory(sPathArc) Then
Messaggio "Download in corso..."

' 1. Download Sicuro HTTPS
If DownloadSicuro(sLink, sFileZip) Then

' 2. Estrazione ZIP tramite Windows Shell (universale)
Messaggio "Estrazione in corso..."
If EstraiZip(sFileZip, sPathArc) Then

nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
Ia = IndiceAnnuale(nEstrTot)

ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sFileTxt, aRighe)

' Ciclo a blocchi di 11 righe
For k = 0 To UBound(aRighe) Step 11
If k + 10 <= UBound(aRighe) Then
parti = Split(aRighe(k), vbTab)
If UBound(parti) >= 6 Then
Dim aDataP : aDataP = Split(parti(0), "/")
sDataEstr = aDataP(2) & "/" & aDataP(1) & "/" & aDataP(0)

If DateDiff("d", sDataLastEstr, sDataEstr) > 0 Then
ReDim aEstr(12, 5)

For r = 0 To 10
rigaAttuale = Split(aRighe(k + r), vbTab)
Dim idxRuota : idxRuota = r + 1

' Spostamento Ruota Nazionale (RN è la 9° riga nel file)
If r = 8 Then
idxRuota = 12
ElseIf r > 8 Then
idxRuota = r ' TO=9, VE=10
End If

For e = 1 To 5
aEstr(idxRuota, e) = Int(rigaAttuale(e + 1))
Next
Next

If Right(sDataEstr, 4) <> Right(sDataLastEstr, 4) Then Ia = 1 Else Ia = Ia + 1
If SalvaEstrazione(aEstr, sDataEstr, Ia, sFileBd) Then
nSalvate = nSalvate + 1
sDataLastEstr = sDataEstr
End If
End If
End If
End If
Next

If nSalvate > 0 Then AllineaArchivi
Scrivi "Estrazioni aggiunte con successo: " & nSalvate
Else
MsgBox "Errore nell'estrazione dello ZIP (File non trovato o corrotto)"
End If
Else
MsgBox "Errore nel download del file ZIP"
End If
End If

Scrivi "Estrazioni totali in archivio: " & QuantitaEstrazioniInFile(sFileBd)
End Sub

' Funzione Download per protocolli TLS 1.2/1.3 (2025)
Function DownloadSicuro(Url, Percorso)
On Error Resume Next
Dim Http, Stream
Set Http = CreateObject("MSXML2.XMLHTTP")
Http.Open "GET", Url, False
Http.Send
If Http.Status = 200 Then
Set Stream = CreateObject("ADODB.Stream")
Stream.Open
Stream.Type = 1
Stream.Write Http.ResponseBody
Stream.SaveToFile Percorso, 2
Stream.Close
DownloadSicuro = True
Else
DownloadSicuro = False
End If
End Function

' Funzione Estrazione ZIP universale tramite Shell di Windows
Function EstraiZip(sFileZip, sPathDest)
On Error Resume Next
Dim objShell, objSource, objTarget
Set objShell = CreateObject("Shell.Application")
Set objSource = objShell.NameSpace(sFileZip)
Set objTarget = objShell.NameSpace(sPathDest)

' Estrae tutto il contenuto (16 = rispondi SI a tutto, 4 = non mostrare progress bar)
objTarget.CopyHere objSource.Items, 16

If Err.Number = 0 Then EstraiZip = True Else EstraiZip = False
End Function

 

[giorgio1960]

Mi dice impossibile aprire il file storico.zip come archivio

 

[giorgio1960]

sono riuscito ad aggiornare lo storico da qui https://www.brightstarlottery.it/STORICO_ESTRAZIONI_LOTTO/storico01-oggi.zip
per aggiornare i singoli file adesso?

 

[giorgio1960]

Risolto

 

[Mauro-emme]

Ho scoperto che Spaziometria v. 1.6.54 aggiorna perfettamente i dati! Non serviva fare script. Però ho dovuto disinstallare la vecchia versione e reinstallare quella nuova.