'Aggiornamento Archivio DAT SuperEnalotto da GitHub o Codeberg (CSV: ID,data,n1-n6,jolly,superstar)
Sub Main
Dim sPercorsoLocale,sFileLocale
sPercorsoLocale = GetDirectoryTemp
CreaDirectory(sPercorsoLocale)
sFileLocale = sPercorsoLocale & "superenalotto_completo.csv"
Call EliminaFile(sFileLocale)
Dim sFileBaseDati : sFileBaseDati = GetDirectoryAppData & "BaseDatiSuperEna.Dat"
Dim eDate,eClock,sPercorsosFileBaseDatiBackup,sFileBaseDatiBackup
Call DateTimeTest(eDate) : Call ClockTimeTest(eClock)
sPercorsosFileBaseDatiBackup = GetDirectoryAppData & "Archivio SuperEnalotto\Backup\dat\"
CreaDirectory(sPercorsosFileBaseDatiBackup)
sFileBaseDatiBackup = sPercorsosFileBaseDatiBackup & "BaseDatiSuperEna.Dat.backup_Del_" & eDate & "_ore_" & eClock & ".bak"
If FileEsistente(sFileBaseDati) Then
Call CopiaFile(sFileBaseDati,sFileBaseDatiBackup)
End If
Dim sUrlCompleto,sScelta
sScelta = InputBox(_
"Scegli la fonte per il download delle estrazioni:" & vbCrLf & vbCrLf & _
"1 = GitHub (predefinito)" & vbCrLf & _
"2 = Codeberg (alternativo)" & vbCrLf & vbCrLf & _
"Inserisci 1 o 2:",_
"Scelta Fonte Download","1")
Select Case Trim(sScelta)
Case "2"
sUrlCompleto = "https://codeberg.org/Lottopython/SUPERENALOTTO-SPAZIOMETRIA/raw/branch/main/SUPERENALOTTO-SPAZIOMETRIA"
Call Messaggio("Scelto download da Codeberg.")
Case Else
sUrlCompleto = "https://raw.githubusercontent.com/L...PAZIOMETRIA/refs/heads/main/superenalotto.txt"
Call Messaggio("Scelto download da GitHub (predefinito).")
End Select
Dim StrMessInfo
StrMessInfo = MsgBox("Ricreare l'intero archivio dal 1997?" & vbCrLf & _
"Verranno eliminate tutte le estrazioni esistenti.",vbQuestion + vbYesNo,"Conferma Ricreazione")
If StrMessInfo = vbNo Then
MsgBox "Operazione annullata dall'utente.",vbInformation
Exit Sub
End If
Call EliminaFile(sFileBaseDati)
If Not DownloadFromWeb(sUrlCompleto,sFileLocale) Then
MsgBox "Errore nel download del file da:" & vbCrLf & sUrlCompleto,vbCritical,"Errore Download"
Exit Sub
End If
If Not FileEsistente(sFileLocale) Then
MsgBox "File temporaneo non trovato dopo il download.",vbCritical
Exit Sub
End If
Dim aRighe,k,sNumEstrTrovate
sNumEstrTrovate = 0
If LeggiRigheFileDiTesto(sFileLocale,aRighe) Then
For k = 0 To UBound(aRighe)
If ScriptInterrotto Then Exit For
Dim sRiga : sRiga = Trim(aRighe(k))
If sRiga <> "" Then
Dim aCampi : ReDim aCampi(0)
Call SplitByChar(sRiga,",",aCampi)
If UBound(aCampi) = 9 Then
Dim sID,sData
sID = Trim(aCampi(0))
sData = Trim(aCampi(1))
If Len(sData) = 10 And Mid(sData,3,1) = "/" And Mid(sData,6,1) = "/" Then
Dim nGiorno,nMese,nAnno
On Error Resume Next
nGiorno = Int(Split(sData,"/")(0))
nMese = Int(Split(sData,"/")(1))
nAnno = Int(Split(sData,"/")(2))
On Error GoTo 0
If nGiorno >= 1 And nGiorno <= 31 And _
nMese >= 1 And nMese <= 12 And _
nAnno >= 1997 And nAnno <= Year(Now) Then
Dim bValida : bValida = True
Dim i
For i = 2 To 9
Dim nValore
nValore = Int(Trim(aCampi(i)))
If nValore < 0 Or nValore > 90 Then
bValida = False
Exit For
End If
Next
If bValida Then
Dim aNumeri
ReDim aNumeri(8)
For i = 1 To 6
aNumeri(i) = Int(Trim(aCampi(i + 1)))
Next
aNumeri(7) = Int(Trim(aCampi(8)))
aNumeri(8) = Int(Trim(aCampi(9)))
Dim nID : nID = 0
On Error Resume Next
nID = CLng(sID)
On Error GoTo 0
Call SalvaEstrazioneSE(aNumeri,sData,nID,sFileBaseDati)
sNumEstrTrovate = sNumEstrTrovate + 1
If(sNumEstrTrovate Mod 500) = 0 Then
Call Messaggio("Estrazioni elaborate: " & sNumEstrTrovate)
End If
End If
End If
End If
End If
End If
Next
End If
Call EliminaFile(sFileLocale)
Call MsgBox("Aggiornamento completato con successo!" & vbCrLf & _
"Estrazioni totali importate: " & sNumEstrTrovate,vbInformation,"ARCHIVIO SUPERENALOTTO")
End Sub
Function DateTimeTest(eDate)
Dim DD,MM,YYYY : DD = Day(Now) : MM = Month(Now) : YYYY = Year(Now)
eDate = YYYY & Right("0" & MM,2) & Right("0" & DD,2)
End Function
Function ClockTimeTest(eClock)
Dim HH,MM,SS : HH = Hour(Now) : MM = Minute(Now) : SS = Second(Now)
eClock = Right("0" & HH,2) & Right("0" & MM,2) & Right("0" & SS,2)
End Function
3718362213
