VBScript binary file http downloader

This WSH script can download a file from a given URL and save it to disk using a binary stream. To use the code in an ASP page instead of WSH, just use the BinaryGetURL() and SaveBinaryData() functions and replace "CreateObject" with "Server.CreateObject".

(See also the plain text/html example.)

Option Explicit

Dim objArgs
Dim strURL
Dim strFileName
Set objArgs = WScript.Arguments
If objArgs.count = 0 Then
  Wscript.echo( _
    "Syntax: GetBinary URL [target file name]" & vbcrlf & vbcrlf & _
    "Examples:" & vbcrlf & _
    "GetBinary http://server.com/folder/file.zip" & vbcrlf & _
    "GetBinary http://server.com/dat.zip c:\dl\file.zip" & vbcrlf & _
    "GetBinary https://server.com/file.dat secure.dat" & vbcrlf & _
    "GetBinary http://server.com/news.htm d:\data\servernews.html")
ElseIf objArgs.count = 1 Then
  strURL = objArgs.Item(0)
  strFileName = strURL
  strFileName = Replace(strFileName, "?", "/")
  strFileName = Replace(strFileName, "&", "/")
  strFileName = Replace(strFileName, "=", "/")
  strFileName = Right(strFileName, Len(strFileName) - _
    InStrRev(strFileName, "/"))
  If strFileName = "" Then
    strFileName = strURL
    strFileName = Replace(strFileName, "http://", "")
    strFileName = Replace(strFileName, "https://", "")
    strFileName = Replace(strFileName, "/", "")
  End If
  SaveBinaryData BinaryGetURL(strURL), strFileName
ElseIf objArgs.count = 2 Then
  strURL = objArgs.Item(0)
  strFileName = objArgs.Item(1)
  SaveBinaryData BinaryGetURL(strURL), strFileName
Else
  Wscript.echo( _
    "Too many arguments. If a path contain spaces, " & _
    "please put quotation marks around the arguments.")
End If

Function BinaryGetURL(strURL)
  Dim objWinHttp
  Dim lngTimeout
  Dim strMethod
  Dim strPostData
  Dim strUserAgentString
  Dim intSslErrorIgnoreFlags
  Dim blnEnableRedirects
  Dim blnEnableHttpsToHttpRedirects
  lngTimeout = 59000 ' milliseconds.
  strMethod = "GET"
  strPostData = ""
  strUserAgentString = "binary_getter/1.0"
  intSslErrorIgnoreFlags = 13056 ' 13056 = ignore all err, 0 = accept no err
  blnEnableRedirects = True
  blnEnableHttpsToHttpRedirects = True
  Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
  objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
  objWinHttp.Option(0) = strUserAgentString
  objWinHttp.Option(4) = intSslErrorIgnoreFlags
  objWinHttp.Option(6) = blnEnableRedirects
  objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
  objWinHttp.Open strMethod, strURL, False
  If strMethod = "POST" Then
    objWinHttp.setRequestHeader "Content-type", _
      "application/x-www-form-urlencoded"
  End If
  objWinHttp.Send(strPostData)
  If (objWinHttp.Status = 200) Then
    BinaryGetURL = objWinHttp.ResponseBody
  End If
  Set objWinHttp = Nothing
End Function

Function SaveBinaryData(arrByteArray, strFileName)
  If VarType(arrByteArray) >= 8192 Then
    Dim objBinaryStream
    Set objBinaryStream = CreateObject("ADODB.Stream")
    objBinaryStream.Type = 1
    objBinaryStream.Open()
    objBinaryStream.Write(arrByteArray)
    objBinaryStream.SaveToFile strFileName, 2
  End If
End Function
Page last updated 2007-12-27 14:51. Some rights reserved (CC by 3.0)