Webscraper : pillez le web avec modération !

Soyez le premier à donner votre avis sur cette source.

Vue 6 739 fois - Téléchargée 767 fois

Description

C'est un petit bout de code pour récupérer des infos sur une page web. Il est possible de parser (décomposer élément par élément) correctement une page HTML (ou mieux : XML) à condition quelle soit bien structurée. En l'occurrence, je ne fais que rechercher bêtement du texte dans la page, avec pour exemple, la récupération de la note d'un film sur imdb (HTML sans structure affirmée). C'est simple, mais cela permet de faire des récupérateurs automatiques plus puissants pour alimenter des bases de données (recommandation : pillez le web avec modération quand même :-)

Source / Exemple :


Nouveau (en plus du projet VB dans le fichier zip) : une mise en oeuvre sur plusieurs pages HTMl successives dans DVDClass :
DVDCLASS : UN COMPILATEUR DE CRITIQUES DE DVD 
www.vbfrance.com/article.asp?Val=2313

modification du code VB en Access VBA dans un Formulaire WebScraper : 

Option Compare Database

' Variables globales
Dim bFinNavigation As Boolean, bMajEnCours As Boolean
Dim bEchec As Boolean
Dim rNote!, sInfos$

Private Sub CmdWebScraper_Click()
    
    ' Si bMajEnCours on interromp la mise à jour
    If bMajEnCours Then bMajEnCours = False: Exit Sub
    
    'WebBrowser1.Offline = True
    
    CmdWebScraper.Caption = "Stop"
    bMajEnCours = True
    
    Dim sSQL$, Rq As Recordset, sWeb$
    Dim iNbEchecs%, sListeEchecs$
    Dim i%, iNbFilmsImdb%
    
    sSQL = "SELECT Oeuvre.Oeuvre, Oeuvre.Web, Vote.Vote" & _
" FROM Votant INNER JOIN (Oeuvre INNER JOIN Vote ON Oeuvre.IdOeuvre = Vote.IdOeuvre) ON Votant.IdVotant = Vote.IdVotant" & _
" WHERE Oeuvre.Web Like 'www.imdb.com/*' AND Votant.Surnom='IMDB';"
    'Oeuvre.Web<>'nul'
    'Oeuvre.Oeuvre Like 's*' AND
    
    Set Rq = CurrentDb.OpenRecordset(sSQL)
    
    If Not (Rq.BOF And Rq.EOF) Then
        Rq.MoveLast
        iNbFilmsImdb = Rq.RecordCount
        Rq.MoveFirst
    End If
    
    LblInfos.Caption = "..."
    
    While Not Rq.EOF
    
        i = i + 1
        'LblInfos.Caption = i & " / " & iNbFilmsImdb
    
        bEchec = False
        bFinNavigation = False
        rNote = -1
        sInfos = ""
        
        sWeb = sLireLienIMDB(Nz(Rq!Web), , bFranciserIMDB:=True)
        'MsgBox sWeb
        WebBrowser1.Navigate sWeb
        
        While Not bFinNavigation
            If Not bMajEnCours Then GoTo Fin
            DoEvents
        Wend
        
        If bEchec Then
            'Stop
            iNbEchecs = iNbEchecs + 1
            sListeEchecs = sListeEchecs & sWeb & " "
        End If
        
        LblInfos.Caption = i & " / " & iNbFilmsImdb & " : " & sInfos
        
        If rNote > -1 And rNote <> Nz(Rq!Vote, -1) Then
            Rq.Edit
                Rq!Vote = rNote
            Rq.Update
        End If
        
        Rq.MoveNext
    Wend
    
Fin:
    Rq.Close
    If i = iNbFilmsImdb Then
        MsgBox "Mise à jour terminée !"
        
    Else
        MsgBox "Mise à jour interrompue !"
    End If
    If iNbEchecs > 0 Then MsgBox "Nombre d'échecs : " & iNbEchecs & vbLf & sListeEchecs
    CmdWebScraper.Caption = "Go !"

End Sub

Private Sub Form_Load()
    LblInfos.Caption = ""
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    
    Dim doc As IHTMLDocument2
    On Error Resume Next
    Set doc = WebBrowser1.Document
    If Err Then Exit Sub
    
    ' Un appel est généré lors du chargement du formulaire
    If doc.Title = "Impossible de trouver le serveur" Then GoTo Echec
    
    ' La pub génère un appel parasite
    If Left$(URL, 20) <> "http://www.imdb.com/" Then Exit Sub
    
    Dim sTxt$, iPosG%, iPosD%, iNbCar%, sAutresTitres$
    Dim Quote As IHTMLElement
    sAutresTitres = "Pas d'autres titres"
    Set Quote = doc.body
    sTxt = Quote.innerText
    Const sTxtNote$ = "User Rating:"
    iNbCar = Len(sTxtNote)
    iPosG = InStr(sTxt, sTxtNote)
    If iPosG = 0 Then GoTo Echec
    iPosD = InStr(iPosG, sTxt, "/10")
    If iPosD = 0 Then GoTo Echec
    sNote = Trim$(Mid$(sTxt, iPosG + iNbCar, iPosD - iPosG - iNbCar))
    Const sTxtAKA$ = "Also Known As:"
    Const sTxtRuntime$ = "Runtime:"
    iNbCar = Len(sTxtAKA)
    iPosG = InStr(sTxt, sTxtAKA)
    If iPosG = 0 Then GoTo Fin
    iPosD = InStr(iPosG, sTxt, sTxtRuntime)
    If iPosD = 0 Then GoTo Fin
    sAutresTitres = Trim$(Mid$(sTxt, iPosG + iNbCar, iPosD - iPosG - iNbCar))
    
Fin:
    sInfos = "URL : " & URL & " :" & vbCrLf & _
        "Titre : " & doc.Title & vbCrLf & _
        "Note : " & sNote & "/10"
        '"Autres titres : " & sAutresTitres
    'MsgBox sInfo
    bFinNavigation = True
    rNote = Val(sNote)
    Exit Sub
        
Echec:
    bEchec = True
    Exit Sub
        
End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
5
Date d'inscription
jeudi 25 septembre 2003
Statut
Membre
Dernière intervention
25 mars 2004

ok merci quand même ;)
par contre, ça pourrait intéresser pas mal de personnes un ptit exemple avec le moteur Gecko, vu le nombre de messages concertant IeWebbrowser :)

@+
Messages postés
1222
Date d'inscription
jeudi 23 août 2001
Statut
Membre
Dernière intervention
9 septembre 2018

Ben c'est que je n'ai plus bcp de tps en ce moment, et en plus, je connais quelqu'un qui avait un robot fonctionnant avec les technologies linux (mozilla et Gecko) qui ne marchent plus sur imdb, car imdb est parvenu à bloquer ses requetes automatiques ; par contre, mon webscraper fonctionne tjrs sur imdb, donc j'ai pas trop envie de changer de techno.
Messages postés
5
Date d'inscription
jeudi 25 septembre 2003
Statut
Membre
Dernière intervention
25 mars 2004

J'ai fait un programme du même genre (récupération d'un texte dans une page web) avec le webbrowser, et j'essaye de l'accélérer.

Sur ce site, on trouve un activeX Mozilla qui utilise strictement les mêmes méthodes et propriétés que IEWebbrowser, mais qui fonctionne avec le moteur de rendu Gecko bien plus rapide.
http://www.iol.ie/~locka/mozilla/mozilla.htm

Personellement, je bloque sur la récupération du HTMLDocument mais il semble que ça soit possible.
Comme tu semble plus expérimenté, tu pourrais certainement arriver à convertir ta source avec l'autre ActiveX.
Tout le monde pourrait en profiter :D !!! ;)
Messages postés
1222
Date d'inscription
jeudi 23 août 2001
Statut
Membre
Dernière intervention
9 septembre 2018

Attention : on m'a signalé récemment qu'IMDB n'acceptait pas les robots sur son site, c'est proscrit dans sa charte d'utilisation. Et c'est normal, car si tout le monde faisait la même chose, les performances du site pourraient en pâtir !
Donc évitez SVP les robots du type WebScraper là où ils ne sont pas les bienvenus !
Messages postés
24
Date d'inscription
lundi 30 septembre 2002
Statut
Membre
Dernière intervention
17 juillet 2003

Le prog que sa m'a permis d'améliorer est sur cette page: http://www.vbfrance.com/article.aspx?Val=9544
Afficher les 7 commentaires

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.