OCX ALLOCINE (INFO COMPLETE + MINIATURE)

Signaler
Messages postés
156
Date d'inscription
mardi 4 novembre 2003
Statut
Membre
Dernière intervention
28 décembre 2010
-
Messages postés
2
Date d'inscription
lundi 20 août 2007
Statut
Membre
Dernière intervention
6 novembre 2011
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/26287-ocx-allocine-info-complete-miniature

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 ;-) ...
Afficher les 32 commentaires