Datamoviecapt (capturer les infos d'un film sur allocine.com)

Télécharger le projet
Commenter

Description

Ce petit programme extrêmement perfectible permet de recuperer les infos de la fiche d'un film provenant du site www.allocine.com. C'est juste un petit bout de programme qui provient d'un autre soft fait par mes soins qui peut etre testé sur

http://perso.wanadoo.fr/indiana.jones/Test/Index.htm

Source / Exemple : 


'========================
'DataMovieCapt
'Version 1.00 - Freeware
'Datée du 02/01/2003
'(c) Indi59
'indianajones59@msn.com
'========================
'CONTROLE NECESSAIRE
'WebBrowser et Inet
'========================

'Le caption du form est mis à jour avec la page web en cours
Private Sub WebBrowser1_DownloadComplete()
    On Error Resume Next
     Me.Caption = "Chargement Terminé " & WebBrowser1.LocationURL
pret = True
End Sub

'Attente que la page web soit affichée completement
Private Sub webAttente()
c = 0
Do
c = c + 1
If WebBrowser1.Busy = False Then Exit Do
If c >= 50000 Then WebBrowser1.Stop: Exit Do
Loop
End Sub

'Mettre a ajour le webbrowser avec l'adresse du text2.txt
Private Sub CmUpdate()

Dim sURL As String
                 
 WebBrowser1.Stop
 WebBrowser1.Navigate Text2
 webAttente

Text1.Text = ""
Debut:
Text1.Text = WebBrowser1.Document.All(0).outerHTML
End Sub

'vider les champs de la fiche du film
Private Sub VideFiche()
Text4 = ""
Text7 = ""
Text11 = ""
Text10 = ""
Text9 = ""
Text8 = ""
Text5 = ""
Text6 = ""
End Sub

Public Function VireBlanc(texte As String) As String
mot = ""
For i = 1 To Len(texte)
If Mid$(texte, i, 1) = " " Then GoTo suite
mot = mot + Mid$(texte, i, 1)
suite:
Next i
VireBlanc = mot
End Function

Private Sub ChoixDeCommand3() 'AlloCiné
Dim txt As String
Dim origine As String
Dim genre As String
Dim duree As String
Dim DateSortie As String
Dim syno As String
Dim synofilm As String
Dim synofilm2 As String
Dim txtacteur As String
Dim RefActeurTemp As String
Dim RealFilm As String
VideFiche
CmUpdate

Text4 = UCase(LireChaine("<TITLE>AlloCiné - Film : ", "</TITLE>", Text1, 1))
Text4.ToolTipText = Text4

txt = LireChaine("Film&nbsp;", "</TD></TR>", Text1, 1)
origineFilm = LireChaine("<FONT Class=size2>", "</FONT>", txt, 1)
annee = LireChaine(" (", ").", txt, 1)
genreFilm = LireChaine("<FONT Class=size2>", "</FONT>", txt, 2)
duree = LireChaine("Durée&nbsp;:&nbsp;", "mn.", txt, 1)
dureefilm = VireBlanc(duree)
If Len(dureefilm) = 2 Then dureefilm = "0h" + dureefilm
txt = LireChaine("Date de sortie&nbsp;:&nbsp;</FONT><FONT class=size2", "</TBODY>", Text1, 1)
DateSortieFilm = LireChaine(">", "</FONT></TD>", txt, 1)
txtacteur = LireChaine("Class=titreDescription>Avec&nbsp;</FONT>", "Plus...", txt, 1)
nr = 0
Do
nr = nr + 1
reflienacteur = LireChaine("gen_cpersonne=", ".html", txtacteur, nr)
If reflienacteur = "NR" Then Exit Do
RefActeur = LireChaine(reflienacteur + ".html"">", "</A>", txtacteur, 1)
RefActeur = Replace(RefActeur, "&nbsp;", " ")
TotalActeur = TotalActeur + RefActeur + ";"
Loop
If Len(TotalActeur) = 0 Then TotalActeur = "NR"
Text7 = TotalActeur
txtacteur = LireChaine("Réalisé par", "/A></TD>", txt, 1) 'Réalisateur
RealLienFilm = LireChaine("gen_cpersonne=", ".html", txtacteur, 1)
tt = LireChaine(RealLienFilm + ".html"">", "<", txtacteur, 1)
RealFilm = Replace(tt, "&nbsp;", " ")
If InStr(1, RealFilm, "</A>") <> 0 Then
ou = InStr(1, RealFilm, "</A>")
RealFilm = Mid$(RealFilm, 1, ou - 1)
End If
txt = LireChaine("Synopsis", "/FONT></DIV></TD>", Text1, 1)
syno = "<DIV align=justify><FONT class=size2>"
synofilm = LireChaine(syno, ".<", txt, 1)
synofilm = synofilm + "."
synofilm = Replace(synofilm, "<I>", "")
synofilm = Replace(synofilm, "</I>", "")
synofilm = Replace(synofilm, "<B>", "")
synofilm = Replace(synofilm, "</B>", "")
'Mise en place des champs
Text11 = RealFilm
Text10 = annee
Text9 = UCase(origineFilm)
Text8 = synofilm + " - SORTIE EN FRANCE : " + DateSortieFilm 'résumé
Text5 = genreFilm 'genre
Text6 = UCase(dureefilm)
End Sub

Private Sub form_load()
If TestConnect("www.yahoo.fr") = False Then
MsgBox "Il me semble que vous n'êtes pas connecté à Internet...", vbCritical + vbOKOnly, "Attention"
End If
CmUpdate
End Sub

Private Sub Image7_Click()
ChoixDeCommand3
End Sub

Public Function Calculate(depart As Integer, strString As String, mot As String) As Integer
       On Error Resume Next
       Calculate = InStr(depart, strString, mot, vbTextCompare)
End Function

'Tester la connection internet avec le site www.yahoo.fr
Public Function TestConnect(Url As String) As Boolean
        InetTest.Cancel
        With InetTest
                .AccessType = icUseDefault
                .Protocol = icHTTP
                moi = .OpenURL(Url, icString)
                Do Until .StillExecuting = False
                  DoEvents
                Loop
        End With
If Len(moi) = 0 Then TestConnect = False Else TestConnect = True
End Function

Public Function LireChaine(EntreMot1 As String, EntreMot2 As String, DansTxt As String, Saut) As String
Dim decal As Integer
cp = 0: decal = 0
dep:
If decal = 0 Then decal = 1
calcu1 = Calculate(decal, DansTxt, EntreMot1)
cp = cp + 1
If cp <> Saut Then decal = calcu1 + 1: GoTo dep
If calcu1 = 0 Then LireChaine = "NR": Exit Function
calcu2 = Calculate(Int(calcu1), DansTxt, EntreMot2)
If calcu2 = "0" Then LireChaine = "NR": Exit Function
LireChaine = Mid(DansTxt, calcu1 + Len(EntreMot1), (calcu2 - (calcu1 + Len(EntreMot1))))
End Function

Conclusion :


Sans doute pas un modèle de programmation mais ça marche pas trop mal

http://perso.wanadoo.fr/indiana.jones/Test/Index.htm
Télécharger le projet

Codes Sources

A voir également

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 (indianajones59)