Change windows wallpaper programatically

vbscript-mini-logo

Another VBScript I produced, this time it’s to change the wallpaper. Well, we have a lot of computers used in classes and we decided it’s enough already to show off that shitty Windows background and replace it with our own wallpaper. Group Policy wasn’t much help – it allowed to change the wallpaper, however it would change for everyone, all the time and wouldn’t let people to change it back – what the hell Microsoft? Because of this I made a workaround – a VBScript to change the wallpaper but only once and let people change it back. Put this into the domain’s logoff script and done. In the morning they’ll have a fresh desktop :D
It works very simply – reads a custom registry key which contains 1 if the script has ran already and if it exists and data is valid (1 for true) the script exits. Otherwise it proceeds to download a wallpaper (has to be in BMP format, otherwise WinXP will not understand wtf you are giving it), sets it as a background, makes it stretch and if everything went fine, writes that control registry key so it knows that it has done shit before on this computer.
That’s basically it, very simple. Can be downloaded from here and of course the code for quick review is below.

  1. '======================================================
  2. '   Author: Kulverstukas
  3. '   Date: 2014.06.24
  4. '   Description:
  5. '       Downloads and changes the wallpaper for current user,
  6. '       but it only takes effect after the user has logged on
  7. '       the second time. The script changes the wallpaper only
  8. '       once and users can change it back.
  9. '======================================================
  10. Function DownloadWallpaper(fromWhere, toWhere)
  11. Set xHttp = createobject("Microsoft.XMLHTTP")
  12. Set bStrm = createobject("Adodb.Stream")
  13. xHttp.Open "GET", fromWhere, False
  14. xHttp.Send
  15.  
  16. With bStrm
  17.     .type = 1 ' binary
  18.     .open
  19.     .write xHttp.responseBody
  20.     .savetofile toWhere, 2 ' overwrite
  21. End With
  22. End Function
  23. '======================================================
  24.  
  25. Set wshShell = CreateObject("WScript.Shell")
  26.  
  27. ' check if wallpaper was changed once
  28. On Error Resume Next
  29. value = WSHShell.RegRead(WallpaperChangedOnceKey)
  30.  
  31. ' do this only if there is no key, or the key contains invalid data
  32. If ((err.number <> 0) Or (value <> 1)) Then
  33.     fullPath = wshShell.ExpandEnvironmentStrings("%USERPROFILE%\awesomeWallpaper.bmp")
  34.     DownloadWallpaper "http://localhost/awesomeWallpaper.bmp", fullPath
  35.     wshShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", fullPath, "REG_SZ"
  36.     wshShell.RegWrite "HKCU\Control Panel\Desktop\WallpaperStyle", "2", "REG_SZ"
  37.     wshShell.RegWrite "HKCU\ish\WallpaperChangedOnce", 1, "REG_DWORD"
  38. End If

Leave a Reply

Your email address will not be published. Required fields are marked *