Soyez le premier à donner votre avis sur cette source.
Vue 11 608 fois - Téléchargée 1 848 fois
'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
9 avril 2011 à 15:19
9 déc. 2007 à 17:22
4 juil. 2005 à 23:03
++
4 juil. 2005 à 22:33
4 juil. 2005 à 20:29
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.