Soyez le premier à donner votre avis sur cette source.
Snippet vu 8 830 fois - Téléchargée 19 fois
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
en utilisant le «Document Model Object» (DOM pour les intimes)
ce serait trop simple %)
Initié !!!
Deplus, préfère toujours les Expressions régulières aux recherches "en pur et dur", c'est toujours plus rapide
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.