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...
Related
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
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.
This Function works:
Sub SaveImage(url, name)
' Set your settings
strFileURL = url
strHDLocation = "D:\Images\" & name
' Fetch the file
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
End Sub
If I call it once, it download the image, if I put it inside a loop it fail with different errors.
I set this function in a page, and set the URL and image name, then it download the image.
I have permission to everyone. NO PERMISSION ISSUE.
If I put it in a seperate page, then take the URL and image name from request, as:
Dim url, name
url = Request("url")
name = Request("name")
Then call the function:
Call SaveImage(url, name)
I get:
ADODB.Stream error '800a0bbc'
Write to file failed.
If I call it from the page, like this:
Call SaveImage("http://www.example.com/images/imageName.jpg", "imageName.jpg")
It dose download the image.
But if from the same place, I call the sub from inside a loop, like this:
Variables are declared above. Array is filled.
For row = 0 To UBound(myArray, 2)
url = CStr(ar(1, row)) : image = id & ".jpg"
Call SaveImage2(url, image)
Next
It fail in the first image.
ADODB.Stream error '800a0bbc'
Write to file failed.
I tried others stream writers, but others act the same with different errors.
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
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