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
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)