Change windows wallpaper programatically

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.

'======================================================

```
'   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
```