Смена обоев рабочего стола

SetWallpaper "D:\Wallpapers\Image.jpg"
 
Sub SetWallpaper(File)
   Set iXML = CreateObject("MSXml2.DOMDocument").CreateElement("tmp")
   iXML.Text = B64: iXML.DataType = "bin.base64"
   Set oFSO = CreateObject("Scripting.FileSystemObject")
   BName = oFSO.GetSpecialFolder(2) & "" & oFSO.GetTempName
   API = BName & ".exe"
   With CreateObject("SAPI.SpFileStream")
      .Format.Type = 1: .Open API, 3
      .Write iXML.NodeTypedValue: .Close
   End With
   Set iXML = Nothing
   Set oWSH = CreateObject("WScript.Shell")
   Ext = oFSO.GetExtensionName(File)
   WinVer = oWSH.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
   Check1 = WinVer < "6" And StrComp(Ext, "bmp", 1) <> 0
   Check2 = WinVer > "6" And WinVer < "6.2" And InStr(1, "|gif|png|tif|tiff|", "|" & Ext & "|", 1) > 0
   If Check1 Or Check2 Then
      If StrComp(Ext, "bmp", 1) Then
         Set oImg = CreateObject("WIA.ImageFile")
         oImg.LoadFile File: File = BName & ".bmp"
         With CreateObject("WIA.ImageProcess")
            .Filters.Add .FilterInfos("Convert").FilterID
            .Filters(1).Properties("FormatID").Value = _
            "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
            .Apply(oImg).SaveFile File
         End With
         Set oImg = Nothing
         Check = 1
      End If
   End If
   oWSH.Run """" & API & """ u@SystemParametersInfoW 20 0 """ & File & """ 4", 0, 1
   If Check Then oFSO.DeleteFile File, 1
   oFSO.DeleteFile API, 1
   Set oWSH = Nothing
End Sub
 
Function S(n): S = String(n,"A") :End Function
Function B64()
B64 = _
"TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQ"&S(47)&"gAAAAA4fug4AtAnNIbgBTM0hVGhpc"&_
"yBwcm9ncmFtIGNhbm5vdCBiZSBydW4gaW4gRE9TIG1vZGUuDQ0KJAAAAAAAAABQRQAATAED"&_
"AM1dylU"&S(10)&"OAAAwELAQwAAAgAAAAGAAAAAAAAXhAAAAAQAAAAIAAAAABAAAAQAAAA"&_
"AgAABQABAAAAAAAFAAEAAAAAAABAAAAAAgAAAAAAAAIAAIEAABAAABAAAAAAEAAAEAAAAAA"&_
"AAB"&S(15)&"MQhAABQ"&S(112)&"IAAAR"&S(36)&"C50ZXh0AAAAJQYAAAAQAAAACAAAA"&_
"AI"&S(18)&"CAAAGAucmRhdGEAAF4DAAAAIAAAAAQAAAAK"&S(18)&"BAAABALmRhdGEAAA"&_
"AIAAAAAD"&S(30)&"QAAAw"&S(21)&"BVieVTUYtNCIsZuRAAAABqAOL8/3UI6AoBAABQjU"&_
"34Uf91COgZAQAAg334AHTtieCNTbSLEIcRiRCDwASD6QQ5yHLwWP/QiQONTbg5zHYGU+igA"&_
"QAAjWX8W13CBADMVYvsUWgEMEAA/xUEIEAAUP8VMCBAAKMAMEAAhcB1CGoB/xUAIEAAgz0E"&_
"MEAAAn0YakBoSCBAAGhoIEAAagD/FTwgQABqAOvZg8AEjU38iUX86AMAAABQ68hVi+xRU4v"&_
"ZVleLA4lF/I1F/FDoMv///4s1ADBAAIv4ixUEMEAAjRSW6zKLAWaDOCx1MWaDeAIAdSqDwQ"&_
"SJTfw7ynQgjUX8UOj9/v//iw0AMEAAi/ihBDBAAI0UgYtN/DvKdceLx4kLX15bi+Vdw1WL7"&_
"FZXi30IizeLDujaAAAAjU4EiQ9fXl3CBABVi+yLDQAwQAChBDBAAFOLXQhWjRSBizM78nUQ"&_
"i0UMxwABAAAAM8DpggAAAIsOVzP/D7cBZoXAdF1mOXkCdVeD6Ch0E0h0BYPoA3VKi0UMxwA"&_
"BAAAA61KDxgSJdQg78nTrjU0I6A3///+LFQAwQACL+IsNBDBAAIt1CI0MijvxdCGLBjPJZo"&_
"M4KXUZZjlIAnUTg8YE6w7o/QAAAIv4iT6DxgQzyYtFDIkIi8eJM19eW13CCABVi+yLRQgrB"&_
"QAwQADB+AJQaMAgQADo3QMAAMxVi+xRUzPbi8FXZjkZdA5mgzhAdAiDwAJmORh18lZmORh1"&_
"JovxiXX8vwQhQABX/xUQIEAAi9iF23VFV/8VHCBAAIvYhdt1OOtmM9KNcAJmiRCL+Q+3AYl"&_
"1/GaFwHTKZjlZAnXJg/hrdL+D+Et0uoP4dXQFg/hVdbW/ICFAAOuui87oCwMAAIvwVlP/FS"&_
"QgQABWagCL2P8VFCBAAFD/FQwgQABehdt0E1+Lw1uL5V3DV2g4IUAA6CIDAABX/3X8aHAhQ"&_
"ADoFAMAAMxVi+xRU1ZXi/lqJFlmOQ8PhdgAAAAPt0cCZoXAD4S0AAAAZoN/BDoPhakAAAAr"&_
"wXRtg+g9D4SoAAAASHQ8g+gRdBBISA+FowAAAIPHBumuAAAAjU8G6G4CAACL8FZX/xUoIEA"&_
"AVmoA/xUUIEAAUP8VDCBAAOmHAAAAjU8GjVX86HgBAACDffwAdnb/dfxqDP8VFCBAAFD/FQ"&_
"ggQADrS41PBo1V/OhTAQAAixUAMEAAi/CLTfxqQFuLPIrrE41OAo1V/Og1AQAAi/CLRfyLP"&_
"IdmOR506Osqg/hhdRJmg38EW3ULi8/oIAAAAIv46xONVfyLz+gFAQAAZoM4AHUDi338i8df"&_
"XluL5V3DVYvsUVFTVleL8TPAaltZaixmOU4EjVYKjX4ID5TAM9uJRfiLy1hqAmaJRgSJXfx"&_
"Yg334AHQMZoM8Rl11BYXJdE9Jhcl1O2osW2Y5HEZRW3UwM9v/RfxmiRxGOV34dCJmg3xGAi"&_
"R1GmaDP2F1FGpbW2Y5GlFbdQpBg8ADg8cGg8IGQIPHAoPCAmY5HEZ1ousGM8lmiQxGi0X8w"&_
"eACUGoE/xUUIEAAUP8VCCBAAIlF+I1+BotF/EiFwH4jV/8VICBAAECLz400R+gr/v//i034"&_
"i/6JBJlDi0X8SDvYfN2Lz+gT/v//i034X16JBJmLwVuL5V3DVYvsUVNWi/GL2jPJV2aDPi1"&_
"1CDP/R4PGAusCi/kPtwZqMFqJVfxmO8J1Zw+3VgKD+nh0BYP6WHVZg8YED7cGZoXAdHdqOV"&_
"pmO0X8cg1mO8J3CA+3wIPoMOsmZoP4YXIOZoP4ZncID7fAg+hX6xJmg/hBckdmg/hGd0EPt"&_
"8CD6DeDxgLB4QQLyA+3BmaFwHW36ylmhcB0JGo5WmY7RfxyG2Y7wncWa8kKg8YCD7fAg8DQ"&_
"A8gPtwZmhcB134X/dAL32V+LxokLXluL5V3DVYvsUVZXi8EzyVFRUVFq/1BRUYlF/P8VGCB"&_
"AAIvwVmoE/xUUIEAAUP8VCCBAAIv4M8BQUFZXav//dfxQUP8VGCBAAIvHX16L5V3DVYvsge"&_
"wECAAAjUUMUP91CI2F/Pf//1D/FTggQABqEGoAjYX89///UGoA/xU8IEAAagD/FQAgQADM" &_
S(633)&"FgiAABmIgAAeCIAAIQiAACQIgAApCIAALYiAADMIgAA3CIAAOgiAAD6IgAAAAAAA"&_
"DwjAAAAAAAAIiMAABQj"&S(13)&"HcAaQBuAGEAcABpAGUAeABlAGMAIAB2ADEALgAyAAAA"&_
"UwBlAGUAIAByAGUAYQBkAG0AZQAgAG8AcgAgAHYAaQBzAGkAdAAgAGgAdAB0AHAAOgAvAC8"&_
"AcgBhAG0AbQBpAGMAaABhAGUAbAAuAGMAbwBtAC8AAAAAAFMAdABhAGMAawAgAGUAcgByAG"&_
"8AcgAgAG8AbgAgAGEAcgBnAHUAbQBlAG4AdAAgAG4AdQBtAGIAZQByACAAJQBkAAAAawBlA"&_
"HIAbgBlAGwAMwAyAC4AZABsAGwAAAAAAHUAcwBlAHIAMwAyAC4AZABsAGwAAAAAAEMAbwB1"&_
"AGwAZAAgAG4AbwB0ACAAbABvAGEAZAAgAG0AbwBkAHUAbABlACAAJQBz"&S(12)&"QwBvAH"&_
"UAbABkACAAbgBvAHQAIABmAGkAbgBkACAAcAByAG8AYwBlAGQAdQByAGUAIAAlAHMAIABpA"&_
"G4AIABtAG8AZAB1AGwAZQAgACUAcwAAAAAAFCI"&S(13)&"BiMAAAAgAABMIg"&S(13)&"w"&_
"IwAAOCAAAEQi"&S(13)&"FIjAAAwI"&S(29)&"BYIgAAZiIAAHgiAACEIgAAkCIAAKQiAAC"&_
"2IgAAzCIAANwiAADoIgAA+iIAAAAAAAA8IwAAAAAAACIjAAAUIwAAAAAAABkBRXhpdFByb2"&_
"Nlc3MAhwFHZXRDb21tYW5kTGluZVcAywJIZWFwQWxsb2MAzwJIZWFwRnJlZQAAGAJHZXRNb"&_
"2R1bGVIYW5kbGVXAABKAkdldFByb2Nlc3NIZWFwAAARBVdpZGVDaGFyVG9NdWx0aUJ5dGUA"&_
"PwNMb2FkTGlicmFyeVcAAE4FbHN0cmxlblcAAEUCR2V0UHJvY0FkZHJlc3MAAEcFbHN0cmN"&_
"weUEAAEtFUk5FTDMyLmRsbAAAFQJNZXNzYWdlQm94VwA1A3d2c3ByaW50ZlcAAFVTRVIzMi"&_
"5kbGwAAAYAQ29tbWFuZExpbmVUb0FyZ3ZXAABTSEVMTDMyLmRsb"&S(218)&"="
End Function