Sub Main()
Dim sLink
Dim sFileLocal
Dim aRighe,aRigheTmp
Dim aNumRuota(11,5)
Dim nIdRuota
Dim k,r
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.servizitelevideo.rai.it/televideo/pub/solotesto.jsp?regione=&pagina=591&sottopagina=01"
Case 1
sLink = "http://www.servizitelevideo.rai.it/televideo/pub/solotesto.jsp?regione=&pagina=592&sottopagina=02"
End Select
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
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