aggiornare superenalotto

[bergie]

fino al 31/07/2026 aggiornavo con questo script,
ora non funziona più,
qualcuno può controllare il motivo.
ringrazio di cuore,
Option Explicit
'Aggiornamento Automatico Archivio DAT SuperEnalotto GNTN
Sub Main
'---------------------------- file temporanei
Dim sPercorsoLocale,sFileLocale0,sFileLocale1
sPercorsoLocale = GetDirectoryTemp & _
"gntn-pgd.it"
CreaDirectory(sPercorsoLocale)
sFileLocale0 = sPercorsoLocale & "0.txt"
sFileLocale1 = sPercorsoLocale & "1.txt"
Call EliminaFile(sFileLocale0)
Call EliminaFile(sFileLocale1)
'--------------------------------- file archivio estrazioni
Dim sFileBaseDati : sFileBaseDati = GetDirectoryAppData & _
"BaseDatiSuperEna.Dat"
'---------------------------------------------------- backup file
Dim eDate,eClock,sPercorsosFileBaseDatiBackup,sFileBaseDatiBackup
Call DateTimeTest(eDate) : Call ClockTimeTest(eClock)
sPercorsosFileBaseDatiBackup = GetDirectoryAppData & _
"Archivio SuperEnalotto\Backup\dat\"
sFileBaseDatiBackup = sPercorsosFileBaseDatiBackup & _
"gntn-pgd.it BaseDatiSuperEna.Dat" & ".backup_Del_" & _
eDate & "_ore_" & eClock & ".bak"
Call CopiaFile(sFileBaseDati,sFileBaseDatiBackup)
'- messaggio avvertenze
Dim StrMessInfo
StrMessInfo = MsgBox("Ricreare i file daccapo ?",vbQuestion + vbYesNo)
If StrMessInfo = vbNo Then
If FileEsistente(sFileBaseDati) Then
Dim nAnnoPartenza,nMesePartenza,nGiornoPartenza
Dim sTemp,idUltimaEstr,aNumUltimaEstr,sDataUltimaEstr
sTemp = GetInfoEstrazioneSE(EstrazioniArchivioSE)
' scrive il risultato una variabile temporanea
' leggo i dati contenuti nella variabile e li separo con split
ReDim AV(00) : Call SplitByChar(sTemp," ",AV)
' ora so che il primo elemento dell'array è l'id estrazione
' il secondo elemento è il numero estrazione
' il terzo elemento è la data
' so pure che gli array iniziano da 0
' percio vado a memorizzare i singoli valori nelle apposite variabili
' ricordando che dobbiamo normalizzarli
' togliendo parentesi quadre e sostituendo il . con /
' levo le parentesi quadre dall' id estrazione
' contenuto nell'elemento 0 dell'array aV()
AV(00) = Replace(AV(00),"[","") : AV(00) = Replace(AV(00),"]","")
' levo le parentesi quadre dal numero estrazione
' contenuto nell'elemento 1 dell'array aV()
AV(01) = Replace(AV(01),"[","") : AV(01) = Replace(AV(01),"]","")
' sostituisco il punto con slash nell'elemento 2 dell'array aV()
AV(02) = Replace(AV(02),".","/")
' ora siamo pronti per memorizzare i dati nelle variabili
aNumUltimaEstr = AV(00)' Id ultima estrazione
idUltimaEstr = IndiceAnnualeSE(EstrazioniArchivioSE)
' numero ultima estrazione
sDataUltimaEstr = AV(02)' data ultima estrazione
ReDim AV00(00) : Call SplitByChar(AV(02),"/",AV00)
Dim nGiornoUltimaEstr,nMeseUltimaEstr,nAnnoUltimaEstr,sDataPartenza
nGiornoPartenza = Int(AV00(00))' giorno ultima estrazione
nMesePartenza = Int(AV00(01))' mese ultima estrazione
nAnnoPartenza = Int(AV00(02))' anno ultima estrazione
sDataPartenza = nAnnoPartenza & "/" & nMesePartenza & "/" & nGiornoPartenza
End If
ElseIf StrMessInfo = vbYes Then
If CopiaFile(sFileBaseDati,sFileBaseDatiBackup) Then
Call EliminaFile(sFileBaseDati)
End If
'inizio estrazioni 01/01/2009
nGiornoPartenza = 01
nMesePartenza = 01
nAnnoPartenza = 2009
sDataPartenza = nGiornoPartenza & "/" & nMesePartenza & "/" & nAnnoPartenza
End If
'---------------------------------
Dim sDataNuova : sDataNuova = Date
Dim sNumEstrTrovate : sNumEstrTrovate = 00
'--------------------------------------------------------------------------------------------------------------
Dim sUrl : sUrl = "https://www.gntn-pgd.it/gntn-info-web/rest/gioco/superenalotto/estrazioni/archivioconcorso/"
Do While FormattaStringa(sDataPartenza,"yyyymmdd") <= FormattaStringa(sDataNuova,"yyyymmdd")
'----------------------------------------------------------------------------------------
If ScriptInterrotto Then Exit Do
'-------------------------------------------------------------------
Dim sData : sData = Year(sDataPartenza) & "/" & Month(sDataPartenza)
Dim sLink : sLink = sUrl & sData & "?idPartner=GIOCHINUMERICI_INFO"
'-----------------------
ReDim aRighe(00) : Dim k
'----------------------------- sFileLocale0
If DownloadFromWeb(sLink,sFileLocale0) Then
If FileEsistente(sFileLocale0) Then
If LeggiRigheFileDiTesto(sFileLocale0,aRighe)Then
If EliminaFile(sFileLocale0) Then
For k = 00 To UBound(aRighe)
If aRighe(k) <> "" Then
aRighe(k) = Replace(aRighe(k),vbTab,"")
aRighe(k) = Replace(aRighe(k),vbCrLf,"")
aRighe(k) = Replace(aRighe(k),vbCr,"")
aRighe(k) = Replace(aRighe(k),vbLf,"")
'
aRighe(k) = Replace(aRighe(k),"{""concorsi"":[","")
aRighe(k) = Replace(aRighe(k),"concorso"":{""numero","concorsonumero")
aRighe(k) = Replace(aRighe(k),",""dettaglioDisponibile"":1},",vbCrLf)
'
aRighe(k) = Replace(aRighe(k),"{""","")
aRighe(k) = Replace(aRighe(k),""":""",vbCrLf)
aRighe(k) = Replace(aRighe(k),""",""",vbCrLf)
aRighe(k) = Replace(aRighe(k),"""},""",vbCrLf)
aRighe(k) = Replace(aRighe(k),",""",vbCrLf)
aRighe(k) = Replace(aRighe(k),""":",vbCrLf)
aRighe(k) = Replace(aRighe(k),"[""","")
aRighe(k) = Replace(aRighe(k),"""]","")
aRighe(k) = Replace(aRighe(k),"""}","")
Dim sOut : sOut = aRighe(k)
'Call Scrivi(sOut)
Call ScriviFile(sFileLocale1,sOut,False,True)
End If
Next
Call CloseFileHandle(sFileLocale1)
End If
End If
Else
Call MsgBox("file non esiste"):Exit Sub
End If
Else
Call MsgBox("link non esiste"):Exit Sub
End If
'-------------
' sFileLocale1
If FileEsistente(sFileLocale1) Then
If LeggiRigheFileDiTesto(sFileLocale1,aRighe) Then
If EliminaFile(sFileLocale1) Then
For k = 00 To UBound(aRighe)
'------------------------------------------ concorsonumero
If InStr(01,aRighe(k),"concorsonumero",vbTextCompare) Then
Dim nRetNumEstr
If IsNumeric(Trim(aRighe(k + 01))) Then
nRetNumEstr = Int(Trim(aRighe(k + 01)))
End If
nRetNumEstr = FormattaStringa(nRetNumEstr,"000")
'------------------------------------------- dataEstrazione
ElseIf InStr(01,aRighe(k),"dataEstrazione",vbTextCompare) Then
Dim sRetData
If IsNumeric(Trim(aRighe(k + 01))) Then
sRetData = Int(Trim(aRighe(k + 01)))
End If
'-----------
Dim sNewData
Call ConverteDataFromUnix(sNewData,sRetData)
sRetData = FormattaStringa(sNewData,"dd/mm/yyyy")
'------------------------------------------- estratti
ElseIf InStr(01,aRighe(k),"estratti",vbTextCompare) Then
Dim i,j : i = 00
ReDim aRetNumVinc(08)
For j = k + 01 To UBound(aRighe)
If IsNumeric(Trim(aRighe(j))) Then
i = i + 01
aRetNumVinc(i) = Int(Trim(aRighe(j)))
Else
If InStr(01,aRighe(j),"numeroJolly",vbTextCompare) Then
Exit For
End If
End If
Next
'------------------------------------------- numeroJolly
ElseIf InStr(01,aRighe(k),"numeroJolly",vbTextCompare) Then
ReDim aRetNumJolly(01)
For j = k + 01 To UBound(aRighe)
If IsNumeric(Trim(aRighe(j))) Then
aRetNumVinc(07) = Int(Trim(aRighe(j)))
Else
If InStr(01,aRighe(j),"superstar",vbTextCompare) Then
Exit For
End If
End If
Next
'------------------------------------------- superstar
ElseIf InStr(01,aRighe(k),"superstar",vbTextCompare) Then
ReDim aRetNumSuperStar(01)
For j = k + 01 To UBound(aRighe)
If IsNumeric(Trim(aRighe(j))) Then
aRetNumVinc(08) = Int(Trim(aRighe(j)))
Else
If InStr(01,aRighe(j),"concorsonumero",vbTextCompare) Then
Exit For
End If
End If
Next
ReDim Preserve aRetNumVinc(08)
'------ data aggiornamento ------------------------------------------------------------
If FormattaStringa(sRetData,"yyyymmdd") > FormattaStringa(sDataPartenza,"yyyymmdd") Then
'--------------------------------------------
sOut = nRetNumEstr & ";" & sRetData & ";" & _
StringaNumeri(aRetNumVinc,";",True)
'--------------- coerenza dati
If IsNumeric(nRetNumEstr) Then
If IsDate(sRetData) Then
If UBound(aRetNumVinc) = 08 Then
sNumEstrTrovate = sNumEstrTrovate + 01
Call Scrivi(sOut)
Call SalvaEstrazioneSE(aRetNumVinc,sRetData,nRetNumEstr,sFileBaseDati)
End If
End If
End If
'- coerenza dati
Else
If InStr(01,aRighe(k),"dettaglioDisponibile",vbTextCompare) Then
Exit For
End If
End If
'------ data aggiornamento
End If
'-------------------
Next
End If
End If
End If
'-------------------------------
If ScriptInterrotto Then Exit Do
Call Messaggio("Conversione file in corso .." & sData & _
" [ " & FormatSpace(nRetNumEstr,000) & _
" ] [ " & sNumEstrTrovate & " ] ")
Call AvanzamentoElab(nAnnoPartenza,Year(Date),Year(sData))
sDataPartenza = DateAdd("m",01,sDataPartenza)
'--------------------------------------------
Loop
'----------------------------- controllo se la nuova data e' uguale o inferiore
If FormattaStringa(sRetData,"yyyymmdd") <= FormattaStringa(Now,"yyyymmdd") Then
Call MsgBox("Aggiornamento archivio completato - Estrazioni aggiunte : " & _
sNumEstrTrovate,vbYes,"AGGIORNAMENTO ARCHIVIO")
End If
'-----
End Sub
Function ConverteDataFromUnix(DateFromUnix,UnixDate)
DateFromUnix = DateAdd("s",UnixDate / 1000,"1/1/1970")
End Function
Function DateTimeTest(eDate)
Dim DD,MM,YYYY : DD = Day(Now) : MM = Month(Now) : YYYY = Year(Now)
eDate = YYYY & "/" & MM & "/" & DD
eDate = FormattaStringa(eDate,"yyyymmdd")
End Function
Function ClockTimeTest(eClock)
Dim HH,MM,SS : HH = Hour(Now) : MM = Minute(Now) : SS = Second(Now)
eClock = Format2(HH) & ":" & Format2(MM) & ":" & Format2(SS)
eClock = FormattaStringa(eClock,"hhmmss")
End Function