download.vbs

download.vbs

' download.vbs --- download a file from internet

'===========================================
' TODO: Please specify the URL and filename:

url = "https://www.google.com/robots.txt"
filename = "robots.txt"

' TODO: OK, save and open this file. Done.
'===========================================

Function CreateHttpRequest()
  ids = Array("WinHttp.WinHttpRequest.5.1", _
              "WinHttp.WinHttpRequest.5", _
              "WinHttp.WinHttpRequest", _
              "Msxml2.ServerXMLHTTP.6.0", _
              "Msxml2.ServerXMLHTTP.5.0", _
              "Msxml2.ServerXMLHTTP.4.0", _
              "Msxml2.ServerXMLHTTP.3.0", _
              "Msxml2.ServerXMLHTTP", _
              "Microsoft.ServerXMLHTTP", _
              "Msxml2.XMLHTTP.6.0", _
              "Msxml2.XMLHTTP.5.0", _
              "Msxml2.XMLHTTP.4.0", _
              "Msxml2.XMLHTTP.3.0", _
              "Msxml2.XMLHTTP", _
              "Microsoft.XMLHTTP")

  Set ret = Nothing

  On Error Resume Next
  For i = LBound(ids) To UBound(ids)
    Set ret = CreateObject(ids(i))
    If Not ret Is Nothing Then Exit For
  Next
  On Error GoTo 0

  Set CreateHttpRequest = ret
End Function

Sub DoDownload(Url, Path)
  Set req = CreateHttpRequest
  If req Is Nothing Then
    MsgBox "ERROR: Can't create an HTTP object!"
    Exit Sub
  End If
  req.Open "GET", Url, False

  req.setRequestHeader "Pragma", "no-cache"
  req.setRequestHeader "Cache-Control", "no-cache"
  req.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
  req.Send

  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .Type = 1
        .Open
        .Write req.responseBody
        .SaveToFile Path, 2
        .Close
      End With
      MsgBox "OK, downloaded!"
    Case Else
      MsgBox "ERROR: Code " & req.Status
  End Select
End Sub

DoDownload url, filename