Author Topic: [VBScript] Change windows wallpaper programatically  (Read 522 times)

0 Members and 1 Guest are viewing this topic.

Offline Kulverstukas

  • Administrator
  • Zeus
  • *
  • Posts: 6627
  • Cookies: 542
  • Fascist dictator
    • View Profile
    • My blog
[VBScript] Change windows wallpaper programatically
« on: June 26, 2014, 07:58:14 pm »
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.

Code: (vb) [Select]
'======================================================
'   Author: Kulverstukas
'   Date: 2014.06.24
'   Description:
'       Downloads and changes the wallpaper for current user,
'       but it only takes effect after the user has logged on
'       the second time. The script changes the wallpaper only
'       once and users can change it back.
'======================================================
Function DownloadWallpaper(fromWhere, toWhere)
Set xHttp = createobject("Microsoft.XMLHTTP")
Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", fromWhere, False
xHttp.Send

With bStrm
    .type = 1 ' binary
    .open
    .write xHttp.responseBody
    .savetofile toWhere, 2 ' overwrite
End With
End Function
'======================================================

Set wshShell = CreateObject("WScript.Shell")

' check if wallpaper was changed once
On Error Resume Next
value = WSHShell.RegRead(WallpaperChangedOnceKey)

' do this only if there is no key, or the key contains invalid data
If ((err.number <> 0) Or (value <> 1)) Then
    fullPath = wshShell.ExpandEnvironmentStrings("%USERPROFILE%\awesomeWallpaper.bmp")
    DownloadWallpaper "http://localhost/awesomeWallpaper.bmp", fullPath
    wshShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", fullPath, "REG_SZ"
    wshShell.RegWrite "HKCU\Control Panel\Desktop\WallpaperStyle", "2", "REG_SZ"
    wshShell.RegWrite "HKCU\ish\WallpaperChangedOnce", 1, "REG_DWORD"
End If