Discussion :

[henrietd]

Bonjour,
je cherche à récupérer une image dont je connais l'URL en programmation VBScript. J'ai trouvé sur internet des références à OSWINSCK.DLL qui fournissait des méthodes, mais je n'ai pas pu le faire fonctionner (The requested URL was not found on this server)...
Quelqu'un connaitrait il une autre méthode ?

[RadPAT]

Salut,

voici un exemple de code que j'ai trouvé sur le net et que j'ai adapté à mes besoins. J'utilise ce code pour vérifier le nom de fichier des signatures anti virus Trend sur le site trendmicro europe. Je recopie le fichier Php dans un fichier Txt qui sera lu ligne à ligne dans un autre sub jusqu'à la ligne où figure le nom du dernier fichier des signatures :

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
59
60
 
Sub ChkInternet
 
    strURL = "http://fr.trendmicro-europe.com/enterprise/support/pattern.php"
    StrFile = "pattern.Txt"
    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
 
       'Save the file
       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

Dans StrUrl tu mets le nom de ton URL et dans StrFile le nom du fichier que tu vas récupérer sur ton disque dur.

A++

[henrietd]

Merci RadPAT, ton script fonctionne à merveille !