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, ""e;", " ")
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.
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.