my boss requests me to download the jpg file from the http and change it to the wallpaper periodically, here is my code
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "http://defsite.com/wallpaper/wallpaper.jpg", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "C:\Documents and Settings\Administrator\My Documents\My Pictures\Wallpaper\wallpaper.jpg", 2 '//overwrite
end with
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "c:\windows\system32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
however, the WshShell.Run can't update on the screen, the OS is XP. Is there any idea to do it?
Kindly Advice!
Related
I've searched all over, but couldnt find any answer. I want the savetofile path to be at the desktop, regardless of username. but i get an error. I think it is about the path, that causes the error. Any tips?
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "http://banos.me/Despacito.mp3", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile ""C:\Users\"" & LoginName & ""\Desktop\"", 2 '//overwrite
end with
In your code you have not specified how you get LoginName.
This code works:
Dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = createobject("Adodb.Stream")
Dim objShell
Dim userPath
Set objShell = Wscript.CreateObject("Wscript.Shell")
userPath = objShell.SpecialFolders("Desktop")
filePath = userPath &"\Despacito.mp3"
xHttp.Open "GET", "http://banos.me/Despacito.mp3", False
xHttp.Send
filePath = userPath &"\Despacito.mp3"
with bStrm
.type = 1
.open
.write xHttp.responseBody
.savetofile filePath, 2
end with
I am running the following VBScript program, download.vbs
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "http://websitelink/textfile.txt", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "c:\dump.txt", 2 '//overwrite
end with
in this program, it will download the textfile from given web url and save it to local disk in the given path.
but the problem is, its working well when i change the download path to local disk d:
and showing the following error when i use local disk c: as download path.
VBScript error message,
Script: C:\test\download.vbs
Line: 10
Char: 5
Error: Write to file failed.
Code: 800A0BBC
Source: ADODB.Stream
Please help. i will be very thankfull.
If the file doesn't exist - you want to use 1 on the safetofile. You can add some code
Const AdTypeBinary = 1, AdTypeText = 2
Const FsoRead = 1, FsoWrite = 2, FsoAppend = 8
Const BstrmCreate = 1, BstrmOvrWrt = 2
dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "http://websitelink/textfile.txt", False
xHttp.Send
mysavefile = "D:\dump.txt" 'Set your save-file here
with bStrm
.type = AdTypeBinary ' YOU MAY WANT TO CHANGE FILE TYPE FOR TEXT/BINARY
.open
.write xHttp.responseBody
if ( FSO.FileExists( mysavefile ) ) then
.savetofile mysavefile, BstrmCreate
else
.savetofile mysavefile, BstrmOvrWrt
end if
end with
I have a code that is supposed to download an image from the Internet and set it as wallpaper, but it keeps saying that there is a wrong number of arguments or invalid property assignment: SaveToFile.
strUser = CreateObject("WScript.Network").UserName
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("ADODB.Stream")
xHttp.Open "GET", "https://image.spreadshirtmedia.com/image-server/v1/compositions/1009468864/views/1,width=300,height=300,version=145225706 1/anonymous-seal-t-shirts-men-s-tall-t-shirt.jpg", False
xHttp.Send
With bStrm
.Type = 1 '//binary
.Open
.Write xHttp.responseBody
.Savetofile "C:\Users\",strUser,"\downloads", 2 '//overwrite
End With
Dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
sUserName = wshShell.ExpandEnvironmentStrings("strUser")
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sWinDir = oFSO.GetSpecialFolder(0)
sWallPaper = "C:\Users\eskonr\Pictures\Nice-Windows-7.jpg"
' update in registry
oShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", sWallPaper
' let the system know about the change
oShell.Run "C:\WINDOWS\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
MsgBox "done"
.SaveToFile "C:\Users\",strUser,"\downloads", 2 '//overwrite
You're trying to call .SaveToFile with 4 parameters: "C:\Users\", strUser, "\downloads", and 2, when you apparently want to build a path from the first three elements. Use the concatenation operator for that:
.SaveToFile "C:\Users\" & strUser & "\downloads", 2 '//overwrite
I was trying to make a download and execute macro. I finished the vbs code and it worked fine, I then put it in some subs and tried to run it as a macro. I get the error
Compile error, Syntax Error: objXMLHTTP.send()
It's weird that this only produces an error as a macro.
Here is the full code:
Sub macro()
Const ADTYPEBINARY = 1
Const ADSAVECREATEOVERWRITE = 2
Dim xHttp
Dim bStrm
Dim filename
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
strFileURL = "ftp://username:pass#ftpserver.com/putty.exe"
strHDLocation = tempfolder & "/putty.exe"
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
Else
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
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "cmd /c " & tempfolder & "/putty.exe", 0, True
End Sub
Thanks I changed it to this and it works fine:
Sub book()
Set objShell = CreateObject("Wscript.Shell")
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
xHttp.Open "GET", "https://the.earth.li/~sgtatham/putty/latest/x86/putty.exe", False
xHttp.Send
With bStrm
.Type = 1 '//binary
.Open
.Write xHttp.responseBody
.SaveTofile tempfolder & "/putty.exe", 2 '//overwrite
End With
objShell.Run "cmd /c " & tempfolder & "/putty.exe", 0, True
End Sub
dim xHttp: Set xHttp = createobject("microsoft.xmlhttp")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "https://www.website.com/apps/CertMgr.Exe", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "c:\CertMgr.Exe", 2 '//overwrite
end with
Using the above code I'm trying to download a file from a secure site to install a security certificate automatically, it works fine from a http site, but I'm needing to bypass the security errors. Any ideas?
You need to switch from MSXML2.XMLHTTP to MSXML2.ServerXMLHTTP and use the setOption method with the value SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS. Just place the call between Open and Send. Here's your example updated with the new code.
const SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = 13056
dim xHttp: Set xHttp = createobject("MSXML2.ServerXMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "https://www.website.com/apps/CertMgr.Exe", False
xHttp.setOption 2, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "c:\CertMgr.Exe", 2 '//overwrite
end with