Une OCX pour télécharger un fichier avec Inet.
un evenement vous permet de recuperer la taille deja telechargee, la taille totale, le pourcentage, la vitesse (quoiqu'il y a quelques progres a faire de ce cote)
Un autre le status du téléchargement.
Le code est commenté et contient un projet de test.
Vous pouvez retoucher le code et l'inclure ds votre projet, ajout le controle, ou ajouter l'ocx (je sais, c chiant a distribuer ;-)
Source / Exemple :
'Control : OCX_Download
'Auteur : Emmanuel Bouillon
'E-mail : ebouillon@ifrance.com
'Page perso : http://informatique.monhttp.com/
'Dernière MAJ : 06/03/2002
'Version Act : 1.1
'
'V 1.1:
' -- Support du resuming (ajout d'un argument a la fonction Download)
' -- un bug corrigé
'
'A venir:
' -- Une meilleur gestion de la vitesse
' -- Le temps
' -- Un controle d'erreur
'J'ai rajouté plusieurs boucles avec Inet.StillExecuting
'pour etre sur que le control n'est pas en train de faire qqc
'Génere une erreur si il y a une variable inconnue
Option Explicit
'Défini les evenements
Public Event Progress(Percent As Byte, Taille_Recue As Long, Taille_Totale As Long, Vitesse As Long)
Public Event ChangementStatus(State As String)
Const Chunk_Size = 1024
Const Retour = 4096
Dim Pourcent As Byte
Dim Taille_Recue As Long
Dim Taille_Totale As Long
Dim Vitesse As Long
Dim LastTailleRecue As Long
Dim File As Integer
Dim StrHeader
Dim Msg
Dim Data() As Byte
'Procedure de téléchargement
Public Sub Download(Source As String, Destination As String, Optional AutoResume As Boolean = True)
'En cas d'erreur, aller a l'etiquette "ErreurDownload"
'On Error GoTo ErreurDownload
'Initialise les variables
Pourcent = 0
Taille_Recue = 0
Taille_Totale = 0
Vitesse = 0
LastTailleRecue = 0
File = 0
StrHeader = ""
'Envoi l'evenement "ChangementStatus" avec pour argument le Status
RaiseEvent ChangementStatus("Initialisation...")
Lbl_Status = "Initialisation..."
RaiseEvent Progress(0, 0, 1, 0)
'Attends qu'il ai terminé ses operations
While Inet.StillExecuting
DoEvents
Wend
'Initialise le controle Internet Transfert
Inet.URL = Source
Inet.Execute , "GET"
'Attends qu'il ai terminé ses operations
While Inet.StillExecuting
DoEvents
Wend
Lbl_Source = "Source : " & Source
Lbl_Destination = "Destination : " & Destination
RaiseEvent ChangementStatus("Recherche de la taille du fichier...")
Lbl_Status = "Recherche de la taille du fichier..."
'Utilise la fonction Taille pour récuperer la taille du fichier
Taille_Totale = Taille(Source)
Bar.Max = Taille_Totale
Taille_Recue = 0
Bar.Value = Taille_Recue
RaiseEvent ChangementStatus("Ouverture du fichier de destination...")
Lbl_Status = "Ouverture du fichier de destination..."
'Cherche un no de fichier libre
File = FreeFile()
'Ouverture du fichier de destination
Open Destination For Binary Access Write As #File
'Si le fichier de destination existe deja :
If FileLen(Destination) > 4096 Then
If AutoResume = False Then Msg = MsgBox("Le fichier de destination existe déja, voulez-vous continuer le transfert ?", vbYesNoCancel, "Le fichier de destination existe déja")
'Si AutoResume est sur False, on demande si il faut reprendre le téléchargement
If Msg = vbNo Then 'Si non, on ferme le fichier de destination,
Close #File 'On le supprime et on le créé
Kill Destination
Open Destination For Binary Access Write As #File
End If
If Msg = vbCancel Then 'Si "cancel",
GoTo Fin 'on arrete le téléchargement
End If
'Si AutoResume est sur True
'ou si on a chosit de continuer
'le téléchargement...
If AutoResume = True Or Msg = vbYes Then
RaiseEvent ChangementStatus("Reprise du téléchargement...")
Taille_Recue = FileLen(Destination)
Seek #File, Taille_Recue + 1
Inet.Execute , "GET", , "Range: bytes=" & CStr(Taille_Recue) & "-" & vbCrLf
End If
End If
'Attends qu'il ai terminé ses operations
While Inet.StillExecuting
DoEvents
Wend
'Debut du téléchargement
RaiseEvent ChangementStatus("Téléchargement en cours...")
Lbl_Status = "Téléchargement en cours..."
Timer.Enabled = True 'Activation du Timer (pour la vitesse)
Do
DoEvents 'Télécharge un bloc de données
Data = Inet.GetChunk(Chunk_Size, icByteArray)
Put #File, , Data 'Les enregistre dans le fichier
Taille_Recue = Taille_Recue + UBound(Data, 1) + 1
Bar.Value = Taille_Recue 'Met a jour la bar de progression
Lbl_State = Taille_Recue & " / " & Taille_Totale & " - " & Pourcent & " %"
Pourcent = Round(Taille_Recue / Taille_Totale * 100)
'Calcule la progression
RaiseEvent Progress(Pourcent, Taille_Recue, Taille_Totale, Vitesse)
Loop While UBound(Data, 1) > 0
'Ferme le fichier
Close #File
Timer.Enabled = False
RaiseEvent ChangementStatus("Téléchargement terminé")
Lbl_Status = "Téléchargement terminé"
Exit Sub
'En cas d'erreur
ErreurDownload:
On Error Resume Next
If MsgBox("Erreur " & Err.Number & " - " & Err.Description & vbCrLf & "Effacer le fichier ?", vbYesNo, "Le téléchargement a échoué") = vbYes Then Kill Destination
Fin:
RaiseEvent ChangementStatus("Une erreur c'est produite !")
Lbl_Status = "Une erreur c'est produite !"
Close #File
End Sub
'Defini la vitesse
Private Sub Timer_Timer()
Vitesse = (Taille_Recue - LastTailleRecue) * 2
LastTailleRecue = Taille_Recue
End Sub
'Retrouve la taille d'un fichier sur internet
'Cette fonction peut être appelée sans necessiter
'un téléchargement, car elle utilise un control Inet
'différent
Public Function Taille(URL As String) As Long
Inet_Taille.URL = URL
Inet_Taille.Execute , "GET"
'Fait patienter le control Inet jusqu'a ce qu'il
'ait terminé ses taches
While Inet_Taille.StillExecuting
DoEvents
Wend
'Cherche la taille
StrHeader = Inet_Taille.GetHeader("Content-Length")
Taille = Val(StrHeader)
End Function
'Arrete les operations des controls Inet en cours
Public Sub Cancel()
On Error Resume Next
Inet.Cancel
Inet_Taille.Cancel
RaiseEvent ChangementStatus("Téléchargement interrompu")
Lbl_Status = "Téléchargement interrompu"
Timer.Enabled = False
End Sub
Conclusion :
V 1.1 :
-- Support du resuming (ajout d'un arg a la fonction Download
-- un bug corrigé
A venir :
-- Une meilleur gestion de la vitesse
-- Le temps
-- Un controle d'erreur
Merci a Mad Vinz pour son aide sur le forum newscs.viendez.com (j'me debrouillais pas avec les OCX)
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.