Aggiornamento estrazioni

[genios]

Non riesco piu' a aggiornare l' estrazioni da base dati aggiornamento archivi da web . Capita anche a voi ?

Ciao Eugenio

 

[antonio65]

Ciao, anche io non riesco...non si aggiorna piu'....

 

[joe]

Il televideo ha cambiato l'impaginazione degli estratti,

dunque, molti dei sistemi automatici che

consultano questo riferimento o derivano in qualche modo da questa fonte ...

.... attualmente non funzionano.

 

[Alien.]

ma è un caso ? il cambio impaginazione ...o............altro lavoro per LuigiB ?

 

[genios]

Il link a cui fa riferimento spaziometria e il seguente : http://www.silop.it/archivi/lottoItalia/BaseDati.dat Non funziona più ?

Ciao Eugenio

 

[stupl]

Nel mio archivio lotto mancano le estrazioni del 7/6/18 e 9/6/18 anche se aggiorno non le inserisce, stessa cosa per il superenalotto.

 

[Mike58]

Per queste 2 estrazioni mancanti (Visto che anche a me risultavano non aggiornabili) LuigiB aveva creato questo script per aggiornamento da Televideo che modificando il link adesso dovrebbe tranquillamente aggiornare da televideo tramite script..

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.televideo.rai.it/televideo/pub/solotesto.jsp?pagina=591&sottopagina=1"
    Case 1
        sLink = "http://www.televideo.rai.it/televideo/pub/solotesto.jsp?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

 

[Roby]

Se può servire...da silop non mi funzia, ma usando le altre opzioni per aggiornare lo fatto senza problemi

ciao a tutti

 

[chicco3]

Salve scusate se mi intrometto con questo da foto si aggiorna.

 

[silop2005]

Sto scrivendo dal cellulare.
mi dispiace per il disagio
un imprevisto personale mi ha portato
lontano dal mio pc
Ma dalle altre opzioni funziona l'aggiornamento .

 

[salvo50]

Salve scusate se mi intrometto con questo da foto si aggiorna.

Idem

[IMG2=JSON]{"data-align":"none","data-size":"full","src":"https:\/\/s33.postimg.cc\/h6wmd8n8v\/AGG.png"}[/IMG2]

 

[houdini]

si così funziona ma non si può scaricare l'archivio di visual lotto 7 (quello di visual lotto 5 non si è mai aggiornato) , chi può risolvere il problema è Luigi da ringraziare per tutto quello che fa (gratis e x tutti gli appassionati del lotto)

 

[chicco3]

grazie sempre pronto

 

[chicco3]

Ciao Houdini basta che vai al link sotto aggiorni visual7

 

[houdini]

grazie mille.

 

[Roby]

Ho notato che con win 7 si aggiorna senza problemi

con win xp, non ne vuol sapere per il momento di aggiornarsi qualsiasi cosa provi.

 

[i legend]

Ciao silop, non preoccuparti,
speriamo che non hai potuto aggiornare perché sei in vacanza al mare .
se l imprevisto fosse meno piacevole ti auguriamo che si risolva presto e per il meglio.
ciao

 

[silop2005]

Scrivo dal cellulare
ciao ilegend
grazie del pensiero
il mare al momento non lo vedo
ma a fine settimana ritorno vicino
al mio "amico" computer.

 

[joe]

Ciao Silop ... un caro saluto.

Giorgio

 

[silop2005]

Scrivo dal cellulare
ciao Joe
grazie del pensiero.