Держите рабочий конструктор
vbs, вызывать через cmd
читать дальше »
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * From Win32_DesktopMonitor")
For Each objItem in colItems
filename = "%ТУТ ПИШЕМ ГДЕ ЛЕЖАТ ФАЙЛЫ С ОБОЯМИ%" & objItem.ScreenWidth & "_" & objItem.ScreenHeight & ".bmp"
'msgbox (filename)
Set wshShell = WScript.CreateObject("WScript.Shell")
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sWinDir = oFSO.GetSpecialFolder(0)
If oFSO.FileExists(filename) Then
'sWallPaper = filename
oShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", filename
oShell.RegWrite "HKCU\Control Panel\Desktop\TileWallpaper", 1
oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
Else
msgbox ("Скажите системному администратору что файл " & filename & " отсутствует!")
End If
If objItem.ScreenHeight >0 Then
Exit For
End If
Next
Ну и плюс надо "нафотошопить" обои под те разрешения мониторов, которые у вас есть. С именами файлов 800_600.bmp, 1024_768.bmp...