yyy

```
VERSION 5.00
```
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form vbmoviecover
BorderStyle = 4 'Fixed ToolWindow
Caption = "Dowload Pochette (Moviecovers.com)"
ClientHeight = 4260
ClientLeft = 45
ClientTop = 165
ClientWidth = 7950
Icon = "Affichersource.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4260
ScaleWidth = 7950
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox Check1
Caption = "Prévisualisation"
Height = 255
Left = 4920
TabIndex = 7
Top = 0
Value = 1 'Checked
Width = 1575
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
Height = 3705
Left = 4920
ScaleHeight = 3645
ScaleWidth = 2715
TabIndex = 6
Top = 360
Width = 2775
End
Begin VB.CommandButton Command1
Caption = "Télécharger Pochette"
Height = 375
Left = 2520
TabIndex = 5
Top = 3720
Width = 2175
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3480
Top = 960
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.ListBox List1
Height = 2595
Left = 120
TabIndex = 2
Top = 840
Width = 4575
End
Begin VB.TextBox Text1
Height = 375
Left = 120
TabIndex = 1
Top = 240
Width = 3615
End
Begin InetCtlsObjects.Inet Inet1
Left = 3840
Top = 600
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin VB.CommandButton VSource
Caption = "Rechercher"
Height = 375
Left = 120
TabIndex = 0
Top = 3720
Width = 2175
End
Begin MSComCtl2.Animation A1
Height = 735
Left = 3840
TabIndex = 8
Top = 120
Visible = 0 'False
Width = 855
_ExtentX = 1508
_ExtentY = 1296
_Version = 393216
Center = -1 'True
FullWidth = 57
FullHeight = 49
End
Begin VB.Label Label2
Caption = "Recherche (Titre)"
Height = 255
Left = 120
TabIndex = 4
Top = 0
Width = 1815
End
Begin VB.Label Label1
Alignment = 2 'Center
Height = 375
Left = 120
TabIndex = 3
Top = 600
Width = 3615
End
End
Attribute VB_Name = "vbmoviecover"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'recuperation des reponses du moteur de recherche de www.moviecovers.com
'tant que le formatage du site sera le mm ca fonctionnera!!!
'valide le 23/07/2003.
'par pcpunch59 si vous avez besoin de renseignements
'laissez un msg sur vbfrance
'-------------------------------------------------------------------------------------
Private Type filmV ' declaration
FilmTitre As String
FilmUrl As String
FilmCaptureTxt As String
FilmAnnée As Integer
End Type
Dim film(1 To 100) As filmV
Dim URL As String
Dim trouver As Boolean
Dim bouton As Integer
Private Sub Command1_Click()
If List1.Text = "" Then Exit Sub
bouton = 3
ControlOff
Dim bData() As Byte
Dim StrUrl As String
Dim Taille As Integer
'recuperation du nom du jpg
Dim NomJpg As String
For i = Len(film(List1.ListIndex + 1).FilmUrl) To 1 Step -1
If Mid(film(List1.ListIndex + 1).FilmUrl, i, 1) = "_" Then Exit For
NomJpg = Right(film(List1.ListIndex + 1).FilmUrl, Len(film(List1.ListIndex + 1).FilmUrl) - (i - 1))
Next i
'fichier de destination
With CommonDialog1
.FileName = NomJpg
.Filter = "*.jpg|*.jpg"
.ShowSave
End With
AnimOn
'telechargement de l image
Label1 = "Telechargement en cours..."
With Inet1
StrUrl = "http://www.moviecovers.com/getjpg.html/" & (NomJpg & ".jpg")
bData() = .OpenURL(StrUrl, icByteArray)
Open CommonDialog1.FileName For Binary Access Write As #1
Put #1, , bData()
Close #1
Do While Inet1.StillExecuting = True
DoEvents
Loop
Label1 = "Terminé...."
ControlOn
AnimOff
End With
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next 'au cas ou on quitte sans rien chercher
Kill App.Path & "/tmp.jpg"
End Sub
Private Sub List1_Click()
Select Case Check1
Case 1
ControlOff
bouton = 2
AnimOn
Label1 = "Affichage de la miniature en cours...."
Dim bData() As Byte
Dim StrUrl As String
Dim StrUrl2 As String
Dim tmp As String
Dim particule As String
'decoupage de l url (nom du fichier)
For i = Len(film(List1.ListIndex + 1).FilmUrl) To 1 Step -1
If Mid(film(List1.ListIndex + 1).FilmUrl, i, 1) = "_" Then Exit For
NomJpg = Right(film(List1.ListIndex + 1).FilmUrl, Len(film(List1.ListIndex + 1).FilmUrl) - (i - 1))
Next i
'suppresion des "." au cas ou le titre trouvé commence par ".."
NomJpg = Replace(NomJpg, ".", "")
'telechargement de la miniature
StrUrl = "http://www.moviecovers.com/DATA/thumbs/films-" & LCase(Mid(NomJpg, 1, 1)) & "/" & NomJpg & ".jpg"
StrUrl2 = "http://www.moviecovers.com/DATA/thumbs/films-" & LCase(Mid(List1.Text, 1, 1)) & "/" & NomJpg & ".jpg"
On Error GoTo err
With Inet1
bData() = .OpenURL(StrUrl, icByteArray)
Open App.Path & "/tmp.jpg" For Binary Access Write As #1
Put #1, , bData()
Close #1
Label1 = ""
ControlOn
AnimOff
Picture1.Picture = LoadPicture(App.Path & "/tmp.jpg")
End With
Exit Sub
err: 'si erreur alors on teste avec premiere lettre de list1
With Inet1
On Error GoTo err2
bData() = .OpenURL(StrUrl2, icByteArray)
Open App.Path & "/tmp.jpg" For Binary Access Write As #2
Put #2, , bData()
Close #2
Label1 = ""
ControlOn
AnimOff
On Error GoTo err2
Picture1.Picture = LoadPicture(App.Path & "/tmp.jpg")
End With
Exit Sub
err2: 'pas de fichier jpg alors on jette l'éponge lol
Picture1.Picture = Nothing
Label1 = "Miniature Indisponible..."
End Select
End Sub
Private Sub VSource_Click()
On Error Resume Next ' au cas ou car il y a des petit bugs
bouton = 1
Erase film()
List1.Clear
AnimOn
ControlOff
Dim Recherche As String
Dim nb As Integer
nb = 0
URL = "http://www.moviecovers.com/multicrit.html?titre=" & Text1 & "&slow=1&listes=1"
'on utilise le moteur de recherche en ligne du site
Label1 = "Recherche en cours..."
Recherche = Inet1.OpenURL(URL) 'recherche contiens le code html de la reponse
Do While Inet1.StillExecuting = True
DoEvents
Loop
'les resultats dans le code html sont sous la forme :
'<LI><A href="/film/titre_UN%20BEAU%20JOUR.html">BEAU JOUR (UN)</A> (1996)
'donc on recherche "/film/" pour avoir la reponse
For i = 1 To Len(Recherche)
If Mid(Recherche, i, 6) = "/film/" Then
nb = nb + 1
film(nb).FilmCaptureTxt = Mid(Recherche, i, 150) 'film(n°).filmcaturetxt = 150 carac qui suivent
trouver = True 'on au moin une reponse
End If
Next i
Label1 = nb & " Reponses"
If trouver = True Then
Call Recup_Recherche ' si reponse on traite les lignes film(n°)
Else
List1.AddItem "Aucun Résultat!!!"
AnimOff
ControlOn
End If
End Sub
Sub Recup_Recherche()
Dim tmp As String
For i = 1 To UBound(film) 'on boucle sur tous les enregistrements de film
'recuperation de url en function du filmcapturetxt
For a = 1 To Len(film(i).FilmCaptureTxt)
'la chaine commence par /film/xxxxxxx, si on trouve un"." alors on arrete
'ex : /film/titre_UN%20BEAU%20JOUR.html">BEAU JOUR (UN)</A> (1996)
'on se retouve avec url "/film/titre_UN%20BEAU%20JOUR"
If Mid(film(i).FilmCaptureTxt, a, 1) <> "." Then
film(i).FilmUrl = film(i).FilmUrl & Mid(film(i).FilmCaptureTxt, a, 1)
Else
Exit For
End If
Next a
'titre & année
On Error Resume Next
'7 caracteres apres le "." c le debut du titre jusque le "<"
For b = a + 7 To Len(film(i).FilmCaptureTxt)
If Mid(film(i).FilmCaptureTxt, b, 1) <> "<" Then
film(i).FilmTitre = film(i).FilmTitre & Mid(film(i).FilmCaptureTxt, b, 1)
Else
'si "<" (fin du titre) la date commence 6 caracteres apres, sur 4 caractex:(2003)
film(i).FilmAnnée = Mid(film(i).FilmCaptureTxt, b + 6, 4)
Exit For
End If
Next b
Next i
'on affiche les titres & dates dans list1
For i = 1 To UBound(film)
If film(i).FilmCaptureTxt = "" Then Exit For
List1.AddItem film(i).FilmTitre & " (" & film(i).FilmAnnée & ")"
Next i
AnimOff
ControlOn
End Sub
Function ControlOff() 'rend impossible l action des controles
VSource.Enabled = False
Command1.Enabled = False
List1.Enabled = False
End Function
Function ControlOn() 'rend possible l action des controles
VSource.Enabled = True
Command1.Enabled = True
List1.Enabled = True
End Function
Function AnimOn()
'pour les animation avi g attribuer un valeur a bouton lors du click sur le command bouton
Select Case bouton
Case 1 'recherche
A1.Open App.Path & "/search.avi"
Case 2 'click list
A1.Open App.Path & "/findfile.avi"
Case 3 ' dowload
A1.Open App.Path & "/download.avi"
End Select
A1.Visible = True
A1.Play
End Function
Function AnimOff() 'ferme l anim
A1.Stop
A1.Visible = False
A1.Close
End Function