Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresConnexion

begin process at 2009 01 08 06:17:08

3 ARTICLES SUR SQL SERVER (DATA STRUCTURES, SCANS AND SEEKS, DATA ACCESS STRATEGIES) par RaptorXP

MAIS QUE PEUT BIEN FAIRE UN MVP QUAND IL NE CODE PAS ??? par sebmafate

POWERSHELL : COMMENT EXéCUTER UN SCRIPT PS DEPUIS UNE FENêTRE MS DOS OU SCHEDULED TASK par ROMELARD Fabrice

EDM DESIGNER par Matthieu MEZIL

SMALL BASIC - UN PROJET INTéRESSANT par pierrick

RE : COLLECTION par Orohena

REMPLIR DATAGRID EN 2 TABLE VB.NET par tdi2a

RE : COLLECTION par skyla

RE : POURQUOI ISEMPTY(VBEMPTY) RENVOI FALSE ??? par PCPT

+ de logiciels à télécharger

1 329 724 membres
71 nouveaux aujourd'hui
14 640 membres club

Trouver une ressource

Trouvez une ressource parmi 39 269 codes, 1 222 798 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

RECUPERATION D INFORMATION DEPUIS UNE PAGE WEB

Information sur la source

Catégorie :Trucs & Astuces Classé sous : internet, donnees, texte, fichiers, recuperation Niveau : Initié Date de création : 14/04/2007 Vu : 4 951

Auteur : capricorne83

Ecrire un message privé

Note :

1,00 / 10

Commentaire sur cette source (2)

Ajouter un commentaire et/ou une note

Description

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

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

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.

Sources du même auteur

ENREGISTRER UNE JAQUETTE VIDEO (OU TOUTE AUTRE IMAGE C EST L...

PROCÉDÉ DE RÉCUPÉRATIONS DES INFOS DEPUIS ALLOCINE.FR

VISUAL BASIC 6 ET CRYSTAL REPORT 8.5

TRAITEMENT DES PHOTOS (PAR REPERTOIRE)

CONNEXION "A CHAUD" SUR UNE AUTRE BASE DE DONNÉES

Toutes les sources de capricorne83

Sources de la même categorie

CONVERTION VB6-VB5 par Galactus13

TABLEAU INITIALISE par CGSI3

PAGE DE TRAVAIL SOUS EXCEL par MotorsV10

ISOLATOR - GÉNÉREZ LES FICHIERS .MANIFEST POUR VOS EXE, DLL ... par Renfield

CONTROLE DE LA BARRE DES TACHES A DISTANCE par djgab21

Toutes les sources de la catégorie Trucs & Astuces

Sources en rapport avec celle ci

GESTION VIDÉO par mich95

RÉCUPÉRATION D'INFOS DE FILM par mich95

MANIPULATEUR DE FICHIERS par MALIKcpp

LIVE (( TRAITEMENT DE TEXTE )) par crossblade

AH VALA UN BON EDITEUR DE TEXTE : NODE EDITOR (PETITE MISE A... par Zeratul456

Commentaires et avis

Commentaire de FREMYCOMPANY le 14/04/2007 17:58:27

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

Commentaire de DarkVader le 16/04/2007 08:57:17

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é !!!

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

Recuperation de donnees XML sur internet [ par Hebut ] Bonjour.Je suis debutant en prog vb6 et je dois recuperer des donnees internet en xml afin de les stocker dans une base access.Si quelqu un a une solu CGI/internet Pour les BIG STARS [ par bill ] je veux envoyer un texte(flux de donnee)avec INET.EXECUTE a un CGI.probleme avec la Methode GET Si le texte trop Grand il est tronqueDonc il faut veux HELP POUR GRAPHIQUE ET RECUPERATION DE DONNEES [ par julien62 ] SALUTsi un utilisateur inscris des chiffres dans des cases d'un formulaire VBA, comment puis je recuperer ces dernieres et les utilisees pour faire un NIIIIX !! A L'AIDE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ par LeKamé ] Tu voit je créé un application, un petit jeu...koi !!bon !!Ne ME DEMANDE PAS CE QUE JE CRéE OU PKOI JE FAIT CA !!! CAR CA SERAIS TROP LONG A EXPLIQUER Comment traiter de gros fichiers texte ? [ par holger ] Je cherche à traiter des fichiers de 1 voir plusieurs Mégas.Comment puis-je faire ? Comment traiter de gros fichiers texte ? [ par holger ] Je cherche à traiter des fichiers de 1 voir plusieurs Mégas.Comment puis-je faire ? Gestion fichiers Internet [ par Christophe ] Est-il possible par un programme Vb d'effacer les fichiers temporaires, l'historique d'Internet Explorer et de plus fermer toutes les fenêtres explore Comparer le contenu de 2 fichiers texte [ par steph ] bonjour Comment faire pour comparer le contenu de 2 fichiers texte?? En fait je souhaiterais faire la meme chose que le diff de unix ou le fc de do VITE J'ai besoin de toi !!!!! [ par bouboussjunior ] Bonjour a tous !!j'aimerai comparer 2 fichiers texte de contenu différent pour obtenir les différences dans un troisieme fichier. pour sa j'ai importe Patage de fichiers par internet [ par kloo ] bonjour,j'aimerais savoir s'il y a moyen et comment faire pour permettre le partage de fichier a distance via internet : exemple, j'ouvre un prog chez