How do I use %SYSTEMROOT% in VBS? - vbscript

I use this code to download a link and I want to save a file in %SystemRoot%\system32 but when replace C:\ with %SystemRoot%, the VBS can't run.
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"
download "http://demo.com/test.gif", "C:\test.gif" **OK**
download "http://demo.com/test.gif", "%SystemRoot%\system32\test.gif" **Faild**

You need to read environment variable in a VBS variable. Something like:
Dim mySystemRoot
Dim myPath
Dim wshShell
Set wshShell = CreateObject( "WScript.Shell" )
mySystemRoot = wshShell.ExpandEnvironmentStrings( "%SystemRoot%" )
wshShell = Nothing
download "http://demo.com/test.gif", myPath & "\test.gif"
Then use mySystemRoot variable to form your file path.

Related

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.

Save Image from URL. Fails inside a loop, but not when run once

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.

how to login with pop up ask for user and password batch file

Im trying to make a batch file or vbs file to download a .csv file but when i get to the website it has a popup!!(different window) that is asking to log in with user and password then i must hit the "OK" button. how do i tell the batch file to jump to the pop up and log in with the user name and password?
i found this code vbs code. but it get stuck on the pop up. and i must do it manually.
VBS CODE:
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "https://api.twilio.com/2010-04-01/Accounts/ACxxxxxx9/Calls.csv?PageSize=1000"
IE.Visible = True
While IE.Busy
WScript.Sleep 50
Wend
Set ipf = IE.document.all.UserNamer
ipf.Value ="MYUSERNAME"
Set ipf = IE.document.all.Password
ipf.Value ="MYpassword"
Set ipf = IE.document.all.submit
ipf.Click
IE.Quit
`
And tried
Set args = WScript.Arguments
'// you can get url via parameter like line below
'//Url = args.Item(0)
Url = "https://USERNAME:PASSWORD#api.twilio.com/2010-04-01/Accounts/ACfcxxxxxxxxx059/Calls.csv? PageSize=1000"
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", Url, False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "C:\Users\jeff\Downloads"
end with
Whats the best why i can automatically download this file?
THIS IS THE WORKING FILE.
'GetRemoteBinaryFile.vbs
CSVFile = "Calls.csv"
DestFolder = "C:\Downloads"
URL = "www.itworks.com"
bstrUser= username
bstrPassword=password
Set xml = CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", URL, False,bstrUser,bstrPassword
xml.Send
set oStream = createobject("Adodb.Stream")
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist = 1
oStream.type = adTypeBinary
oStream.open
oStream.write xml.responseBody
' Do not overwrite an existing file
oStream.savetofile "Calls.csv", adSaveCreateNotExist
' Use this form to overwrite a file if it already exists
' oStream.savetofile DestFolder & ImageFile, adSaveCreateOverWrite
oStream.close
set oStream = nothing
Set xml = Nothing

vbscript downloading file from cache

I need to download latest file from website without using wget or any external utility. I found following vbscript on stack overflow itself (didnt know link, because I have cleared the cache and history)
' Set your settings
strFileURL = "http://somewebsitehere.com/somefile"
strHDLocation = "D:\somepath\"
' 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
However after using this script, I found it did work correctly for first few trials but later download same file from cache instead of downloading the fresh file from net. I get same file from C:\Users\username\AppData\Local\Microsoft\Windows\INetCache\IE\0XQSU247.
I need to clear the INETCache and then re run the script to get the fresh file.
So how should this script be modified so it gets latest updated file from web server instead of getting files from cache.
This question might be lame, but I have no knowledge of vbscript.

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