Ocx allocine (info complete + miniature)

Soyez le premier à donner votre avis sur cette source.

Vue 10 526 fois - Téléchargée 1 549 fois

Description

Maj:

Suite a plusieurs demande Privée, l'ocx a été retravaillé suite au changements de formatage du site d'allociné.
Malheuresement l'affiche n'est plus a disposition sur allociné, donc on peu récuperer la miniature simplement...
Aucun bug apparent, mais il reste à réglé qq gestion d'erreur au cas ou le champ extrait n'est pas disponible sur le site...
++

Tout est dans le titre, comme je me Dev une petit appli de gestion de film, j'ai transformé ma source de recupération d'information et d'affiche depuis le site d'allociné...

J'ai au passage corrigé qq bugs notament au niveau du téléchargement de l'affiche du film.

Pour l'utilisation c'est trés simple :

1. La commande : Allocine1.Search "Titre" permet de lancer une recherche sur le moteur d'allociné
2. L'event : Allocine1_ReponseRecherche(Liste As String) recoit la liste des reponse avec pour séparateur Vbcrlf
3. La commande : Allocine1.AfficheInfo "Titre" permet de lancer la recherche des infos depuis le titre recupérer dans l'event ReponseRecherche
4. L'event : Allocine1_AfficheInfo(Titre As Variant, Synopsis As Variant, ..., Miniature As stdole.StdPicture) permet de recupérer les infos texte et l'affiche miniature du film

Pour le reste :

L'event : Allocine1_Progression(Progress As Long, Total As Long, Pourcent As Integer) renvoie la progression en cours de l'opération, le total de l'opération, et le pourcentage). apparement ce n'est pas trés stable car les données revoyer par le webbrowser sont parfois bizarre....

L'event : Allocine1_Evenement(Operation As String) renvoie l'operation en cours du controle "Recherche des infos pour : xxxxx", "55 reponses", etc...

La commande : Allocine1.EnregistrerAfficheSous (Path as string) permet de telecharger l'affiche du film et non la miniature quand elle est disponible....

Source / Exemple :


Voir Zip + Capture

Conclusion :


Aprés plusieurs éssaie l'ocx me parait stable, il apparait parfois qq probléme aparement sur d'ancien film certainement du au formatage du site allociné.

J'ai joint un exemple d'utilisation du controle, ainsi que la source et l'ocx compilé....

Voila j'espére que ça vous sera utile, avec ce controle faire une Bdd de Film perso devient un jeu d'enfant....

++

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
2
Date d'inscription
lundi 20 août 2007
Statut
Membre
Dernière intervention
6 novembre 2011

Bonjour,

J'ai essayé cette source, car je suis nioubie, j'essaie de comprendre la recup de données web.
Ce projet ne fonctionne plus, j'ai bien réussi à modifié "table",
mais je sèche sur nb1...
j'ai remarqué que l'url du film est récupérée 2 fois dans le tableau,
il faudrait sauter le premier lien, et dans la liste d'affichage des films trouvés, on se retrouve
avec le lien image.
Bref, il manque une instruction pour ignorer le premier "href=" et passer au suivant, mais je suis infichue de la faire au niveau ou j'en suis.
j'ai bien ouvert quelques msgbox pour voir les valeurs de i, et nb1, mais ça m'aide pas, lol.
Auriez-vous une mise à jour plus récente, et je suis interessée aussi pour la méthode d'enregistrement en BDD.
Cordialement.
Messages postés
106
Date d'inscription
mercredi 29 novembre 2006
Statut
Membre
Dernière intervention
9 octobre 2009

Bonjour!

Je up la source après un an! lol
Excellente cette OCX! deux - trois bugs vraiment minuscule mais vraiment efficace! C'est grâce à ce genre d'aide que des gens comme moi parviennent à gagner du temps précieux! merci beaucoup!

;-)
Messages postés
50
Date d'inscription
vendredi 6 août 2004
Statut
Membre
Dernière intervention
16 janvier 2015

Salut pcpunch!
J'utilise ta source depuis un certain temp et j'ai fait quelque modif:

'---------------------------------------------------------------------------
'Synopsis
Nb1 = InStr(1, CodeSrc, "
")
nb2 = InStr(Nb1, CodeSrc, "")
Nb1 = InStr(nb2, CodeSrc, "
")
tmp = Mid(CodeSrc, nb2, Nb1 - nb2)
'suppresion des balises
tmp = Replace(tmp, "", "")
tmp = Replace(tmp, "", "")
tmp = Replace(tmp, "", "")
tmp = Replace(tmp, "
", vbCrLf)
tmp = Replace(tmp, "", Chr(34))
tmp = Replace(tmp, "", Chr(34))
If tmp ">" Then Synopsis "Pas de Sysnopsis disponible" Else Synopsis = tmp

'---------------------------------------------------------------------------
'genre se trouve entre nb2+4 et duree delimité par et <
tmp = ""
Nb1 = InStr(1, CodeSrc, "<H4>Genre :")
nb2 = InStr(Nb1, CodeSrc, "
")
tmp = Mid(CodeSrc, Nb1 + 12, nb2 - Nb1 - 12)
Dim travail_Genre() As String
travail_Genre = Split(tmp, ">")

If UBound(travail_Genre) > 1 Then
For i = 1 To UBound(travail_Genre) Step 2
Genre = Genre & travail_Genre(i) & ", "
Next i
Genre Replace(Genre, " "" Then Set Miniature LoadPicture(App.Path & "\tmp.jpg") Else Set Miniature = LoadPicture(Nothing)
RaiseEvent Evenement("Téléchargement miniature Terminée")
Kill App.Path & "\tmp.jpg"

toujour dans l'ocx j'ai rajouté la fonction:

Public Function AfficheAutreMiniature()
'Affiche miniatures
If NumMiniature < NombreDePhoto Then
NumMiniature = NumMiniature + 1
Else
NumMiniature = 0
End If

Dim Tmp1() As Byte
Erase Tmp1
RaiseEvent Evenement("Téléchargement de la miniature")
Tmp1() = Inet1.OpenURL(TablImageUrl(NumMiniature), icByteArray)
Do While Inet1.StillExecuting = True
DoEvents
Loop

Open App.Path & "\tmp.jpg" For Binary Access Write As #1
Put #1, , Tmp1()
Close #1
If UrlMini <> "" Then Set Miniature LoadPicture(App.Path & "\tmp.jpg") Else Set Miniature LoadPicture(Nothing)
RaiseEvent Evenement("Téléchargement miniature Terminée")
Kill App.Path & "\tmp.jpg"
UrlMini = TablImageUrl(NumMiniature)
FrmInfoAllocine.Image1.Picture = Miniature
FrmInfoAllocine.Label1.Caption "Image " & NumMiniature & "/" & NombreDePhoto
End Function

sur la form j'ai rajouté un label: label1
et un bouton : CmdAutreMiniature

quand on appuis sur le bouton sa donne:

Private Sub CmdAutreMiniature_Click()
Allocine1.AfficheAutreMiniature
End Sub
Messages postés
26
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mars 2009

En complément, le code pour réupérer les grandes affiches si elles existent ;-)

Cest basé sur une petite étude des pages de galerie photos, plusieurs cas possible :
- Affiche française et affiche américaine
- Affiche préventive et affiche définitive
- Affiche unique
- Pas d'affiche

On recherche les liens des pages avec l'image agrandie, une fois que le nuémro d'image est connu (affiche française, définitive, unique), le lien de la vignette donne le lien de l'image agrandie ...

' LienFicheFilm$ est de la forme http://www.allocine.fr/film/fichefilm_gen_cfilm=56143.html
Function RechercheGrandeAffiche(ByVal LienFicheFilm$) As String
Dim hMSHTML As New MSHTML.HTMLDocument
Dim hDocument As HTMLDocument
Dim hTable As HTMLTable
Dim hImage As HTMLImg
Dim hLink As HTMLLinkElement
Dim hRow As HTMLTableRow

Dim Tableau
Dim TableauTemp
Dim i As Integer, j As Integer
Dim Début As Integer
Dim NuméroFilm$
Dim NuméroImage$

Dim Lien$
Dim Temp$

Temp$ = Replace$(LienFicheFilm$, "http://www.allocine.fr/film/fichefilm_gen_cfilm=", "")

' Numéro de film dans la base Allociné
NuméroFilm$ = Replace$(Temp$, ".html", "")

Lien$ = "http://www.allocine.fr/film/galerievignette_gen_cfilm=" + NuméroFilm$ + ".html"

Set hDocument = hMSHTML.createDocumentFromUrl(Lien$, vbNullString)

' Attente du chargement de la page
While hDocument.readyState <> "complete"
DoEvents
Wend

Set hTable = hDocument.All.tags("table").Item(8)

Set hRow = hTable.rows(0)

NuméroImage$ = ""
For i = 0 To hTable.rows(0).All.length - 1
If hRow.All.Item(i).tagName = "A" Then
If InStr(hRow.All.Item(i).href, "http://www.allocine.fr/film/galerie_gen_cfilm=" + NuméroFilm$ + "&filtre=&cmediafichier=") <> 0 Then
If InStr(hRow.All.Item(i - 1).innerText, "Affiche française") <> 0 Or InStr(hRow.All.Item(i - 1).innerText, "Affiche définitive") <> 0 Then
Temp$ = Replace(hRow.All.Item(i).href, "http://www.allocine.fr/film/galerie_gen_cfilm=", "")
Temp$ = Replace$(Temp$, NuméroFilm$, "")
Temp$ = Replace$(Temp$, "&filtre=&cmediafichier=", "")
NuméroImage$ = Replace$(Temp$, ".html", "")
Exit For
End If
End If
End If
Next i

If NuméroImage$ = "" Then
For Each hLink In hDocument.links
If InStr(hLink, "http://www.allocine.fr/film/galerie_gen_cfilm=" + NuméroFilm$ + "&filtre=&cmediafichier=") <> 0 Then
Temp$ = Replace(hLink, "http://www.allocine.fr/film/galerie_gen_cfilm=", "")
Temp$ = Replace$(Temp$, NuméroFilm$, "")
Temp$ = Replace$(Temp$, "&filtre=&cmediafichier=", "")
NuméroImage$ = Replace$(Temp$, ".html", "")
Exit For
End If
Next
End If

If NuméroImage$ <> "" Then
For Each hImage In hDocument.images
If InStr(hImage.src, NuméroImage$) <> 0 Then
Lien$ = Replace$(hImage.src, "_vign", "")
Exit For
End If
Next
Else
Lien$ = "http://a69.g.akamai.net/n/69/10688/v1/img5.allocine.fr/acmedia/skin/AlloCineV5/habillage/AffichetteAllocine.gif"
End If

Set hTable = Nothing
Set hDocument = Nothing
Set hMSHTML = Nothing
RechercheGrandeAffiche = Lien$
End Function

Code testé plusieurs fois et sans bug, jusqu'à preuve du contraire ;-) ...
Messages postés
26
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mars 2009

En fait, je pense que c'est la méthode la moins "pète-bonbon" pour programmer ça, en cas de modification de structure des pages, cela semble peut-être plus aisé à mettre à jour ...
Afficher les 32 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.