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)

Search

Feeds

RSS 2.0 feed All content
RSS 2.0 feed ajax
RSS 2.0 feed asp
RSS 2.0 feed aspnet
RSS 2.0 feed bicycle
RSS 2.0 feed copenhagen
RSS 2.0 feed databases
RSS 2.0 feed denmark
RSS 2.0 feed diy
RSS 2.0 feed dotnet
RSS 2.0 feed html
RSS 2.0 feed japan
RSS 2.0 feed javascript
RSS 2.0 feed modding
RSS 2.0 feed photography
RSS 2.0 feed utilities
RSS 2.0 feed vbscript