Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
BaseDat.dat
- Creatore Discussione joe
- Data di inizio
joe
Advanced Member >PLATINUM PLUS<
Ciao a Tutti Joe, [B][SIZE=4]Reacher[/SIZE][/B] e a tutto il gruppo
DOMANDA: cosa succede al SITO LOTTOLOGIA? Non si riesce a scaricare più le estrazioni --(non risultano nuove estrazioni... la RISPOSTA) , scusa JOE ..ma cosa vuol dire Stando così le cose, con Lottologia non funzionerà mai più?
Semplificando, utilizziamo dei programmi che ci permettono di leggere i contenuti delle pagine web.
Però il contenuto di queste pagine può essere più o meno complesso.
Può variare dall'essere, un semplice testo ad un messaggio criptato.
In sintesi hanno reso illeggibile ed inutilizzabile l'archivio.
Quale è la loro strategia ? Per quali motivi cambiano sempre ? Anche Lottomatica fa la stessa cosa .Semplificando, utilizziamo dei programmi che ci permettono di leggere i contenuti delle pagine web.
Però il contenuto di queste pagine può essere più o meno complesso.
Può variare dall'essere, un semplice testo ad un messaggio criptato.
In sintesi hanno reso illeggibile ed inutilizzabile l'archivio.
joe
Advanced Member >PLATINUM PLUS<
druid
Super Member >PLATINUM<
Non mi riferisco al lotto, ma in generale ai siti dei giochi/pronostici. Principalmente perche' lo scraping dei dati e' vietato, e poi ci sono siti che ti fanno vedere la pubblicita', ma se non ci vai "fisicamente", la pubblicita' non la vedi.
joe
Advanced Member >PLATINUM PLUS<
E' tuttavia intuitivo realizzare, che un sito inutile, perde il suo utile pubblicitario.
Questo invece, per esempio, tra una storia e l'altra, esiste e resiste.
Questo script funziona
Discussione 'Aggiorna Archivio Spaziometria' https://forum.lottoced.com/threads/aggiorna-archivio-spaziometria.2227336/
Discussione 'Aggiorna Archivio Spaziometria' https://forum.lottoced.com/threads/aggiorna-archivio-spaziometria.2227336/
joe
Advanced Member >PLATINUM PLUS<
Lo script che l'amico Ramco, in questa ultima versione, ha adattato, al nuovo sito, funziona bene.
Lo ha anche, ripulito, commentato, migliorato.
Dunque fintanto che non ci saranno nuovi intoppi consiglio di usare questo script.
Molti degli altri script e metodi di aggiornamento, a catena, purtroppo sono diventati inutilizzabili.
joe
Advanced Member >PLATINUM PLUS<
Buona Domenica a tutte/i.
Qui al messaggio #8 ho inserito il nuovo script per aggiornare il Lotto dall' Archivio fatto da LottoPython.
Al primo messaggio ho inserito invece una copia del file BaseDati.txt da rinominare in BaseDati.dat
e da trasferire nella DirectoryDati di Spaziometria.
Qui al messaggio #8 ho inserito il nuovo script per aggiornare il Lotto dall' Archivio fatto da LottoPython.
Al primo messaggio ho inserito invece una copia del file BaseDati.txt da rinominare in BaseDati.dat
e da trasferire nella DirectoryDati di Spaziometria.
joe
Advanced Member >PLATINUM PLUS<
Io avevo provato la versione SPAZIO40.exe.
Non sono a conoscenza di versioni successive.
Hai la possibilità di usare AniDesk ?
DATA
Member
dopo che mi sono stufato di avere errori nell ultimo mese, ho fatto questo
parte da 4 maggio 2005,
prende lo storico originale lo scompatta e errori non dovrebbero esserci dato che e' della lotto italia archivi.
se lo usate buttate via il .dat, aprite spazio e lanciate il listato , spero che a qualcuno serva....
ciao
--
'Aggiorna archivio lotto di Spaziometria versione corretta per archivio vuoto
'Estrazioni prelevate direttamente dalla fonte Lottomatica
Option Explicit
Sub Main()
Dim sDirTemp,sDirZip,sDestDir
Dim sLink,sFileBd
Dim sCmd
Dim sDataUltima,sDataUltimaISO
Dim sDataCorrente,sDataEstr,sNuovaData,sSigla
Dim nEstrTot,nSalvate
Dim nIdUltimo,nIdDaSalvare
Dim sAnnoUltimoSalvato
Dim bSalvaDaSubito,bTrovataUltimaData,bArchivioVuoto
Dim aRighe,aCampi
Dim aEstr,aRuotePresenti
Dim k,r,c
Dim oShell,oFSO
'========================
' Percorsi file
'========================
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sDirZip = GetDirectoryTemp & "storico.zip"
sDirTemp = GetDirectoryTemp & "storico.txt"
'========================
' Pulizia file temporanei
'========================
Call EliminaFile(sDirZip)
Call EliminaFile(sDirTemp)
'========================
' Download archivio ufficiale
'========================
sLink = "https://www.brightstarlottery.it/STORICO_ESTRAZIONI_LOTTO/storico.zip"
Call Messaggio("Download archivio ufficiale in corso...")
If Not DownloadFromWeb(sLink,sDirZip) Then
Call Scrivi("ERRORE: impossibile scaricare il file zip dal sito LottoItalia.",True,,,vbRed)
Exit Sub
End If
'========================
' Decompressione zip -> storico.txt
'========================
Call Messaggio("Decompressione archivio...")
sDestDir = GetDirectoryTemp
If Right(sDestDir,1) = "\" Then
sDestDir = Left(sDestDir,Len(sDestDir) - 1)
End If
sCmd = "powershell -NoProfile -Command ""Expand-Archive -Force -LiteralPath '" & sDirZip & "' -DestinationPath '" & sDestDir & "'"""
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
oShell.Run sCmd,0,True
If Not oFSO.FileExists(sDirTemp) Then
Call Scrivi("ERRORE: il file storico.txt non è stato trovato dopo la decompressione.",True,,,vbRed)
Call Scrivi("Verificare che PowerShell sia disponibile e che lo zip contenga 'storico.txt'.",True)
Set oShell = Nothing
Set oFSO = Nothing
Exit Sub
End If
Set oShell = Nothing
Set oFSO = Nothing
'========================
' Lettura righe file testo
'========================
ReDim aRighe(0)
If Not LeggiRigheFileDiTesto(sDirTemp,aRighe) Then
Call Scrivi("ERRORE: impossibile leggere storico.txt.",True,,,vbRed)
Exit Sub
End If
Call EliminaFile(sDirZip)
Call EliminaFile(sDirTemp)
'========================
' Stato archivio corrente
'========================
nEstrTot = EstrazioniArchivio
If nEstrTot <= 0 Then
' Archivio vuoto: salviamo tutto dall'inizio
bArchivioVuoto = True
bSalvaDaSubito = True
bTrovataUltimaData = True
sDataUltima = ""
sDataUltimaISO = ""
nIdUltimo = 0
sAnnoUltimoSalvato = ""
Else
' Archivio esistente: salviamo solo da dopo l'ultima data presente
bArchivioVuoto = False
bSalvaDaSubito = False
bTrovataUltimaData = False
sDataUltima = DataEstrazione(nEstrTot,,,"/") ' GG/MM/AAAA
sDataUltimaISO = Right(sDataUltima,4) & "/" & Mid(sDataUltima,4,2) & "/" & Left(sDataUltima,2) ' AAAA/MM/GG
nIdUltimo = IndiceAnnuale(nEstrTot)
sAnnoUltimoSalvato = Left(sDataUltimaISO,4)
End If
'========================
' Inizializzazione buffer estrazione
'========================
ReDim aEstr(11,5)
ReDim aRuotePresenti(11)
sDataCorrente = ""
'========================
' Formato atteso righe:
' AAAA/MM/GG [TAB] SIGLA [TAB] N1 [TAB] N2 [TAB] N3 [TAB] N4 [TAB] N5
'
' Ordine sigle nel file sorgente:
' BA CA FI GE MI NA PA RM RN TO VE
'
' Ordine ruote Spaziometria:
' 1 BA
' 2 CA
' 3 FI
' 4 GE
' 5 MI
' 6 NA
' 7 PA
' 8 RO
' 9 TO
' 10 VE
' 11 NZ
'========================
For k = 0 To UBound(aRighe)
If ScriptInterrotto Then Exit For
If Trim(aRighe(k)) <> "" Then
aCampi = Split(aRighe(k),vbTab)
If UBound(aCampi) >= 6 Then
sNuovaData = Trim(aCampi(0)) ' AAAA/MM/GG
sSigla = UCase(Trim(aCampi(1)))
'---------------------------------
' Se cambia la data, prima salvo
' l'estrazione precedente
'---------------------------------
If sNuovaData <> sDataCorrente Then
If sDataCorrente <> "" Then
' Se siamo già entrati in modalità salvataggio,
' salvo l'estrazione precedente
If bSalvaDaSubito Then
If EstrazioneCompleta(aRuotePresenti,aEstr) Then
nIdDaSalvare = ProssimoIndiceAnnuale(sAnnoUltimoSalvato,sDataCorrente,nIdUltimo)
sDataEstr = Right(sDataCorrente,2) & "/" & Mid(sDataCorrente,6,2) & "/" & Left(sDataCorrente,4)
If SalvaEstrazione(aEstr,sDataEstr,nIdDaSalvare,sFileBd) Then
nSalvate = nSalvate + 1
nIdUltimo = nIdDaSalvare
sAnnoUltimoSalvato = Left(sDataCorrente,4)
Call Messaggio(nSalvate)
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: errore salvataggio estrazione " & sDataCorrente,True)
ColoreTesto 0
End If
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: estrazione incompleta ignorata in data " & sDataCorrente,True)
ColoreTesto 0
End If
End If
' Se l'estrazione appena chiusa è l'ultima già presente
' nell'archivio, da quella successiva in poi si salva
If(Not bSalvaDaSubito) Then
If sDataCorrente = sDataUltimaISO Then
bSalvaDaSubito = True
bTrovataUltimaData = True
End If
End If
End If
' Reset buffer per la nuova data
ReDim aEstr(11,5)
ReDim aRuotePresenti(11)
sDataCorrente = sNuovaData
End If
'---------------------------------
' Mappa sigla ruota -> indice riga
'---------------------------------
r = MappaRuota(sSigla)
' Se la sigla è valida, carico i 5 numeri
If r > 0 Then
For c = 1 To 5
aEstr(r,c) = Format2(CInt(Trim(aCampi(c + 1))))
Next
aRuotePresenti(r) = 1
End If
End If
End If
Call AvanzamentoElab(0,UBound(aRighe),k)
Next
'========================
' Salvataggio ultima estrazione letta
'========================
If sDataCorrente <> "" Then
If bSalvaDaSubito Then
If EstrazioneCompleta(aRuotePresenti,aEstr) Then
nIdDaSalvare = ProssimoIndiceAnnuale(sAnnoUltimoSalvato,sDataCorrente,nIdUltimo)
sDataEstr = Right(sDataCorrente,2) & "/" & Mid(sDataCorrente,6,2) & "/" & Left(sDataCorrente,4)
If SalvaEstrazione(aEstr,sDataEstr,nIdDaSalvare,sFileBd) Then
nSalvate = nSalvate + 1
nIdUltimo = nIdDaSalvare
sAnnoUltimoSalvato = Left(sDataCorrente,4)
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: errore salvataggio ultima estrazione " & sDataCorrente,True)
ColoreTesto 0
End If
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: ultima estrazione incompleta ignorata in data " & sDataCorrente,True)
ColoreTesto 0
End If
Else
' Caso archivio esistente ma ultima data non trovata nel file sorgente
If(Not bArchivioVuoto) Then
If sDataCorrente = sDataUltimaISO Then
bTrovataUltimaData = True
End If
End If
End If
End If
'========================
' Riepilogo finale
'========================
If nSalvate > 0 Then
AllineaArchivi
Call Scrivi()
Call Scrivi("Script per Spaziometria - Aggiornamento da LottoItalia/BrightStar",True,,,vbBlue)
Call Scrivi()
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi()
Call Scrivi("Estrazioni totali: " & EstrazioniArchivio)
Call Scrivi()
Call Scrivi("Fonte: www.lotto-italia.it (archivio ufficiale BrightStar)")
Call Scrivi()
Call Scrivi("yes",True,,,vbBlue)
Else
If(Not bArchivioVuoto) And(Not bTrovataUltimaData) Then
Call Scrivi("ATTENZIONE: l'ultima data presente in archivio non è stata trovata nel file sorgente.",True,,,vbRed)
Call Scrivi("Verificare la coerenza di BaseDati.dat oppure ricostruire l'archivio da zero.",True)
Else
Call Scrivi("NON HO TROVATO NUOVE ESTRAZIONI !",True,,,2)
End If
End If
End Sub
'========================================================
' Restituisce l'indice ruota usato da Spaziometria
'========================================================
Function MappaRuota(ByVal sSigla)
MappaRuota = 0
Select Case UCase(Trim(sSigla))
Case "BA": MappaRuota = 1
Case "CA": MappaRuota = 2
Case "FI": MappaRuota = 3
Case "GE": MappaRuota = 4
Case "MI": MappaRuota = 5
Case "NA": MappaRuota = 6
Case "PA": MappaRuota = 7
Case "RM": MappaRuota = 8 ' Roma
Case "TO": MappaRuota = 9
Case "VE": MappaRuota = 10
Case "RN": MappaRuota = 11 ' Nazionale
End Select
End Function
'========================================================
' Calcola il prossimo indice annuale in modo corretto
' anche quando si cambia anno
'========================================================
Function ProssimoIndiceAnnuale(ByVal sAnnoUltimoSalvato,ByVal sDataCorrente,ByVal nIdUltimo)
If Trim(sAnnoUltimoSalvato) = "" Then
ProssimoIndiceAnnuale = 1
ElseIf Left(sDataCorrente,4) <> Trim(sAnnoUltimoSalvato) Then
ProssimoIndiceAnnuale = 1
Else
ProssimoIndiceAnnuale = nIdUltimo + 1
End If
End Function
'========================================================
' Verifica che l'estrazione sia completa:
' 11 ruote presenti e 5 numeri per ciascuna
'========================================================
Function EstrazioneCompleta(ByRef aRuotePresenti,ByRef aEstr)
Dim rr,cc
EstrazioneCompleta = True
For rr = 1 To 11
If aRuotePresenti(rr) <> 1 Then
EstrazioneCompleta = False
Exit Function
End If
For cc = 1 To 5
If Trim("" & aEstr(rr,cc)) = "" Then
EstrazioneCompleta = False
Exit Function
End If
Next
Next
End Function
parte da 4 maggio 2005,
prende lo storico originale lo scompatta e errori non dovrebbero esserci dato che e' della lotto italia archivi.
se lo usate buttate via il .dat, aprite spazio e lanciate il listato , spero che a qualcuno serva....
ciao
--
'Aggiorna archivio lotto di Spaziometria versione corretta per archivio vuoto
'Estrazioni prelevate direttamente dalla fonte Lottomatica
Option Explicit
Sub Main()
Dim sDirTemp,sDirZip,sDestDir
Dim sLink,sFileBd
Dim sCmd
Dim sDataUltima,sDataUltimaISO
Dim sDataCorrente,sDataEstr,sNuovaData,sSigla
Dim nEstrTot,nSalvate
Dim nIdUltimo,nIdDaSalvare
Dim sAnnoUltimoSalvato
Dim bSalvaDaSubito,bTrovataUltimaData,bArchivioVuoto
Dim aRighe,aCampi
Dim aEstr,aRuotePresenti
Dim k,r,c
Dim oShell,oFSO
'========================
' Percorsi file
'========================
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sDirZip = GetDirectoryTemp & "storico.zip"
sDirTemp = GetDirectoryTemp & "storico.txt"
'========================
' Pulizia file temporanei
'========================
Call EliminaFile(sDirZip)
Call EliminaFile(sDirTemp)
'========================
' Download archivio ufficiale
'========================
sLink = "https://www.brightstarlottery.it/STORICO_ESTRAZIONI_LOTTO/storico.zip"
Call Messaggio("Download archivio ufficiale in corso...")
If Not DownloadFromWeb(sLink,sDirZip) Then
Call Scrivi("ERRORE: impossibile scaricare il file zip dal sito LottoItalia.",True,,,vbRed)
Exit Sub
End If
'========================
' Decompressione zip -> storico.txt
'========================
Call Messaggio("Decompressione archivio...")
sDestDir = GetDirectoryTemp
If Right(sDestDir,1) = "\" Then
sDestDir = Left(sDestDir,Len(sDestDir) - 1)
End If
sCmd = "powershell -NoProfile -Command ""Expand-Archive -Force -LiteralPath '" & sDirZip & "' -DestinationPath '" & sDestDir & "'"""
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
oShell.Run sCmd,0,True
If Not oFSO.FileExists(sDirTemp) Then
Call Scrivi("ERRORE: il file storico.txt non è stato trovato dopo la decompressione.",True,,,vbRed)
Call Scrivi("Verificare che PowerShell sia disponibile e che lo zip contenga 'storico.txt'.",True)
Set oShell = Nothing
Set oFSO = Nothing
Exit Sub
End If
Set oShell = Nothing
Set oFSO = Nothing
'========================
' Lettura righe file testo
'========================
ReDim aRighe(0)
If Not LeggiRigheFileDiTesto(sDirTemp,aRighe) Then
Call Scrivi("ERRORE: impossibile leggere storico.txt.",True,,,vbRed)
Exit Sub
End If
Call EliminaFile(sDirZip)
Call EliminaFile(sDirTemp)
'========================
' Stato archivio corrente
'========================
nEstrTot = EstrazioniArchivio
If nEstrTot <= 0 Then
' Archivio vuoto: salviamo tutto dall'inizio
bArchivioVuoto = True
bSalvaDaSubito = True
bTrovataUltimaData = True
sDataUltima = ""
sDataUltimaISO = ""
nIdUltimo = 0
sAnnoUltimoSalvato = ""
Else
' Archivio esistente: salviamo solo da dopo l'ultima data presente
bArchivioVuoto = False
bSalvaDaSubito = False
bTrovataUltimaData = False
sDataUltima = DataEstrazione(nEstrTot,,,"/") ' GG/MM/AAAA
sDataUltimaISO = Right(sDataUltima,4) & "/" & Mid(sDataUltima,4,2) & "/" & Left(sDataUltima,2) ' AAAA/MM/GG
nIdUltimo = IndiceAnnuale(nEstrTot)
sAnnoUltimoSalvato = Left(sDataUltimaISO,4)
End If
'========================
' Inizializzazione buffer estrazione
'========================
ReDim aEstr(11,5)
ReDim aRuotePresenti(11)
sDataCorrente = ""
'========================
' Formato atteso righe:
' AAAA/MM/GG [TAB] SIGLA [TAB] N1 [TAB] N2 [TAB] N3 [TAB] N4 [TAB] N5
'
' Ordine sigle nel file sorgente:
' BA CA FI GE MI NA PA RM RN TO VE
'
' Ordine ruote Spaziometria:
' 1 BA
' 2 CA
' 3 FI
' 4 GE
' 5 MI
' 6 NA
' 7 PA
' 8 RO
' 9 TO
' 10 VE
' 11 NZ
'========================
For k = 0 To UBound(aRighe)
If ScriptInterrotto Then Exit For
If Trim(aRighe(k)) <> "" Then
aCampi = Split(aRighe(k),vbTab)
If UBound(aCampi) >= 6 Then
sNuovaData = Trim(aCampi(0)) ' AAAA/MM/GG
sSigla = UCase(Trim(aCampi(1)))
'---------------------------------
' Se cambia la data, prima salvo
' l'estrazione precedente
'---------------------------------
If sNuovaData <> sDataCorrente Then
If sDataCorrente <> "" Then
' Se siamo già entrati in modalità salvataggio,
' salvo l'estrazione precedente
If bSalvaDaSubito Then
If EstrazioneCompleta(aRuotePresenti,aEstr) Then
nIdDaSalvare = ProssimoIndiceAnnuale(sAnnoUltimoSalvato,sDataCorrente,nIdUltimo)
sDataEstr = Right(sDataCorrente,2) & "/" & Mid(sDataCorrente,6,2) & "/" & Left(sDataCorrente,4)
If SalvaEstrazione(aEstr,sDataEstr,nIdDaSalvare,sFileBd) Then
nSalvate = nSalvate + 1
nIdUltimo = nIdDaSalvare
sAnnoUltimoSalvato = Left(sDataCorrente,4)
Call Messaggio(nSalvate)
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: errore salvataggio estrazione " & sDataCorrente,True)
ColoreTesto 0
End If
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: estrazione incompleta ignorata in data " & sDataCorrente,True)
ColoreTesto 0
End If
End If
' Se l'estrazione appena chiusa è l'ultima già presente
' nell'archivio, da quella successiva in poi si salva
If(Not bSalvaDaSubito) Then
If sDataCorrente = sDataUltimaISO Then
bSalvaDaSubito = True
bTrovataUltimaData = True
End If
End If
End If
' Reset buffer per la nuova data
ReDim aEstr(11,5)
ReDim aRuotePresenti(11)
sDataCorrente = sNuovaData
End If
'---------------------------------
' Mappa sigla ruota -> indice riga
'---------------------------------
r = MappaRuota(sSigla)
' Se la sigla è valida, carico i 5 numeri
If r > 0 Then
For c = 1 To 5
aEstr(r,c) = Format2(CInt(Trim(aCampi(c + 1))))
Next
aRuotePresenti(r) = 1
End If
End If
End If
Call AvanzamentoElab(0,UBound(aRighe),k)
Next
'========================
' Salvataggio ultima estrazione letta
'========================
If sDataCorrente <> "" Then
If bSalvaDaSubito Then
If EstrazioneCompleta(aRuotePresenti,aEstr) Then
nIdDaSalvare = ProssimoIndiceAnnuale(sAnnoUltimoSalvato,sDataCorrente,nIdUltimo)
sDataEstr = Right(sDataCorrente,2) & "/" & Mid(sDataCorrente,6,2) & "/" & Left(sDataCorrente,4)
If SalvaEstrazione(aEstr,sDataEstr,nIdDaSalvare,sFileBd) Then
nSalvate = nSalvate + 1
nIdUltimo = nIdDaSalvare
sAnnoUltimoSalvato = Left(sDataCorrente,4)
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: errore salvataggio ultima estrazione " & sDataCorrente,True)
ColoreTesto 0
End If
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: ultima estrazione incompleta ignorata in data " & sDataCorrente,True)
ColoreTesto 0
End If
Else
' Caso archivio esistente ma ultima data non trovata nel file sorgente
If(Not bArchivioVuoto) Then
If sDataCorrente = sDataUltimaISO Then
bTrovataUltimaData = True
End If
End If
End If
End If
'========================
' Riepilogo finale
'========================
If nSalvate > 0 Then
AllineaArchivi
Call Scrivi()
Call Scrivi("Script per Spaziometria - Aggiornamento da LottoItalia/BrightStar",True,,,vbBlue)
Call Scrivi()
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi()
Call Scrivi("Estrazioni totali: " & EstrazioniArchivio)
Call Scrivi()
Call Scrivi("Fonte: www.lotto-italia.it (archivio ufficiale BrightStar)")
Call Scrivi()
Call Scrivi("yes",True,,,vbBlue)
Else
If(Not bArchivioVuoto) And(Not bTrovataUltimaData) Then
Call Scrivi("ATTENZIONE: l'ultima data presente in archivio non è stata trovata nel file sorgente.",True,,,vbRed)
Call Scrivi("Verificare la coerenza di BaseDati.dat oppure ricostruire l'archivio da zero.",True)
Else
Call Scrivi("NON HO TROVATO NUOVE ESTRAZIONI !",True,,,2)
End If
End If
End Sub
'========================================================
' Restituisce l'indice ruota usato da Spaziometria
'========================================================
Function MappaRuota(ByVal sSigla)
MappaRuota = 0
Select Case UCase(Trim(sSigla))
Case "BA": MappaRuota = 1
Case "CA": MappaRuota = 2
Case "FI": MappaRuota = 3
Case "GE": MappaRuota = 4
Case "MI": MappaRuota = 5
Case "NA": MappaRuota = 6
Case "PA": MappaRuota = 7
Case "RM": MappaRuota = 8 ' Roma
Case "TO": MappaRuota = 9
Case "VE": MappaRuota = 10
Case "RN": MappaRuota = 11 ' Nazionale
End Select
End Function
'========================================================
' Calcola il prossimo indice annuale in modo corretto
' anche quando si cambia anno
'========================================================
Function ProssimoIndiceAnnuale(ByVal sAnnoUltimoSalvato,ByVal sDataCorrente,ByVal nIdUltimo)
If Trim(sAnnoUltimoSalvato) = "" Then
ProssimoIndiceAnnuale = 1
ElseIf Left(sDataCorrente,4) <> Trim(sAnnoUltimoSalvato) Then
ProssimoIndiceAnnuale = 1
Else
ProssimoIndiceAnnuale = nIdUltimo + 1
End If
End Function
'========================================================
' Verifica che l'estrazione sia completa:
' 11 ruote presenti e 5 numeri per ciascuna
'========================================================
Function EstrazioneCompleta(ByRef aRuotePresenti,ByRef aEstr)
Dim rr,cc
EstrazioneCompleta = True
For rr = 1 To 11
If aRuotePresenti(rr) <> 1 Then
EstrazioneCompleta = False
Exit Function
End If
For cc = 1 To 5
If Trim("" & aEstr(rr,cc)) = "" Then
EstrazioneCompleta = False
Exit Function
End If
Next
Next
End Function
Ultima modifica:
Ultima estrazione Lotto
-
Estrazione del lotto
martedì 14 aprile 2026Bari1214298576Cagliari3375719035Firenze7276560680Genova3773083478Milano4785011108Napoli0730462911Palermo3240784674Roma4313650552Torino6404443674Venezia4850212819Nazionale7088154420Estrazione Simbolotto
Genova
2807141635
