Discussion :

[imparator_42]

J'ai lu cette discussion.
Ce code marche trop bien , merci beaucoup...
je l'ai un peu modifié et ça me sert à beaucoup de choses

[ThierryAIM]

je l'ai un peu modifié et ça me sert à beaucoup de choses

Tu peux toujours en faire profité les copains

[imparator_42]

Ben au fait j'ai créer un tout petit programme :
donc il contient : command1 , textbox1, textbox2 et combo1

Tu rentre un lien dans la case textbox1 (si tu rentre www.dna.fr ben c'est l'index du site qui va être télécharger)
dans la case textbox2 tu rentre le nom du fichier à enregistrer sans l'extension bien sur
combo1 ben tu choisi l'extension...
et enfait le fichier se trouve juste à côté de ce programme...

la prochaine fois je mets un truc pour l'enregistrer là où on veut ....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Private Sub Command1_Click()
 
    strURL = Text1.Text
    strFile = Text2.Text & "." & Combo1.Text
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    Const ForWriting = 2
    Dim web, varByteArray, strData, strBuffer, lngCounter, ado
    Err.Clear
    Set web = Nothing
    Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
    If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
    If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
    If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
    web.Open "GET", strURL, False
    web.Send
    If Err.Number <> 0 Then
        SaveWebBinary = False
        Set web = Nothing
        MsgBox "Une erreur est intervenue."
        TagIe = 1
    End If
 
    If web.Status <> "200" Then
       SaveWebBinary = False
       Set web = Nothing
       MsgBox "Internet ne peut pas etre joint, démarrez une session IE."
       TagIe = 1
    End If
 
    If TagIe = 0 Then
       varByteArray = web.ResponseBody
       Set web = Nothing
 
       'Enregistrer le fichier
       On Error Resume Next
       Set ado = Nothing
       Set ado = CreateObject("ADODB.Stream")
       If ado Is Nothing Then
           Set fs = CreateObject("Scripting.FileSystemObject")
           Set ts = fs.OpenTextFile(strFile, ForWriting, True)
           strData = ""
           strBuffer = ""
           For lngCounter = 0 To UBound(varByteArray)
               ts.Write Chr(255 And AscB(MidB(varByteArray, lngCounter + 1, 1)))
           Next
           ts.Close
       Else
           ado.Type = adTypeBinary
           ado.Open
           ado.Write varByteArray
           ado.SaveToFile strFile, adSaveCreateOverWrite
           ado.Close
       End If
       SaveWebBinary = True
    End If
    TagIe = 0
End Sub

Sinon excusez moi , j'ai utilisé que la 2ème pers. du singulier...c'était plus simple :d

[ThierryAIM]

Sinon excusez moi , j'ai utilisé que la 2ème pers. du singulier...c'était plus simple :d

Pas de problème et Merci pour le suivi

[DarkVader]

WinHttp utilisé en mode asynchrone : c'est mieux - cela évite notamment de rester planté avec un serveur qui ne répond pas.

[imparator_42]

WinHttp utilisé en mode asynchrone : c'est mieux - cela évite notamment de rester planté avec un serveur qui ne répond pas.

Comment vous utilisez / faites ceci ?

[DarkVader]

WinHTTP est intancié avec WithEvents afin de permettre la gestion évènementale.

La méthode Open est utilisé avec le paramètre Async=1 - c'est tout.

[imparator_42]

D'accord merci beaucoup DarkVader