How Can I Ignore Internet Errors in a VBScript? - vbscript

I have a vbscript that downloads a file. I need to make it so that if there is no internet that it wont pop up with the error message The operation timed out, or Failed to find the resource specified. I've tried using On Error Resume Next, but alas it does not skip any internet related errors. Any way I can set a timeout or something? It is not a large file, just a 20-line text file. Here is my script:
strFileURL = "https://minecraft-statistic.net/en/server/167.114.43.185_25565/json/"
strHDLocation = "c:\users\public\mc.txt"
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
End if
Set objXMLHTTP = Nothing

On Error Resume Next is the only option for capturing errors, I'm not sure why you say it doesn't work. This works for me;
On Error Resume Next
strFileURL = "https://minecraft-statistic.net/en/server/167.114.43.185_25565/json/"
strHDLocation = "c:\users\public\mc.txt"
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()
If Err.Number = 0 Then
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
End if
Set objXMLHTTP = Nothing
Else
'Handle the error here.
End If
The way On Error Resume Next works is as follows;
Line triggers an error which is caught by the VBScript runtime.
The error is recorded in the Err object.
The line is skipped and the next statement is run.
This process will continue until an On Error Goto 0 line is reached at which point the default behaviour resumes.
Useful Links
VBScript — Using error handling

Related

Download file via vbs

I know this has been asked and answered, it is where I found the code to start my project. But it doesn't work.
I'm stuck. I have tried and tried and the code(s) don't work.
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
xHttp.Open "GET", "https://filexxx.exe", False
xHttp.Send
With bStrm
.Type = 1 'binary
.Open
.Write xHttp.ResponseBody 'this part removed, error, tools not yet avail
.SaveToFile "c:\temp\xxx.exe", 2 'overwrite
End With
And this one.
strFileURL = "https://filexxx.exe"
strHDLocation = "C:\temp\xxx.exe"
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objXMLHTTP.Open "GET", strFileURL, False
objXMLHTTP.Send()
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.SaveToFile strHDLocation
And this one.
strFileURL = "https://filexxx.exe"
strHDLocation = "C:\temp\filexxx.exe"
proxy = null
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Set wshShell = CreateObject( "WScript.Shell" )
Set objUserVariables = wshShell.Environment("USER")
'http proxy is optional
'attempt to read from HTTP_PROXY env var first
On Error Resume Next
If Not (objUserVariables("HTTP_PROXY") = "") Then
proxy = objUserVariables("HTTP_PROXY")
ElseIf Not (WScript.Arguments.Named("proxy") = "") Then
proxy = WScript.Arguments.Named("proxy")
End If
If Not isNull(proxy) Then
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objXMLHTTP.SetProxy 2, proxy
End If
On Error Goto 0
objXMLHTTP.Open "GET", strFileURL, False
objXMLHTTP.Send()
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.Position = 0
Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(path) Then objFSO.DeleteFile path
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
Set objXMLHTTP = Nothing
And this one
HTTPDownload "https:filexxx.exe", "C:\temp\filexxx.exe"
Sub HTTPDownload(myURL, myPath)
' Standard housekeeping
Dim i, objFile, objFSO, objHTTP, strFile, strMsg
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check if the specified target file or folder exists,
' and build the fully qualified path of the target file
If objFSO.FolderExists(myPath) Then
strFile = objFSO.BuildPath(myPath, Mid(myURL, InStrRev(myURL, "/") + 1))
ElseIf objFSO.FolderExists(Left(myPath, InStrRev(myPath, "\") - 1)) Then
strFile = myPath
Else
WScript.Echo "ERROR: Target folder not found."
Exit Sub
End If
' Create or open the target file
Set objFile = objFSO.OpenTextFile(strFile, ForWriting, True)
' Create an HTTP object
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
' Download the specified URL
objHTTP.Open "GET", myURL, False
objHTTP.Send
' Write the downloaded byte stream to the target file
For i = 1 To LenB(objHTTP.ResponseBody)
objFile.Write Chr(AscB(MidB(objHTTP.ResponseBody, i, 1)))
Next
' Close the target file
objFile.Close()
End Sub
All have same result. They don't download the file. Sometimes one of them freezes the computer and I have to manually power down.
They do, after time, download (but don't) and only shows file as 0kb. If I change
objXMLHTTP.Open "GET", strFileURL, False
to
objXMLHTTP.Open "GET", strFileURL, True
It instantly shows up in folder and shows 0kb
Either True or False, waiting 30+ minutes does nothing to size of file. The actual file size is 1,874,886 kB and only takes a couple minutes to download from website.
Dim ie
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.Navigate2("https://filexxx.exe")
ie.Document.Execwb("saveas", False, "C:\temp\filexxxx.exe")
ie.Quit
Gives
line 5 char 58 cannot use parentheses when calling a sub
And if I remove the quotation marks "" from drive\folder\file I get
line 5 char 36 expected ")"
Note the URL is https, not http. Been working on this for couple days now.
I don't know what the point of posting random code is. The point of this code is it says what is happening.
Set fso = CreateObject("Scripting.FileSystemObject")
Set Outp = Wscript.Stdout
Set wshShell = CreateObject("Wscript.Shell")
Set ShApp = CreateObject("Shell.Application")
On Error Resume Next
Set File = WScript.CreateObject("Msxml2.XMLHTTP.6.0")
File.Open "GET", "https://www.google.com.au/search?q=cat"), False
File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
File.Send
wscript.echo ""
wscript.echo "Error getting file"
wscript.echo "=================="
wscript.echo ""
wscript.echo "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description
wscript.echo "Source " & err.source
wscript.echo ""
wscript.echo "HTTP Error " & File.Status & " " & File.StatusText
wscript.echo File.getAllResponseHeaders
wscript.echo File.ResponseBody
On Error Goto 0
wscript.echo "Server Response " & File.Status & " " & File.StatusText
wscript.echo File.getAllResponseHeaders
Set BS = CreateObject("ADODB.Stream")
BS.type =1
' BS.Charset = "utf-8"
BS.open
BS.Write File.ResponseBody
BS.Position = 0
BS.type =2
BS.Charset = "utf-8"
wscript.echo BS.ReadText
Set BS = CreateObject("ADODB.Stream")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile ShApp.Namespace(&h10).self.path & "\Google.html]", 2
' wshshell.Run "c:\users\safetyscanner.exe", 1, False

Vb-script parse webpages with username and password

NOTE: I need to use something like Vb-Script or batch because that is what i am familiar with and i also need to be able to run, edit, and create files.
I need to name MS Word files values on a webpage. I decided to first download the webpage as HTML using this code:
function download(sFileURL, sLocation, async)
set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", sFileURL, async
on error resume next
objXMLHTTP.send()
if err.number = 0 then
do until objXMLHTTP.Status = 200
wscript.echo objXMLHTTP.Status
wcript.sleep(200)
loop
if objXMLHTTP.Status = 200 Then
set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0
set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(sLocation) Then objFSO.DeleteFile sLocation
Set objFSO = Nothing
objADOStream.SaveToFile sLocation
objADOStream.Close
set objADOStream = Nothing
download = true
end if
else
download = false
end if
set objXMLHTTP = Nothing
end function
if download("https://web.example.com\login.php", "C:\", false) then
wscript.echo "download ok"
else
wscript.echo "download nok"
end if
The only problem is that to view this page you need to be logged in with a username and password.
NOTE: I can't use the actual webpage for security reasons.

VBScript getting the same file twice when intermittently reading from a webpage

I'm using the following code to download a webpage and save it to file:
function download(sFileURL, sLocation, async)
download = false
set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", sFileURL, async
on error resume next
objXMLHTTP.send()
if err.number = 0 then
do until objXMLHTTP.Status = 200
wscript.echo objXMLHTTP.Status
wcript.sleep(200)
loop
if objXMLHTTP.Status = 200 Then
set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0
set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(sLocation) Then objFSO.DeleteFile sLocation
Set objFSO = Nothing
objADOStream.SaveToFile sLocation
objADOStream.Close
objXMLHTTP.Close
set objADOStream = Nothing
download = true
end if
else
download = false
end if
set objXMLHTTP = Nothing
end function
I'm calling it once passing it (url, filename1, false)
and then I sleep for x seconds
and call it again with (url, filename2, false)
I can see the x delay between the properties of the 2 files on disk, but the second file is the exact same as the first file that is downloaded. I know this for certain because I have a server timer.
Is there some sort of strange caching going on, or something wrong with my download function? To be fair I did copy it from the internets...

VBS to open multiple URL from a list and save to file

I have multiple webpages that I need to open and save the information, which is just text, to a new file for each one. I am not that experienced in VBScripts, at all. But, I have been searching for days and here is what I have gathered so far:
function download(sFileURL, sLocation, async)
set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", sFileURL, async
on error resume next
objXMLHTTP.send()
if err.number = 0 then
do until objXMLHTTP.Status = 200
wscript.echo objXMLHTTP.Status
wcript.sleep(200)
loop
if objXMLHTTP.Status = 200 Then
set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0
set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(sLocation) Then objFSO.DeleteFile sLocation
Set objFSO = Nothing
objADOStream.SaveToFile sLocation
objADOStream.Close
set objADOStream = Nothing
download = true
end if
else
download = false
end if
set objXMLHTTP = Nothing
end function
if download("http://books.google.com/books/feeds/volumes?q=isbn", "test.txt", false) then
wscript.echo "download ok"
else
wscript.echo "download did not work"
end if
How can I change the
if download("http://books.google.com/books/feeds/volumes?q=isbn", "test.txt", false)
to read from a list in text file, and save as test00, test01, test02,...
Thank you in advance
This is the simplest code that should do what you need.
Set objFSO = CreateObject("Scripting.FileSystemObject")
ListFile = "D:\list.txt"
Set objFile = objFSO.OpenTextFile(ListFile)
FileNumber = 0
Do Until objFile.AtEndOfStream
URLFromList = objFile.ReadLine
FileNumber = FileNumber + 1
if download(URLFromList, "test" & FileNumber & ".txt", false) then
wscript.echo "download ok for " & URLFromList
else
wscript.echo "download did not work for " & URLFromList
end if
Loop
objFile.Close
objFSO = Nothing

Disable error in vbs

i use this code for download a link , but if objXMLHTTP.Status not 200 then script show error that can't download or not found link &...
How can add command that if objXMLHTTP.Status not 200 , script don't show any error?
function download(sFileURL, sLocation)
'create xmlhttp object
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
'get the remote file
objXMLHTTP.open "GET", sFileURL, false
'send the request
objXMLHTTP.send()
'wait until the data has downloaded successfully
do until objXMLHTTP.Status = 200 : wcript.sleep(1000) : loop
'if the data has downloaded sucessfully
If objXMLHTTP.Status = 200 Then
'create binary stream object
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
'adTypeBinary
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
'Set the stream position to the start
objADOStream.Position = 0
'create file system object to allow the script to check for an existing file
Set objFSO = Createobject("Scripting.FileSystemObject")
'check if the file exists, if it exists then delete it
If objFSO.Fileexists(sLocation) Then objFSO.DeleteFile sLocation
'destroy file system object
Set objFSO = Nothing
'save the ado stream to a file
objADOStream.SaveToFile sLocation
'close the ado stream
objADOStream.Close
'destroy the ado stream object
Set objADOStream = Nothing
'end object downloaded successfully
End if
'destroy xml http object
Set objXMLHTTP = Nothing
End function
download "http://remote-location-of-file", "C:\name-of-file-and-extension"
Your code misses the end function and you have an error at the line with wcript.sleep, without comments to be concise it should be something like
function download(sFileURL, sLocation, async)
set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", sFileURL, async
on error resume next
objXMLHTTP.send()
if err.number = 0 then
if objXMLHTTP.Status = 200 Then
set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0
set objFSO = Createobject("Scripting.FileSystemObject")
if objFSO.Fileexists(sLocation) then
objFSO.DeleteFile sLocation
end if
set objFSO = Nothing
objADOStream.SaveToFile sLocation
objADOStream.Close
set objADOStream = Nothing
download = true
end if
else
download = false
end if
set objXMLHTTP = Nothing
end function
if download("http://stackoverflow.com/questions/10782976/disable-error-in-vbs", "question.html", false) then
wscript.echo "download ok"
else
wscript.echo "download nok"
end if
See my other answer about the errors in your code.
This is a more concise version using the overwrite parameter so no check with fso needed.
function download2(url, destination)
download2 = false
on error resume next
set xml = CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", url, False
xml.Send
if err.number = 0 then
if xml.readystate = 4 then
if xml.status = 200 then
set oStream = createobject("Adodb.Stream")
const adTypeBinary = 1, adSaveCreateOverWrite = 2, adSaveCreateNotExist = 1
oStream.type = adTypeBinary
oStream.open
oStream.write xml.responseBody
oStream.saveToFile destination, adSaveCreateOverWrite
oStream.close
set oStream = nothing
download2 = true
end if
end if
end if
set xml = Nothing
end function
if download2("http://www.textpad.com/download/v60/txpeng600.zig", "txpeng600.zip") then
wscript.echo "download ok"
else
wscript.echo "download nok"
end if
'download nok

Resources