1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Recuperation d information depuis une page web

Recuperation d information depuis une page web

4/5 (2 avis)

Snippet vu 9 233 fois - Téléchargée 21 fois

Commenter

Contenu du snippet

Sans avoir accès au serveur d un site, il y a au moins un moyen de récupérer les informations dont on a besoin. On sait qu'il est possible d'obtenir (sauf pour les pages en ASP et PHP ou tout au moins la totalité )le code source de la page. Si on a le source il suffit d'enregistrer ce source comme un fichier texte et ensuite de le parcourir à volonté pour en récupérer les infos. Bon c'est pas parfait je sais..si le site change sa structure de page..c est mort.....!!! mais c est mieux que rien..je m en sers pour recuperer des informations concernant un film pour mon logiciel de gestion de videotheque....... Donc sur une fenetre j'ai mis un composant Web (WebBrowser) avec les differents boutons necessaires à la navigation et je transfere ensuite les donnees recuperees vers la fenetre d'enregistrement des donnees.

Source / Exemple : 


Private Sub CmdRecuperer_Click()

On Error GoTo gestionerreur

MousePointer = vbHourglass
TextPageInternet.Text = WebBrowser.LocationURL

'Elements lies au navigateur integre dans la fenetre
Text1.Text = TextTitreFilm.Text
If TextTitreFilm.Text <> "" Then
    TitreFilm = Replace(TextTitreFilm.Text, " ", "_")
    TitreFilm = Replace(TextTitreFilm.Text, "?", "")
    TitreFilm = Replace(TextTitreFilm.Text, "-", " ")
    TitreFilm = TitreFilm & ".txt"
    nomfichier = "c:\program files\videotheque\fiche_film_" & TitreFilm
End If
If ComboRealisateur <> "" Then
    TitreFilm = Replace(ComboRealisateur, " ", "_")
    TitreFilm = TitreFilm & ".txt"
    nomfichier = "c:\program files\videotheque\fiche_Realisateur_" & TitreFilm
End If
If ComboFilms.Text <> "" Then
    TitreFilm = Replace(ComboFilms.Text, " ", "_")
    TitreFilm = Replace(ComboFilms.Text, "?", "")
    TitreFilm = Replace(ComboFilms.Text, "-", " ")
    TitreFilm = TitreFilm & ".txt"
    nomfichier = "c:\program files\videotheque\fiche_film_" & TitreFilm
End If

'TextTitreFilm.Text = ""

Open nomfichier For Output As #1
    codesrc = WebBrowser.Document.documentElement.innerHTML 'recupération du codesrc
    Print #1, codesrc
Close #1

Open nomfichier For Input As #1
'test en dur
'Open "c:\program files\videotheque\fiche_film_JFK.txt" For Input As #1
    

'**********************************
'dans l'ordre Les Infos Necessaires
'**********************************
' titre, commentaire, date sortie, affiche, realisateur, acteurs, genre, duree, interdiction
' pour l'affiche ca ne fonctionne pas donc je laisse tomber

'pour le titre
Do While EOF(1) = False
    Line Input #1, valeur
    chainearechercher = "<HEAD><TITLE>"
    trouve = InStr(valeur, chainearechercher)
    If trouve Then
        Position = 14
        Do Until caractere = ">"
            caractere = Mid(valeur, Position, 1)
            If caractere = "<" Then Exit Do
            titre = titre + caractere
            Position = Position + 1
        Loop
        If titre <> ComboFilms.Text Then
            titre = Replace(titre, "'", " ")
            TextNouveauTitre.Text = titre
        End If
        Exit Do
    End If
Loop
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, ":", " ")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "ê", "e")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "é", "e")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "ê", "e")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "î", "i")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "û", "u")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "ô", "o")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, ".", " ")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "-", " ")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "â", "a")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "ç", "c")
TextNouveauTitre.Text = Replace(TextNouveauTitre.Text, "'", " ")

Close #1
Open nomfichier For Input As #1

' pour le commentaire
Do While EOF(1) = False
    Line Input #1, valeur
    chainearechercher = "<META content="""
    trouve = InStr(valeur, chainearechercher)
    If trouve Then
        Position = 16
        Do Until caractere = ">"
            caractere = Mid(valeur, Position, 1)
            If caractere = "<" Or caractere = " "" " Then Exit Do
            synopsis = synopsis + caractere
            Position = Position + 1
        Loop
        Exit Do
    End If
Loop
TextSynopsisFilm.Text = synopsis
TextSynopsisFilm.Text = Replace(TextSynopsisFilm.Text, "'", " ")
TextSynopsisFilm.Text = Replace(TextSynopsisFilm.Text, "'" & " & '", "")
TextSynopsisFilm.Text = Replace(TextSynopsisFilm.Text, ">", "")
TextSynopsisFilm.Text = Replace(TextSynopsisFilm.Text, """", "")
TextSynopsisFilm.Text = Replace(TextSynopsisFilm.Text, "<", "")
TextSynopsisFilm.Text = Replace(TextSynopsisFilm.Text, "&quote;", " ")

lettresavirer = "name=description"
longueuravirer = Len(lettresavirer)
longueuragarder = Len(TextSynopsisFilm.Text)
TextSynopsisFilm.Text = Mid(TextSynopsisFilm.Text, 1, longueuragarder - longueuravirer)

Close #1
Open nomfichier For Input As #1

' pour la date de sortie
Do While EOF(1) = False
    Line Input #1, valeur
    caractere = ""
    chainearechercher = "<H4>Date de sortie :"
    trouve = InStr(valeur, chainearechercher)
    If trouve Then
        Position = 25
        Do Until caractere = "<"
            caractere = Mid(valeur, Position, 1)
            If caractere = "<" Then Exit Do
            sortie = sortie + caractere
            Position = Position + 1
        Loop
        If IsNumeric(TextAnneeFilm.Text) = True Then
            TextAnneeFilm.Text = Right(sortie, 4)
        Else
            TextAnneeFilm.Text = "1900"
        End If
        Exit Do
    End If
Loop

Close #1
Open nomfichier For Input As #1

'realisateur
Do While EOF(1) = False
    Line Input #1, valeur
    caractere = ""
    chainearechercher = "<H4>Réalisé par <A class=link1 href"
    trouve = InStr(valeur, chainearechercher)
    If trouve Then
        Position = 78
        Do Until caractere = "<"
            caractere = Mid(valeur, Position, 1)
            If caractere = "<" Then Exit Do
            nomrealisateur = nomrealisateur + caractere
            Position = Position + 1
        Loop
        ComboRealisateur = nomrealisateur
        Exit Do
    End If
Loop

Position = 1
For q = 1 To Len(nomrealisateur)
    caractere = Mid(nomrealisateur, Position, 1)
    If caractere = ">" Then
        ComboRealisateur.Text = Mid(nomrealisateur, Position + 1)
        Exit For
    End If
    compteur = compteur + 1
    Position = Position + 1
Next

Close #1
Open nomfichier For Input As #1

'acteurs
Do While EOF(1) = False
    Line Input #1, valeur
    caractere = ""
    chainearechercher = "<H4>Avec <A class=link1 href"
    trouve = InStr(valeur, chainearechercher)
    If trouve Then
        nouvellechainearechercher = "</a>, <a class="
        If trouve Then
          Position = 78
            Do Until caractere = "<"
                caractere = Mid(valeur, Position, 1)
                If caractere = "<" Then Exit Do
                nomacteur1 = nomacteur1 + caractere
                Position = Position + 1
            Loop
            nouvelleposition = Position
            ComboActeur1.Text = nomacteur1
        End If
        
        Position = 1
        For q = 1 To Len(nomacteur1)
            caractere = Mid(nomacteur1, Position, 1)
            If caractere = ">" Then
                ComboActeur1.Text = Mid(nomacteur1, Position + 1)
                Exit For
            End If
            compteur = compteur + 1
            Position = Position + 1
        Next
        ' separation nom prenom
        positionblanc = 0
        positionblanc = InStr(1, ComboActeur1.Text, " ")
        PrenomActeur = Mid(ComboActeur1.Text, 1, positionblanc - 1)
        NomActeur = Mid(ComboActeur1.Text, positionblanc + 1)
        ComboActeur1.Text = NomActeur
        ComboPrenom1.Text = PrenomActeur
        
        valeur = Mid(valeur, nouvelleposition, Len(valeur))
        caractere = ""
        chainearechercher = "/personne/fichepersonne_gen_cpersonne="
        trouve = InStr(valeur, chainearechercher)
        If trouve Then
            Position = 78
            Do Until caractere = "<"
                caractere = Mid(valeur, Position, 1)
                If caractere = "<" Then Exit Do
                nomacteur2 = nomacteur2 + caractere
                Position = Position + 1
            Loop
            ComboActeur2.Text = nomacteur2
        End If
        
        Position = 1
        For q = 1 To Len(nomacteur2)
            caractere = Mid(nomacteur2, Position, 1)
            If caractere = ">" Then
                ComboActeur2.Text = Mid(nomacteur2, Position + 1)
                Exit For
            End If
            compteur = compteur + 1
            Position = Position + 1
        Next
        ' separation nom prenom
        positionblanc = 0
        positionblanc = InStr(1, ComboActeur2.Text, " ")
        PrenomActeur = Mid(ComboActeur2.Text, 1, positionblanc - 1)
        NomActeur = Mid(ComboActeur2.Text, positionblanc + 1)
        ComboActeur2.Text = NomActeur
        ComboPrenom2.Text = PrenomActeur
        
        valeur = Mid(valeur, nouvelleposition, Len(valeur))
        caractere = ""
        chainearechercher = "/personne/fichepersonne_gen_cpersonne="
        trouve = InStr(valeur, chainearechercher)
        If trouve Then
            Position = 70
                Do Until caractere = "<"
                    caractere = Mid(valeur, Position, 1)
                    If caractere = "<" Then Exit Do
                    nomacteur3 = nomacteur3 + caractere
                    Position = Position + 1
                Loop
                ComboActeur3.Text = nomacteur3
        End If
        Position = 1
        For q = 1 To Len(nomacteur3)
            caractere = Mid(nomacteur3, Position, 1)
            If caractere = ">" Then
                ComboActeur3.Text = Mid(nomacteur3, Position + 1)
                Exit For
            End If
            compteur = compteur + 1
            Position = Position + 1
        Next
        ' separation nom prenom
        positionblanc = 0
        positionblanc = InStr(1, ComboActeur3.Text, " ")
        PrenomActeur = Mid(ComboActeur3.Text, 1, positionblanc - 1)
        NomActeur = Mid(ComboActeur3.Text, positionblanc + 1)
        ComboActeur3.Text = NomActeur
        ComboPrenom3.Text = PrenomActeur
        
        
    Else
        t = 1000 ' variable bidon
    End If
Loop

Close #1
Open nomfichier For Input As #1

' pour le Genre
Do While EOF(1) = False
    Line Input #1, valeur
    caractere = ""
    chainearechercher = "<H4>Genre : <A class=link1 href="
    trouve = InStr(valeur, chainearechercher)
    If trouve Then
        Position = 85
        Do Until caractere = "<"
            caractere = Mid(valeur, Position, 1)
            If caractere = "." Or caractere = "," Then Exit Do
            genre = genre + caractere
            Position = Position + 1
        Loop
    Exit Do
    End If
Loop
TextGenreFilm.Text = genre

Close #1
Open nomfichier For Input As #1

'duree
Do While EOF(1) = False
    Line Input #1, valeur
    caractere = ""
    chainearechercher = "<H4>Durée :"
    trouve = InStr(valeur, chainearechercher)
    If trouve Then
        Position = 13
        Do Until caractere = "<"
            caractere = Mid(valeur, Position, 1)
            If caractere = "m" Then Exit Do
            duree = duree + caractere
            Position = Position + 1
        Loop
    Exit Do
    End If
Loop

duree = Replace(duree, ":", "")
duree = Replace(duree, "<", "")
duree = Replace(duree, ".", "")
duree = Replace(duree, " ", "")
valeurheure = Mid(duree, 1, 2)
If IsNumeric(valeurheure) = False Then
    valeurheure = "0" & Mid(valeurheure, 1, 1)
End If
duree = Replace(duree, "h", "")
valeurminute = Mid(duree, 2, 3)
If valeurminute = "" Then valeurminute = "00"
If IsNumeric(valeurminute) = False Then
    valeurminute = "0" & Mid(valeurminute, 1, 1)
End If
valeurminute = Replace(valeurminute, "h", "0")
If Len(valeurminute) = 1 Then valeurminute = "0" & valeurminute
duree = valeurheure & ":" & valeurminute

TextDureeFilm.Text = duree

Close #1
Open nomfichier For Input As #1

'interdiction eventuelle
Do While EOF(1) = False
    Line Input #1, valeur
    caractere = ""
    chainearechercher = "Interdit aux moins de"
    trouve = InStr(valeur, chainearechercher)
    If trouve Then
        Position = trouve
        Do Until caractere = "<"
            caractere = Mid(valeur, Position, 1)
            If caractere = "<" Then Exit Do
            interdiction = interdiction + caractere
            Position = Position + 1
        Loop
        Exit Do
    Else
        interdiction = ""
    End If
Loop

If interdiction = "" Then interdiction = "Aucune"
ComboRestriction.Text = interdiction

t = MsgBox("Récupération des éléments terminée", vbOKOnly, "Videotheque")
Nom = ""

Close #1

' je vire le fichier texte crée "temporairement"
Kill nomfichier
CmdRecherche.Enabled = True
If ComboFilms.Text <> "" Then
    CmdMiseaJour.Enabled = True
Else
    CmdOk.Enabled = True
End If

CmdRecuperer.Enabled = False
MousePointer = vbNormal
Exit Sub

gestionerreur:
Select Case Err.Number
    Case 5
        Z = MsgBox("Récupération via Internet impossible. Vous devez enregistrer ce Film manuellement", vbCritical, "Videothèque")
        CmdOk.Enabled = False
        CmdRecuperer.Enabled = False
        CmdMiseaJour.Enabled = False
        MousePointer = vbNormal
        Exit Sub
    Case Else
        Z = MsgBox("Erreur Inconnue. Vous devez enregistrer ce Film manuellement", vbCritical, "Videothèque")
        CmdOk.Enabled = False
        CmdRecuperer.Enabled = False
        CmdMiseaJour.Enabled = False
        MousePointer = vbNormal
        Exit Sub
End Select

End Sub

Conclusion :


il y a au moins deux bugs de connus..a savoir : 1) pour la recuperation de la date de sortie du film.....je l ai pas encore corrige. l'autre est plus genant puisqu'il concerne en general le prenom du second acteur (la premiere lettre est ignoree dans certains cas). Je reste a la disposition de qui veut pour apporter les precisions necessaires.

A voir également

Ajouter un commentaire Commentaires
cs_DarkVader Messages postés 51 Date d'inscription samedi 21 octobre 2000 Statut Membre Dernière intervention 10 octobre 2011
16 avril 2007 à 08:57
Cela s'appelle réinventer le fil à couper le beurre -
en utilisant le «Document Model Object» (DOM pour les intimes)
ce serait trop simple %)

Initié !!!
FREMYCOMPANY Messages postés 276 Date d'inscription jeudi 12 janvier 2006 Statut Membre Dernière intervention 22 décembre 2008
14 avril 2007 à 17:58
Pour ma part je ne passe pas par un webbrowser, trop lent, mais bien par MSXML2.XMLHTTPREQUEST60 (voir composants COM de ta machine)

Deplus, préfère toujours les Expressions régulières aux recherches "en pur et dur", c'est toujours plus rapide
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (capricorne83)