Novità

Script (non plugin in) per aggiornare MD?

lotto_tom75

Premium Member
Messaggi
7.776
Punti reazione
75
Punti
48
Grazie a chi me lo indica se esiste e grazie decuplicate a chi lo realizza nel caso non fosse ancora stato costruito :)
Complimentimentissimi a Ced per la nuova versione del forum. Già interessantissima prima... Adesso è davvero "spaziale!" :eek: :D
 

magia

Super Member >PLATINUM<
Messaggi
487
Punti reazione
15
Punti
18
buonanotte,
Provi questo listato , e' ancora da perfezionare
Deve cambiare il percorso del file dove viene salvato l' archivio .
confidiamo in LuigiB , Mike48 , Joe91 , Beppignello ,
Ilegend , Claudio8 ,Rubino , Salvo50 . Druid , Master ed altri
per un aiuto .
Codice:
Option Explicit
' TestWebBroser MILLIONDAY
Sub Main
   Dim ObjIe
   Dim s,sOut,i,ii,TimeStart,sUrl
   Dim cTimeOut
   Dim cREADYSTATE_COMPLETE ' costante di internet explorer che indica la navigazione completata
   cREADYSTATE_COMPLETE = 04 ' la costante vale 4 (secondo documentazione)
   cTimeOut = 30 ' variabile per gestire il timeout
   Dim sFileEstrazioni
   Dim nIdEstr,nEstrTot,nAnnoCorr,nAnno,k,nAnnoPartenza
   Dim nNumEstr,sDataEstr
   nAnnoPartenza = 2018
   sFileEstrazioni = "C:\Users\Admin\Desktop\Archivio MillionDay.txt"
   If MsgBox("Ricreare il file daccapo ?",vbQuestion + vbYesNo) = vbYes Then
      Call EliminaFile(sFileEstrazioni)
      nAnnoPartenza = Int(InputBox("Da quale anno inizio ?","Inizio archivio",nAnnoPartenza))
      If nAnnoPartenza = 0 Then nAnnoPartenza = 2018
   End If
   '
   'sUrl = "https://www.adm.gov.it/portale/en/estrazioni?prog=1&anno=2018"
   sUrl = "https://www.adm.gov.it/portale/en/estrazioni?prog="
   '
   nIdEstr = 0000
   nAnnoCorr = nAnnoPartenza
   Set ObjIe = CreateObject("InternetExplorer.Application")
   If FileEsistente(sFileEstrazioni) Then
      ReDim aEstrazioni(00)
      Call LeggiRigheFileDiTesto(sFileEstrazioni,aEstrazioni)
      nEstrTot = UBound(aEstrazioni)
      If nEstrTot > 00 Then
         ReDim av(00)
         Call SplitByChar(aEstrazioni(nEstrTot),",",av)
         nIdEstr = Int(av(00))
         nAnnoCorr = Int(Right(av(01),04))
      End If
   End If
   For nAnno = nAnnoCorr To Year(Now)
      Do
         nIdEstr = nIdEstr + 01
         Call Messaggio("Scarico estrazione " & nAnno & "/" & nIdEstr)
         Call AvanzamentoElab(001,365,nIdEstr)
         ObjIe.Navigate2(sUrl & nIdEstr & "&anno=" & nAnno)
         ' Aspetto che la pagina sia caricata
         Do While ObjIe.ReadyState <> cREADYSTATE_COMPLETE
            DoEventsEx
         Loop
         s = ObjIe.Document.All(00).outerHTML ' leggo il contenuto della pagina che sto navigando
         TimeStart = Timer
         i = InStr(s,"<h2>MillionDay n. ")' cerco la stringa conosciuta
         k = InStr(s,"<div class=""errore"" >Non ci sono estrazioni MillionDay</div>")' cerco la stringa conosciuta
         Do While i = 00
            s = ObjIe.Document.All(00).outerHTML ' rileggo il contenuto della pagina che sto navigando
            i = InStr(s,"<h2>MillionDay n. ")' cerco la stringa conosciuta
            k = InStr(s,"<div class=""errore"" >Non ci sono estrazioni MillionDay</div>")' cerco la stringa conosciuta
            If i > 00 And k < 01 Then Exit Do
            If Timer - TimeStart > cTimeOut Then
               Exit Do ' se la stringa non viene trovata dopo il timeout esce
            End If
         Loop
         If i > 00 Then
            ii = InStr(i,s,"<div id=""boxEvidenza"">",vbTextCompare)
            ' gestisco il fatto di aver trovato la stringa oppure no
            If ii > 00 Then
               sOut = Mid(s,i,ii - i)
            Else
               sOut = Mid(s,i)
            End If
            ReDim aNumVinc(00)
            If GetEstrazioneFromBuffer(sOut,aNumVinc,sDataEstr,nNumEstr) Then
               sOut = FormattaStringa(nNumEstr,"00000") & "," & sDataEstr & "," & StringaNumeri(aNumVinc,",",True)
               Call ScriviFile(sFileEstrazioni,sOut,False,True)
               Call Scrivi(sOut,True)
            Else
               Exit Do
            End If
         Else
            Call MsgBox("Impossibile scaricare il file dell'archivio")
            Exit Do
         End If
         If ScriptInterrotto Then Exit Do
      Loop
      nIdEstr = 0000
      If ScriptInterrotto Then Exit For
   Next
   ' chiudo il browser
   ObjIe.Quit
   ' anniento la variabile
   Set ObjIe = Nothing
   '
   Call CloseFileHandle(sFileEstrazioni) ' chiudo l'handle al file
   Call LanciaFile(sFileEstrazioni) ' lancio il file si aprira notepad
End Sub
Function GetEstrazioneFromBuffer(sBuffer,aRetNumVinc,sRetData,nRetNumEstr)
   ReDim aRighe(00)
   ReDim aRetNumVinc(10)
   Dim k,j,i
   sBuffer = Replace(sBuffer,vbTab,"")
   sBuffer = Replace(sBuffer,vbCrLf,"")
   sBuffer = Replace(sBuffer,vbCr,"")
   sBuffer = Replace(sBuffer,vbLf,"")
   sBuffer = Replace(sBuffer,"<h2","")
   sBuffer = Replace(sBuffer,"</h2","")
   sBuffer = Replace(sBuffer,"<div class=""boxIntEvidenza""","") ' se il testo da sostituire ha virgolette le virgolette vanno raddoppiate
   sBuffer = Replace(sBuffer,"<p class=""IntBordo""","") ' se il testo da sostituire ha virgolette le virgolette vanno raddoppiate
   sBuffer = Replace(sBuffer,"<span","")
   sBuffer = Replace(sBuffer,"</span","")
   sBuffer = Replace(sBuffer,"</p","")
   sBuffer = Replace(sBuffer,"</div","")
   sBuffer = Replace(sBuffer,"div","")
   Do While InStr(sBuffer,">>")
      sBuffer = Replace(sBuffer,">>",">")
   Loop
   ReDim aValori(00)
   Call SplitByChar(sBuffer,">",aValori)
   For k = 00 To UBound(aValori)
      If InStr(01,aValori(k),"MillionDay",vbTextCompare) Then
         ReDim aTmp(00)
         Call SplitByChar(aValori(k)," ",aTmp)
         If IsNumeric(aTmp(02)) Then
            nRetNumEstr = Int(Trim(aTmp(02)))
         End If
         If Trim(aTmp(04)) <> "" Then
            sRetData = Trim(aTmp(04))
         End If
      End If
      If InStr(01,aValori(k),"Combinazione vincente",vbTextCompare) Then
         i = 00
         For j = k + 01 To UBound(aValori)
            If IsNumeric(Trim(aValori(j))) Then
               i = i + 01
               aRetNumVinc(i) = Int(Trim(aValori(j)))
            End If
         Next
         ReDim Preserve aRetNumVinc(i)
      End If
   Next
   If IsDate(sRetData) <> False Then
      If nRetNumEstr <> 00 Then
         If UBound(aRetNumVinc) = 05 Then
            GetEstrazioneFromBuffer = True
            Exit Function
         End If
      End If
   End If
   GetEstrazioneFromBuffer = False
End Function
Controllare Sempre .
Salvo Errori ed Omissis .
 
Alto