Aggiornamento archivio lotto e superenalotto per SPAZIOMETRIA da spazio/web silop

[geronimo]

ciao Joe ,volevo chiederti come mai da qualche tempo il tuo script per aggiornare le estrazioni del lotto non mi funziona più ?


ne uso un altro per aggiornare ma è lunghissimo da copiare, mentre il tuo è bellissimo e corto ...

'Agg_Lotto V.4.2 By Joe *** Archivio LottoPython *** - 06/01/2026 -

'Script per Spaziometria By Joe.

Dim sFileLoc

Dim nEstrTot,sDataLastEstr,k,r

Dim sDataEstr,nNumEstr,nSalvate

Dim b

Dim sFileBd

Dim sLink

Dim Ia,N,sVV,x

Dim CfrData

Dim Vecchio,Nuovo

Dim V

Dim E

Dim S: S = String(4," ")

sLink = "https://raw.githubusercontent.com/Lottopython/exstrazionales/refs/heads/main/Estrazionales lotto.txt"

b = False : N = False

nSalvate = 0

sFileBd = GetDirectoryAppData & "BaseDati.dat"

Scrivi sFileBd,1,,,2 : Scrivi

sFileLoc = GetDirectoryAppData & "ArcTlv\"

Messaggio "Agg_Lotto V.4.2 By Joe *** Archivio LottoPython ***"

If CreaDirectory(sFileLoc) Then

sFileLoc = sFileLoc & "Archivio.txt"

If DownloadFromWeb(sLink,sFileLoc) Then

nEstrTot = EstrazioniArchivio

sDataLastEstr = DataEstrazione(nEstrTot,,,"/")

Vecchio = Right(sDataLastEstr,4)

Ia = IndiceAnnuale(nEstrTot)

ReDim aRighe(0)

Call LeggiRigheFileDiTesto(sFileLoc,aRighe)

For k = 0 To UBound(aRighe) Step 12

AvanzamentoElab 1,UBound(aRighe),k

ReDim aV(0)

If Len(aRighe(k)) = 53 Then

sDataEstr = Left(aRighe(k),2) & "/" & Mid(aRighe(k),4,2) & "/" & Mid(aRighe(k),7,4)

ReDim aEstr(11,5)

For r = 0 To 10

sVV = Right(aRighe(k + r),27)

V = Split(sVV,S) 'Spazio

For x = 0 To 4

aEstr(r + 1,x + 1) = V(x)

Next

Next

Nuovo = Right(sDataEstr,4)

If b Then

If Nuovo <> Vecchio Then Ia = 0 : Vecchio = Nuovo

If sDataEstr <> sDataLastEstr Then

Ia = Ia + 1

nNumEstr = Ia

If nNumEstr > 0 And IsDate(sDataEstr) Then

If CfrData <> sDataEstr Then

If SalvaEstrazione(aEstr,sDataEstr,nNumEstr,sFileBd) Then

CfrData = sDataEstr

nSalvate = nSalvate + 1

End If

Else

ColoreTesto 2

Scrivi "ATTENZIONE " & sDataEstr & " ERRORE NELLE DATE",True

ColoreTesto 0

End If

End If

End If

End If

If sDataEstr = sDataLastEstr Then b = True

Else

Scrivi "Errore nel Download"

End If

Next

If nSalvate > 0 Then AllineaArchivi

Else

Scrivi "Errore nella creazione Dei File Necessari"

End If

Call Scrivi("Aggiornamento Lotto V.4.2 By Joe *** Utilizza Archivio lottoPython ***",1)

Call Scrivi("")

Call Scrivi("Estrazioni trovate in Archivio Remoto " & QuantitaEstrazioniInFile(sFileBd))

Call Scrivi("")

Call Scrivi("Archivio Locale Aggiornato all' Estrazione N° " & IndiceAnnuale(EstrazioniArchivio) & " del " & DataEstrazione(EstrazioneFin,,,"/"))

Call Scrivi("")

Call Scrivi("- Sono state Aggiunte " & nSalvate & " Estrazioni -",1,,,1)

Call Scrivi("")

End If

SI è PER CASO PERSO QUALCHE BITE ? NEL PROMPT DI SPAZIO GIRA MA ALLA FINE DA NESSUNA ESTRAZIONE AGGIUNTA

GRAZIE E BUONA GIORNATA

 

[DjNomade]

Perche credo le le prenda da qui https://raw.githubusercontent.com/Lottopython/exstrazionales/refs/heads/main/Estrazionales lotto.txt

e vedi che non sono aggiornate
Ciauz

 

[joe]

Purtroppo gli script sono molto rigidi nell'interpretare le istruzioni.

C'è una incompatibilità tra come "Windows" considera finita una "linea di programma"

e da come invece la considerano finita altri "sistemi" poi non sempre ci sono dati disponibili ed aggiornati.

Basta appunto un ritardo nel fornire i dati necessari oppure uno "spazio" in più o in meno, un "ritorno a capo"

scritto diversamente e l'aggiornamento smette di funzionare perché "il tutto" non venga convalidato a diventare aggiornamento.

 

[geronimo]

'Aggiornamento Lotto Compatto - Versione Veloce 2026
Dim sFileBd, sLink, xmlHttp, txtData, aRighe, k, r, x, sVV, V, sCData, sData, sSigla
Dim nEstrTot, sDataLastEstr, b, id, z, nSalvate, CfrData, aCampi, c, sDataEstr
Dim aEstr(11,5)

sLink = "https://githubusercontent.com"
sFileBd = GetDirectoryAppData & "BaseDati.dat"
b = False: nSalvate = 0: sCData = ""

On Error Resume Next
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", sLink, False
xmlHttp.Send

If xmlHttp.Status = 200 Then
txtData = Replace(xmlHttp.ResponseText, vbCrLf, vbLf)
aRighe = Split(txtData, vbLf)

If UBound(aRighe) > 0 Then
nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
z = Right(sDataLastEstr,4) & "/" & Mid(sDataLastEstr,4,2) & "/" & Left(sDataLastEstr,2)
id = IndiceAnnuale(nEstrTot)

For k = 0 To UBound(aRighe)
If Trim(aRighe(k)) <> "" Then
aCampi = Split(aRighe(k), vbTab)
If UBound(aCampi) >= 6 Then
sData = Trim(aCampi(0))
sSigla = Trim(aCampi(1))

If sData <> sCData Then
If b And sCData <> "" Then
If Left(sCData,4) <> Left(sData,4) Then id = 0
id = id + 1: sDataEstr = Right(sCData,2) & "/" & Mid(sCData,6,2) & "/" & Left(sCData,4)
If SalvaEstrazione(aEstr, sDataEstr, id, sFileBd) Then nSalvate = nSalvate + 1
End If
If sCData = z Then b = True
ReDim aEstr(11,5): sCData = sData
End If

If sSigla = "BA" Then r = 1 Else If sSigla = "CA" Then r = 2 Else If sSigla = "FI" Then r = 3 _
Else If sSigla = "GE" Then r = 4 Else If sSigla = "MI" Then r = 5 Else If sSigla = "NA" Then r = 6 _
Else If sSigla = "PA" Then r = 7 Else If sSigla = "RM" Then r = 8 Else If sSigla = "TO" Then r = 9 _
Else If sSigla = "VE" Then r = 10 Else If sSigla = "RN" Then r = 11

For c = 1 To 5: aEstr(r,c) = Format2(CInt(Trim(aCampi(c + 1)))): Next
End If
End If
Call AvanzamentoElab(0, UBound(aRighe), k)
Next

If b And sCData <> "" Then
id = id + 1: sDataEstr = Right(sCData,2) & "/" & Mid(sCData,6,2) & "/" & Left(sCData,4)
If SalvaEstrazione(aEstr, sDataEstr, id, sFileBd) Then nSalvate = nSalvate + 1
End If
If nSalvate > 0 Then AllineaArchivi
End If
End If
Set xmlHttp = Nothing

If nSalvate > 0 Then
Call Scrivi("Aggiornamento completato con successo!", 1,, vbBlue)
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni.")
Else
Call Scrivi("Nessuna nuova estrazione trovata. L'archivio è in pari!", 1,, 2)
End If

questa me l'ha riscritta l'IA questa sera vedo se aggiorna ... avendo già aggiornato con un altro script ... però l'ho fatta girare, non l'ha rifiutata e in un amen mi ha detto che l'archivio era aggiornato

 

[geronimo]

certo che chi avrebbe mai pensato che un giovincello di 72 anni avrebbe postato uno script senza capirci un tubo di informatica

 

[joe]

certo che chi avrebbe mai pensato che un giovincello di 72 anni avrebbe postato uno script senza capirci un tubo di informatica

Discorso lungo e difficile da affrontare ...

Si l' IA secondo istruzioni ricevute, depreca alcune procedure sostituendole con alternative più recenti.

Tuttavia esse non sono utilizzabili con le vecchie versioni dei sistemi operativi.

Lo script potrebbe funzionare, ma attualmente non funziona, anche per mancanza di dati disponibili.

Comunque si, è una alternativa valida alle routine cui Spaziometria ci aveva abituato e con le correzioni

che nel tempo (a partire dall'immediato) si renderanno necessarie potrà essere utile.

 

[Alien.]

Ho cancellato una cartella gialla dat. ti metto l'immagine controlla con il tuo vedi se...............riesci a vedere quella cancellata che manca però prima vai ad acquistare la "pazienza" ma credo che non ne hai bisogno.

NO joe non trovato stessa cosa :

 

[geronimo]

'Aggiornamento Lotto Compatto - Versione Veloce 2026
Dim sFileBd, sLink, xmlHttp, txtData, aRighe, k, r, x, sVV, V, sCData, sData, sSigla
Dim nEstrTot, sDataLastEstr, b, id, z, nSalvate, CfrData, aCampi, c, sDataEstr
Dim aEstr(11,5)

sLink = "https://githubusercontent.com"
sFileBd = GetDirectoryAppData & "BaseDati.dat"
b = False: nSalvate = 0: sCData = ""

On Error Resume Next
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", sLink, False
xmlHttp.Send

If xmlHttp.Status = 200 Then
txtData = Replace(xmlHttp.ResponseText, vbCrLf, vbLf)
aRighe = Split(txtData, vbLf)

If UBound(aRighe) > 0 Then
nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
z = Right(sDataLastEstr,4) & "/" & Mid(sDataLastEstr,4,2) & "/" & Left(sDataLastEstr,2)
id = IndiceAnnuale(nEstrTot)

For k = 0 To UBound(aRighe)
If Trim(aRighe(k)) <> "" Then
aCampi = Split(aRighe(k), vbTab)
If UBound(aCampi) >= 6 Then
sData = Trim(aCampi(0))
sSigla = Trim(aCampi(1))

If sData <> sCData Then
If b And sCData <> "" Then
If Left(sCData,4) <> Left(sData,4) Then id = 0
id = id + 1: sDataEstr = Right(sCData,2) & "/" & Mid(sCData,6,2) & "/" & Left(sCData,4)
If SalvaEstrazione(aEstr, sDataEstr, id, sFileBd) Then nSalvate = nSalvate + 1
End If
If sCData = z Then b = True
ReDim aEstr(11,5): sCData = sData
End If

If sSigla = "BA" Then r = 1 Else If sSigla = "CA" Then r = 2 Else If sSigla = "FI" Then r = 3 _
Else If sSigla = "GE" Then r = 4 Else If sSigla = "MI" Then r = 5 Else If sSigla = "NA" Then r = 6 _
Else If sSigla = "PA" Then r = 7 Else If sSigla = "RM" Then r = 8 Else If sSigla = "TO" Then r = 9 _
Else If sSigla = "VE" Then r = 10 Else If sSigla = "RN" Then r = 11

For c = 1 To 5: aEstr(r,c) = Format2(CInt(Trim(aCampi(c + 1)))): Next
End If
End If
Call AvanzamentoElab(0, UBound(aRighe), k)
Next

If b And sCData <> "" Then
id = id + 1: sDataEstr = Right(sCData,2) & "/" & Mid(sCData,6,2) & "/" & Left(sCData,4)
If SalvaEstrazione(aEstr, sDataEstr, id, sFileBd) Then nSalvate = nSalvate + 1
End If
If nSalvate > 0 Then AllineaArchivi
End If
End If
Set xmlHttp = Nothing

If nSalvate > 0 Then
Call Scrivi("Aggiornamento completato con successo!", 1,, vbBlue)
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni.")
Else
Call Scrivi("Nessuna nuova estrazione trovata. L'archivio è in pari!", 1,, 2)
End If

questa me l'ha riscritta l'IA questa sera vedo se aggiorna ... avendo già aggiornato con un altro script ... però l'ho fatta girare, non l'ha rifiutata e in un amen mi ha detto che l'archivio era aggiornato

Vedi l'allegato 2317294

non aggiorna peccato