Aggiornamento Estrazioni Spaziometria

Option Explicit
Sub Main
'Script By Joe
'https://lottogam.forumfree.it/?t=78437103
Dim sFileLoc
Dim nEstrTot,sDataLastEstr,k,r,e
Dim sDataEstr,nNumEstr,nSalvate
Dim b
Dim sFileBd
Dim sLink
Dim Ia,N,sVV,x
Dim CfrData
sLink = "http://www.lottogam.it/Archivio1945.txt"
b = False : N = False
nSalvate = 0
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sFileLoc = GetDirectoryAppData & "temp\"
If CreaDirectory(sFileLoc) Then
sFileLoc = sFileLoc & "Estrazioni.txt"
If DownloadFromWeb(sLink,sFileLoc) Then
nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
Ia = IndiceAnnuale(nEstrTot)
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sFileLoc,aRighe)
For k = 0 To UBound(aRighe)
ReDim aV(0)
Call SplitByChar(aRighe(k),"-",aV)
If Len(aRighe(k)) = 120 Then
If UBound(aV) = 2 Then
sDataEstr = Replace(Left(aRighe(k),10),"-","/")
sVV = Right(aRighe(k),110)
If b Then
If N = False And(Right(sDataEstr,4) <> Right(sDataLastEstr,4)) Then Ia = 0 : N = True
If Left(sDataEstr,4) <> Left(sDataLastEstr,4) Then
Ia = Ia + 1
nNumEstr =(Ia)
If nNumEstr > 0 And IsDate(sDataEstr) Then
ReDim aEstr(11,5)
r = 1 : e = 0
For x = 1 To 110 Step 2
e = e + 1
aEstr(r,e) = Mid(sVV,x,2)
If e = 5 Then r = r + 1 : e = 0
Next
If CfrData <> Left(sDataEstr,5) Then
If SalvaEstrazione(aEstr,sDataEstr,nNumEstr,sFileBd) Then
CfrData = Left(sDataEstr,5)
nSalvate = nSalvate + 1
Call Messaggio(nSalvate)
End If
Else
ColoreTesto 2
Scrivi "ATTENZIONE " & sDataEstr & " ESTRAZIONE DUPLICATA",True
ColoreTesto 0
End If
End If
End If
End If
If sDataEstr = sDataLastEstr Then b = True
End If
End If
Next
If nSalvate > 0 Then AllineaArchivi
Else
MsgBox "Errore download verificare il link con il browser"
End If
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi("")
Call Scrivi("Estrazioni totali " & QuantitaEstrazioniInFile(sFileBd))
Call Scrivi("")
Call Scrivi("Utilizzato archivio del sito " & Left(sLink,23))
Call Scrivi("")
End If
End Sub

Option Explicit
'https://forum.lottoced.com/threads/aggiornamento-estrazioni-lotto-spaziometria-1-6-31.2194296/post-2238089
'script di Mike58
' PRIMA di lanciare lo script accertarsi che l'estrazione si vede a video
'nella pagina del TELEVIDEO RAI qui :
'http://www.televideo.rai.it/televideo/pub/solotesto.jsp?regione=&pagina=786&sottopagina=01
'Attenzione la barra potrebbe non risultare aggiornata ma basta spostarla per vederla aggiornata, Mike58.
Sub Main

Dim fso 'filesystemobject
Dim sFile ' percorso del file
Dim myFile ' è lo strream per leggere il file
Dim sLinea ' è la linea letta corrente
Dim ContaLinea,EsMancanti,E,R,P,EsNuova
Dim sLink
Dim sFileLocal
Dim aRighe,aRigheTmp
Dim aNumRuota(11,5)
Dim nIdRuota
Dim k
Dim nRuoteLette
Dim sData
Dim sDataLastEstr
Dim sTesto
Dim nLastIndiceAnn,nNewIndiceAnn
Dim sFileDati

sFileDati = GetDirectoryAppData & "BaseDati.dat"

Select Case ScegliEstrazione
Case 0
sLink = "http://www.televideo.rai.it/televideo/pub/solotesto.jsp?pagina=786"
Case 1
sLink = "http://www.televideo.rai.it/televideo/pub/solotesto.jsp?pagina=787"

Case 2
Scrivi "Nessun aggiornamento effettuato"
Exit Sub
Case - 1
Scrivi "Nessun aggiornamento effettuato"
Exit Sub
End Select

'sLink = "http://www.televideo.rai.it/televideo/pub/solotesto.jsp?pagina=786"

nIdRuota = 0
nRuoteLette = 0
sDataLastEstr = DataEstrazione(EstrazioniArchivio,,,"/")
nLastIndiceAnn = IndiceAnnuale(EstrazioniArchivio)
sFileLocal = GetDirectoryAppData & "temp\Estrazione.htm"

If DownloadFromWeb(sLink,sFileLocal) Then
Call LeggiRigheFileDiTesto(sFileLocal,aRighe)
For k = 0 To UBound(aRighe)
If InStr(aRighe(k),"ESTRAZIONE DEL") Then
aRigheTmp = Split(aRighe(k),vbLf)
For R = 0 To UBound(aRigheTmp)
nIdRuota = IdRigaRuota(aRigheTmp(R))
If nIdRuota > 0 Then
If LeggiNumRuota(aRigheTmp(R),aNumRuota,nIdRuota) Then
nRuoteLette = nRuoteLette + 1
End If
Else
If IsDate(Trim(aRigheTmp(R))) Then
sData = Trim(aRigheTmp(R))
End If
End If
If nRuoteLette = 11 Then Exit For
Next
Exit For
End If
Next
If nRuoteLette = 11 Then
If sData = sDataLastEstr Then
MsgBox "Non ci sono estrazioni da scaricare",vbInformation
Else
sTesto = "Ultima estrazione presente " & FormattaStringa(sDataLastEstr,"Long Date") & vbCrLf
sTesto = sTesto & "Estrazione scaricata " & FormattaStringa(sData,"Long Date") & vbCrLf & vbCrLf
sTesto = sTesto & "Aggiungere l'estrazione del " & FormattaStringa(sData,"Long Date") & " ?" & vbCrLf & vbCrLf
sTesto = sTesto & GetAnteprimaNumeri(aNumRuota)
If MsgBox(sTesto,vbQuestion + vbYesNo) = vbYes Then
If Year(sData) = Year(sDataLastEstr) Then
nNewIndiceAnn = nLastIndiceAnn + 1
Else
nNewIndiceAnn = 1
End If
If SalvaEstrazione(aNumRuota,sData,nNewIndiceAnn,sFileDati) Then
MsgBox "Aggiornamento effettuato",vbInformation
Else
MsgBox "Errore aggiornamento",vbCritical
End If
End If
End If
End If
End If
Call AllineaArchivi
Scrivi "EstrazioneFine in Archivio : " &(sDataLastEstr),1
Scrivi "Attenzione la barra potrebbe non risultare aggiornata all'estrazione successiva "
Scrivi "ma basta cliccare sulla BARRA SOTTO freccia >| per vederla aggiornata, Mike58/silop. "
Scrivi "---------------------------------------------"


Scrivi "-------------------------------------------------"
Scrivi TempoTrascorso
End Sub



Function IdRigaRuota(sRiga)
Dim aRuote
Dim k
Dim nRet
nRet = 0
aRuote = Array("","Bari","Cagliari","Firenze","Genova","Milano","Napoli","Palermo","Roma","Torino","Venezia","Nazionale")
For k = 1 To UBound(aRuote)
If InStr(1,sRiga,aRuote(k),vbTextCompare) Then
nRet = k
Exit For
End If
Next
IdRigaRuota = nRet
End Function
Function LeggiNumRuota(sRiga,aNumRuota,nIdRuota)
Dim aV
Dim k
Dim nQNum
nQNum = 0
sRiga = Replace(sRiga,vbTab,"")
sRiga = Trim(RiduciSpazi(sRiga))
aV = Split(sRiga," ")
If UBound(aV) = 5 Then
For k = 1 To 5
If IsNumeric(aV(k)) Then
aNumRuota(nIdRuota,k) = aV(k)
nQNum = nQNum + 1
End If
Next
LeggiNumRuota =(nQNum = 5)
Else
LeggiNumRuota = False
End If
End Function
Function RiduciSpazi(s)
Dim sTmp
sTmp = s
Do While InStr(sTmp," ")
sTmp = Replace(sTmp," "," ")
Loop
RiduciSpazi = sTmp
End Function
Function GetAnteprimaNumeri(aNumRuota)
Dim r,e,sRet
For r = 1 To 11
sRet = sRet & NomeRuota(Iif(r <= 10,r,12)) & " "
For e = 1 To 5
sRet = sRet & FormatSpace(aNumRuota(r,e),2,True) & " "
Next
sRet = Trim(sRet) & vbCrLf
Next
GetAnteprimaNumeri = sRet
End Function
Function ScegliEstrazione
Dim aVoci
Dim r
aVoci = Array("Ultima","Penultima")
r = ScegliOpzioneMenu(aVoci,0,"Aggiornamento da televideo")
ScegliEstrazione = r
End Function

Option Explicit
'Script per Spaziometria V.4.0 di LuigiB & Giomi Rev. By Joe
Sub Main
Dim sDirTemp
Dim sLink
Dim nAnnoPart,nAnnoCorr,sNuovaData
Dim k
Dim id
Dim sDataEstr,sCData,nSalvate,sFileBd
Dim sV,r,e,x
Dim b,nEstrTot,sDataLastEstr,iA,z
nAnnoPart = Year(Now) - 2
nAnnoCorr = Year(Now)
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sDirTemp = GetDirectoryTemp & "lottologia.txt"
Call EliminaFile(sDirTemp)
For sNuovaData = nAnnoPart To nAnnoCorr
If ScriptInterrotto Then Exit For
Call Messaggio(sNuovaData)
Call AvanzamentoElab(nAnnoPart,nAnnoCorr,sNuovaData)
sLink = "https://www.lottologia.com/lotto/archivio-estrazioni/?as=TXT&year=" & sNuovaData
If DownloadFromWeb(sLink,sDirTemp) Then
nEstrTot = EstrazioniArchivio
If nEstrTot = 0 Then nAnnoPart = 1871 : b = True
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
z = Right(sDataLastEstr,4)
id = IndiceAnnuale(nEstrTot)
ReDim aRighe(0)
If LeggiRigheFileDiTesto(sDirTemp,aRighe) Then
If EliminaFile(sDirTemp) Then
If Trim(aRighe(k)) <> "" Then
For k = UBound(aRighe) - 3 To 2 Step - 1
aRighe(k) = Replace(aRighe(k),vbTab,"")
aRighe(k) = Replace(aRighe(k),"-","")
'Call Scrivi(id & " ",0,0)
sDataEstr = Mid(aRighe(k),7,2) & "/" & Mid(aRighe(k),5,2) & "/" & Left(aRighe(k),4)
If z <> Left(aRighe(k),4) Then id = 0 : z = Left(aRighe(k),4)
'Call Scrivi(sDataEstr)
sV = Right(aRighe(k),110)
'Call Scrivi (sV)
ReDim aEstr(11,5)
r = 1 : e = 0
For x = 1 To 110 Step 2
e = e + 1
'Scrivi Mid(sVV,x,2) & " ",0,0
aEstr(r,e) = Mid(sV,x,2)
If e = 5 Then r = r + 1 : e = 0
Next
'ScriviMatrice(aEstr)
If b = True Then
If sCData <> sDataEstr Then
id = id + 1
If SalvaEstrazione(aEstr,sDataEstr,id,sFileBd) Then
sCData = sDataEstr
nSalvate = nSalvate + 1
Call Messaggio(nSalvate)
End If
Else
ColoreTesto 2
Scrivi "ATTENZIONE " & sDataEstr & " ESTRAZIONE DUPLICATA",True
ColoreTesto 0
End If
End If
If sDataEstr = sDataLastEstr Then b = True
'
Next
End If
End If
End If
End If
If ScriptInterrotto Then Exit For
Next
If nSalvate > 0 Then
AllineaArchivi
Call Scrivi()
Call Scrivi("Script per Spaziometria V.4.0 di LuigiB & Giomi Rev. By Joe",True,,,vbBlue)
Call Scrivi()
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi("")
Call Scrivi("Estrazioni totali " & EstrazioniArchivio)
Call Scrivi()
Call Scrivi("Utilizzato Archivio del sito www.lottologia.com")
Call Scrivi()
Else
Call Scrivi("NON HO TROVATO NUOVE ESTRAZIONI !",1,,,2)
End If

End Sub

Option Explicit
'Script per Spaziometria V.4.0 di LuigiB & Giomi Rev. By Joe
Sub Main
Dim sDirTemp
Dim sLink
Dim nAnnoPart,nAnnoCorr,sNuovaData
Dim k
Dim id
Dim sDataEstr,sCData,nSalvate,sFileBd
Dim sV,r,e,x
Dim b,nEstrTot,sDataLastEstr,iA,z
nAnnoPart = Year(Now) - 2
nAnnoCorr = Year(Now)
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sDirTemp = GetDirectoryTemp & "lottologia.txt"
Call EliminaFile(sDirTemp)
For sNuovaData = nAnnoPart To nAnnoCorr
If ScriptInterrotto Then Exit For
Call Messaggio(sNuovaData)
Call AvanzamentoElab(nAnnoPart,nAnnoCorr,sNuovaData)
sLink = "https://www.lottologia.com/lotto/archivio-estrazioni/?as=TXT&year=" & sNuovaData
If DownloadFromWeb(sLink,sDirTemp) Then
nEstrTot = EstrazioniArchivio
If nEstrTot = 0 Then nAnnoPart = 1871 : b = True
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
z = Right(sDataLastEstr,4)
id = IndiceAnnuale(nEstrTot)
ReDim aRighe(0)
If LeggiRigheFileDiTesto(sDirTemp,aRighe) Then
If EliminaFile(sDirTemp) Then
If Trim(aRighe(k)) <> "" Then
For k = UBound(aRighe) - 3 To 2 Step - 1
aRighe(k) = Replace(aRighe(k),vbTab,"")
aRighe(k) = Replace(aRighe(k),"-","")
'Call Scrivi(id & " ",0,0)
sDataEstr = Mid(aRighe(k),7,2) & "/" & Mid(aRighe(k),5,2) & "/" & Left(aRighe(k),4)
If z <> Left(aRighe(k),4) Then id = 0 : z = Left(aRighe(k),4)
'Call Scrivi(sDataEstr)
sV = Right(aRighe(k),110)
'Call Scrivi (sV)
ReDim aEstr(11,5)
r = 1 : e = 0
For x = 1 To 110 Step 2
e = e + 1
'Scrivi Mid(sVV,x,2) & " ",0,0
aEstr(r,e) = Mid(sV,x,2)
If e = 5 Then r = r + 1 : e = 0
Next
'ScriviMatrice(aEstr)
If b = True Then
If sCData <> sDataEstr Then
id = id + 1
If SalvaEstrazione(aEstr,sDataEstr,id,sFileBd) Then
sCData = sDataEstr
nSalvate = nSalvate + 1
Call Messaggio(nSalvate)
End If
Else
ColoreTesto 2
Scrivi "ATTENZIONE " & sDataEstr & " ESTRAZIONE DUPLICATA",True
ColoreTesto 0
End If
End If
If sDataEstr = sDataLastEstr Then b = True
'
Next
End If
End If
End If
End If
If ScriptInterrotto Then Exit For
Next
If nSalvate > 0 Then
AllineaArchivi
Call Scrivi()
Call Scrivi("Script per Spaziometria V.4.0 di LuigiB & Giomi Rev. By Joe",True,,,vbBlue)
Call Scrivi()
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi("")
Call Scrivi("Estrazioni totali " & EstrazioniArchivio)
Call Scrivi()
Call Scrivi("Utilizzato Archivio del sito www.lottologia.com")
Call Scrivi()
Else
Call Scrivi("NON HO TROVATO NUOVE ESTRAZIONI !",1,,,2)
End If

End Sub