CROISEZ LES TIRAGES DE EURO MILLIONS AVEC VOS GRILLES V2 UPDATE

Commentaire de claudetom le 24/07/2005 23:00:07

De rien, tout le plaisir est pour moi.
j'avais un peu de temps ;)
Je pourrais l'améliorer bien plus genre :
Comme la source de lotobase trouvable sur mon site :
claudetom.fr.st rubrique programmation.
récupération des tirages directement sur internet.
Affichage d'une liste des tirages depuis ce jour avec tri sélectif.
Possibilité de multiliste (exemple si plusieurs personnes jouent dans la même maison).
Affichage des numéros les plus souvent sortis.
Comparaison des grilles jouées sur tous les tirages déjà sortis.
Aperçu des numéros les plus souvent sortis en graphe et dans une grille.
Mis en avant des numéros ou tirage avec les sommes perdues et gagnantes configurable.
etc..
Mais je manque de temps beaucoup de boulot.
Donc si des personnes débutantes ou pros sont intéressées à vos claviers.
le chalenge faire un logiciel pro, entièrement gratuit ou tout le monde y mets sa signature et son petit +
Je n’ai aucun mérite juste ma participation pour le plaisir.
Comme je l'ai, déjà fais avec des personnes de ce groupe, ils me connaissent et je les respecte.
À plusieurs ont fait avancer et évoluer les choses.
Ici c'est l'entraide qui prône donc faisons le nécessaire :)
Et c'est grâce à ce site que moi-même j'évolue dans la connaissance de ce langage.
ClaudeTom

Commentaire de pit1 le 26/07/2005 20:10:21

Salut,

j'ai ici encore une sub pour télécharger les tirages (avec les gains ...) de www.fdjeux.com
Dans mon projet, j'insère les nouveaux tirages dans une base access.
Le seul hic, c'est que le fichier à télécharger est un ZIP, j'ai trouvé un ocx libre sous http://www.codeguru.com/vb/gen/vb_graphics/fileformats/article.php/c6743/, mais je n'ai pas testé sous .net!


Const Proxy As String = "192.168.1.11:3128"
Const DNS As String = "192.168.114.252"
Const UrlGetZip = "http://www.fdjeux.com/generated/dyn/euromillions/euromillions.zip"

Public Sub UpdateDatabase()

    Dim fso As New FileSystemObject
    Dim ts As TextStream
    Dim line As String
    Dim a() As String
    Dim oUnZip As New CGUnzipFiles
    Dim Count As Long
    Dim inet1 As Object
    Dim rstTirages As New ADODB.Recordset
    Dim rstRapports As New ADODB.Recordset
    
    Application.StatusBar = "Downloading from " & UrlGetZip
    ' open our database, in the same path than the application
    If Trim$(cnn.ConnectionString) = "" Then
        cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\Euromillions.mdb"
    End If
    
    Set inet1 = CreateObject("InetCtls.Inet")
    inet1.Proxy = Proxy
    Dim bData() As Byte
    bData() = inet1.OpenURL(UrlGetZip, 1)
    Open ActiveWorkbook.Path & "\" & "tmp.zip" For Binary Access Write As #1
    Put #1, , bData()
    Close

    Application.StatusBar = "Unzipping " & ActiveWorkbook.Path & "\" & "tmp.zip" & vbCrLf
    oUnZip.ZipFileName = ActiveWorkbook.Path & "\" & "tmp.zip"
    oUnZip.ExtractDir = ActiveWorkbook.Path ' or whatever you like !
    If oUnZip.Unzip <> 0 Then
      MsgBox oUnZip.GetLastMessage
    End If
    Set oUnZip = Nothing
    
    Count = 0
    Application.StatusBar = "Importing " & ActiveWorkbook.Path & "\" & "Euromill.csv" & vbCrLf
    Set ts = fso.OpenTextFile(ActiveWorkbook.Path & "\" & "Euromill.csv", ForReading)
    line = ts.ReadLine
    If line <> "annee_numero_de_tirage;jour_de_tirage;date_de_tirage;" & _
                "date_de_forclusion;boule_1;boule_2;boule_3;boule_4;" & _
                "boule_5;etoile_1;etoile_2;boules_gagnantes_en_ordre_croissant;" & _
                "etoiles_gagnantes_en_ordre_croissant;" & _
                "nombre_de_gagnant_au_rang1_en_france;nombre_de_gagnant_au_rang1_en_europe;rapport_du_rang1;" & _
                "nombre_de_gagnant_au_rang2_en_france;nombre_de_gagnant_au_rang2_en_europe;rapport_du_rang2;" & _
                "nombre_de_gagnant_au_rang3_en_france;nombre_de_gagnant_au_rang3_en_europe;rapport_du_rang3;" & _
                "nombre_de_gagnant_au_rang4_en_france;nombre_de_gagnant_au_rang4_en_europe;rapport_du_rang4;" & _
                "nombre_de_gagnant_au_rang5_en_france;nombre_de_gagnant_au_rang5_en_europe;rapport_du_rang5;" & _
                "nombre_de_gagnant_au_rang6_en_france;nombre_de_gagnant_au_rang6_en_europe;rapport_du_rang6;" & _
                "nombre_de_gagnant_au_rang7_en_france;nombre_de_gagnant_au_rang7_en_europe;rapport_du_rang7;" & _
                "nombre_de_gagnant_au_rang8_en_france;nombre_de_gagnant_au_rang8_en_europe;rapport_du_rang8;" & _
                "nombre_de_gagnant_au_rang9_en_france;nombre_de_gagnant_au_rang9_en_europe;rapport_du_rang9;" & _
                "nombre_de_gagnant_au_rang10_en_france;nombre_de_gagnant_au_rang10_en_europe;rapport_du_rang10;" & _
                "nombre_de_gagnant_au_rang11_en_france;nombre_de_gagnant_au_rang11_en_europe;rapport_du_rang11;" & _
                "nombre_de_gagnant_au_rang12_en_france;nombre_de_gagnant_au_rang12_en_europe;rapport_du_rang12;" Then
        MsgBox "File format changed! Abording..." & ActiveWorkbook.Path & "\" & "Euromill.csv"
    Else
        Do While Not ts.AtEndOfStream
            line = ts.ReadLine
            a = Split(line, ";")
            ' check the tirages table
            rstTirages.Open "SELECT * FROM Tirages Where Tirage=" & a(0), cnn, adOpenDynamic, adLockOptimistic
            If rstTirages.EOF Then
                Count = Count + 1
                ' add this one
                Application.StatusBar = "Adding TIRAGE " & a(0) & " date " & a(2)
                rstTirages.Close
                rstTirages.Open "Tirages", cnn, adOpenDynamic, adLockOptimistic
                rstTirages.AddNew
                rstTirages.Fields("Tirage") = Val(a(0))
                rstTirages.Fields("Date") = #1/1/1000#
                rstTirages.Fields("Date") = DateAdd("d", CDbl(Mid(a(2), 7, 2)) - 1, rstTirages.Fields("Date"))
                rstTirages.Fields("Date") = DateAdd("m", CDbl(Mid(a(2), 5, 2)) - 1, rstTirages.Fields("Date"))
                rstTirages.Fields("Date") = DateAdd("yyyy", CDbl(Mid(a(2), 1, 4)) - 1000, rstTirages.Fields("Date"))
                rstTirages.Fields("B1") = Val(a(4))
                rstTirages.Fields("B2") = Val(a(5))
                rstTirages.Fields("B3") = Val(a(6))
                rstTirages.Fields("B4") = Val(a(7))
                rstTirages.Fields("B5") = Val(a(8))
                rstTirages.Fields("E1") = Val(a(9))
                rstTirages.Fields("E2") = Val(a(10))
                rstTirages.Update
            End If
            rstTirages.Close
            ' check the rapports table
            rstRapports.Open "SELECT * FROM Rapports Where Tirage=" & a(0), cnn, adOpenDynamic, adLockOptimistic
            If rstRapports.EOF Then
                ' add this one
                Application.StatusBar = "Adding RAPPORTS " & a(0) & " date " & a(2)
                rstRapports.Close
                rstRapports.Open "Rapports", cnn, adOpenDynamic, adLockOptimistic
                rstRapports.AddNew
                rstRapports.Fields("Tirage") = Val(a(0))
                rstRapports.Fields("Date") = #1/1/1000#
                rstRapports.Fields("Date") = DateAdd("d", CDbl(Mid(a(2), 7, 2)) - 1, rstRapports.Fields("Date"))
                rstRapports.Fields("Date") = DateAdd("m", CDbl(Mid(a(2), 5, 2)) - 1, rstRapports.Fields("Date"))
                rstRapports.Fields("Date") = DateAdd("yyyy", CDbl(Mid(a(2), 1, 4)) - 1000, rstRapports.Fields("Date"))
                rstRapports.Fields("nbrR1") = Val(a(14))
                rstRapports.Fields("rapR1") = Val(a(15))
                rstRapports.Fields("nbrR2") = Val(a(17))
                rstRapports.Fields("rapR2") = Val(a(18))
                rstRapports.Fields("nbrR3") = Val(a(20))
                rstRapports.Fields("rapR3") = Val(a(21))
                rstRapports.Fields("nbrR4") = Val(a(23))
                rstRapports.Fields("rapR4") = Val(a(24))
                rstRapports.Fields("nbrR5") = Val(a(26))
                rstRapports.Fields("rapR5") = Val(a(27))
                rstRapports.Fields("nbrR6") = Val(a(29))
                rstRapports.Fields("rapR6") = Val(a(30))
                rstRapports.Fields("nbrR7") = Val(a(32))
                rstRapports.Fields("rapR7") = Val(a(33))
                rstRapports.Fields("nbrR8") = Val(a(35))
                rstRapports.Fields("rapR8") = Val(a(36))
                rstRapports.Fields("nbrR9") = Val(a(38))
                rstRapports.Fields("rapR9") = Val(a(39))
                rstRapports.Fields("nbrR10") = Val(a(41))
                rstRapports.Fields("rapR10") = Val(a(42))
                rstRapports.Fields("nbrR11") = Val(a(44))
                rstRapports.Fields("rapR11") = Val(a(45))
                rstRapports.Fields("nbrR12") = Val(a(47))
                rstRapports.Fields("rapR12") = Val(a(48))
                rstRapports.Update
            End If
            rstRapports.Close
        Loop
        Application.StatusBar = "Import done, " & CStr(Count) & " new tirages."
    End If
    rstTirages.Close
    rstRapports.Close
End Sub

Commentaire de jeff_montois le 06/03/2006 18:48:55

Je suis intérressé par ce prog également est ce que tu pourrais m'envoyer l'exe ou me dire cmt l'ouvrir car je suis en VB6 et non .net!!!