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

@eatmore · Регистрация: 23.05.2010

Студворк — интернет-сервис помощи студентам

нужен скрипт после запуска которого менялся бы фон рабочего стола на любое изображение из определенной папки.

FlasherX · 08.07.2024, 22:02

Сообщение от HackerVlad

нет такого кода который взял бы и обновил рабочий стол

Ну фон же меняет. А насчёт иконок или меню для стола — это отправка F5 ему, но это на др. языках.

@HackerVlad · 08.07.2024, 22:08

Сообщение от FlasherX

это отправка F5 ему

Неа, я даже когда физически нажимаю F5 обои не меняются, только перезагрузка компьютера помогает (ну это если использовать скрипт с правкой реестра для смены обоев)

Добавлено через 1 минуту
nekit270, я не очень понимаю вашего когда, что вы там пытаетесь намудрить))) но без перезагрузки системы или хотябы LogOut выход из системы и снова вход ничего не получится...

Добавлено через 41 секунду
Только код от FlasherX будет сразу менять обои и обновлять десктоп.

Добавлено через 1 минуту

Сообщение от nekit270

решение, не связанное с тем, что пользователь наворотил в своих SystemFileAssociations

Такое решение вряд ли получится найти, хотя не исключаю, что это возможно, но просто слишком сильно сложно.

FlasherX · 08.07.2024, 22:22

Сообщение от HackerVlad

Неа, я даже когда физически нажимаю F5 обои не меняются
Только код от FlasherX будет сразу менять обои и обновлять десктоп.

Дык я отвечал на "нет такого кода". Мой код же есть. Правильно было бы написать "у меня не было".

Есть у меня, в принципе, ещё вариантец, но он скорее для гурманов, так, побаловаться. )

@HackerVlad · 08.07.2024, 22:30

FlasherX, для гурманов это вызов API из VBS наверное...

Добавлено через 1 минуту
На VB6 лично я этот код давно сделал, который работает на всех версиях Windows для всех типов графических файлов, для VBS конечно сложнее. VBS ограничен из-за отсутствия API. Однако, возможно существует способ и без API если знать как обратиться к IActiveDesktop

Добавлено через 4 минуты
Я не силён просто в программировании VBS однако хочу сказать что правильный код установки обоев на рабочий стол будет именно через объект IActiveDesktop вот даже вроде как есть у меня константы для этого:

Visual Basic
1
2
Private Const CLSID_ActiveDesktop   As String = "{75048700-EF1F-11D0-9888-006097DEACF9}"
Private Const IID_ActiveDesktop     As String = "{F490EB00-1240-11D1-9888-006097DEACF9}"

Возможно есть какой-то способ создать такие объекты через CreateObject или GetObject и обратиться напрямую к интерфейсу IActiveDesktop но я понятия не имею как это делается.

FlasherX · 08.07.2024, 22:31

Сообщение от HackerVlad

для гурманов это вызов API из VBS наверное.

Не совсем "из", но из этой оперы. )

Сообщение от HackerVlad

VBS ограничен из-за отсутствия API.

Да, но при желании можно добавить.

Сообщение от HackerVlad

если знать как обратиться к IActiveDesktop

Что имеется в виду?

@HackerVlad · 08.07.2024, 22:33

На VB6 это вообще делалось через ассемблерную вставку, поэтому возможно ли это осуществить в VBS я понятия не имею даже

FlasherX · 08.07.2024, 22:34

Сообщение от HackerVlad

Возможно есть какой-то способ создать такие объекты через CreateObject или GetObject

Через встроенные COM вряд ли.

@HackerVlad · 08.07.2024, 22:46

FlasherX, вот код на VB6: Как программно в Windows XP поменять картинку на рабочем столе, используя файл JPG?
вряд ли это реалезуемо в VBS

Добавлено через 2 минуты

Сообщение от FlasherX

Что имеется в виду?

https://learn.microsoft.com/en... twallpaper

Добавлено через 33 секунды
Если знать как вызвать IActiveDesktop::SetWallpaper из VBS то это будет идеальный код.

Добавлено через 2 минуты
Кстати кажется нашёл такой код в интернете...

Добавлено через 5 минут
Вот посмотрите [...] но там DLL надо... Поэтому фокус не пройдёт...

FlasherX · 08.07.2024, 22:48

Сообщение от HackerVlad

вот код на VB6:

И опять публикуем ошибочный вариант?

Сообщение от HackerVlad

Но в XP почему-то пропускает только BMP-файлы!? Как обойти это ограничение?

Вот я как раз про это. На vbs можно сконвертировать в bmp. А так тот же SystemParametersInfoW.

@HackerVlad · 08.07.2024, 22:51

Сообщение от FlasherX

И опять публикуем ошибочный вариант?

Я нахожу этот вариант нормальным.

Сообщение от FlasherX

Есть у меня, в принципе, ещё вариантец

Лично у меня больше вариантов нет, так что жду ваш вариантец.

FlasherX · 08.07.2024, 22:54

Сообщение от HackerVlad

Вот посмотрите

Зачем же правила (5.8) нарушать?
Знаю эту библиотеку, но у меня кое-что покомпактней, раз так в 25.

Добавлено через 1 минуту

Сообщение от HackerVlad

Я нахожу этот вариант нормальным.

Убираем On Error Resume Next, авось станет понятно, почему он не такой.

@HackerVlad · 08.07.2024, 22:55

Буду откровенен запрет делиться полезными ссылками это полная ерунда а не правило. Пусть меня накажут если я преступник)))))))))))

Добавлено через 48 секунд
FlasherX, так я же специально упростил этот код ну, зачем мне проверять на типы файлов, если вдруг тип файла будет другим

FlasherX · 09.07.2024, 03:13

Если будет другим, то не сработает. Но речь шла не об этом. oShA не объявлена.

Сообщение от HackerVlad

так что жду ваш вариантец

Позже. Надо отлучиться...

Добавлено через 4 часа 1 минуту

Короче, вот такая вот фиговина:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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")
   If oWSH.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion") <= "5.1" Then
      If StrComp(oFSO.GetExtensionName(File), "bmp", 1) Then
         Set oImg = CreateObject("WIA.ImageFile")
         oImg.LoadFile File
         With CreateObject("WIA.ImageProcess")
            .Filters.Add .FilterInfos("Convert").FilterID
            .Filters(1).Properties("FormatID").Value = _
            "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
            .Apply(oImg).SaveFile BName & ".bmp"
         End With
         Set oImg = Nothing
      End If
   End If
   oWSH.Run API & " u@SystemParametersInfoW 20 0 """ & BName & ".bmp"" 0x04""", 0, 1
   oFSO.DeleteFile BName & ".bmp", 1
   oFSO.DeleteFile BName & ".exe", 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

@nekit270 · 09.07.2024, 05:01

учитывая то, что SystemParametersInfo можно скормить не только BMP, код может быть упрощён:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub SetWallpaper(fileName)
    Dim b64, exeFile
    b64 = "TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAAA4fug4AtAnNIbgBTM0hVGhpcyBwcm9ncmFtIGNhbm5vdCBiZSBydW4gaW4gRE9TIG1vZGUuDQ0KJAAAAAAAAABQRQAATAEDAH+dP2UAAAAAAAAAAOAAIgALATAAABoAAAAIAAAAAAAATjgAAAAgAAAAQAAAAABAAAAgAAAAAgAABAAAAAAAAAAEAAAAAAAAAACAAAAAAgAAAAAAAAMAQIUAABAAABAAAAAAEAAAEAAAAAAAABAAAAAAAAAAAAAAAPw3AABPAAAAAEAAANwEAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAAACAAAAAAAAAAAAAAACCAAAEgAAAAAAAAAAAAAAC50ZXh0AAAAVBgAAAAgAAAAGgAAAAIAAAAAAAAAAAAAAAAAACAAAGAucnNyYwAAANwEAAAAQAAAAAYAAAAcAAAAAAAAAAAAAAAAAABAAABALnJlbG9jAAAMAAAAAGAAAAACAAAAIgAAAAAAAAAAAAAAAAAAQAAAQgAAAAAAAAAAAAAAAAAAAAAwOAAAAAAAAEgAAAACAAUABCgAAPgPAAABAAAADAAABgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAF4CKAUAAAoAAAIDfQEAAAQCBH0CAAAEKhMwBwDhAAAAAQAAEQDQAQAAGygGAAAKCgKOaY0GAAABCxYTCSsVAAcRCQIRCZooBwAACqIAEQkXWBMJEQkCjmn+BBMKEQot3nIBAABwcwgAAAoMCBcoCQAACg0JciEAAHBvCgAAChMEEQRyPQAAcCABAQAA0BUAAAEoBgAACm8LAAAKEwURBSCGEAAAFxiNBgAAASUW0AUAAAEoBgAACqIlF9AXAAABKAYAAAqibwwAAAoTBhEGGW8NAAAKABEFcl0AAHAgxgEAAAYHbw4AAAoTBxEHGW8PAAAKABEFbxAAAAoTCBEIEwsrABELKgAAABMwBwDdAAAAAQAAEQACKAcAAAoKA45pjQYAAAELFhMJKxUABxEJAxEJmigHAAAKogARCRdYEwkRCQOOaf4EEwoRCi3ecgEAAHBzCAAACgwIFygJAAAKDQlyIQAAcG8KAAAKEwQRBHI9AABwIAEBAADQFQAAASgGAAAKbwsAAAoTBREFIIYQAAAXGI0GAAABJRbQBQAAASgGAAAKoiUX0BcAAAEoBgAACqJvDAAAChMGEQYZbw0AAAoAEQVyXQAAcCDGAQAABgdvDgAAChMHEQcZbw8AAAoAEQVvEAAAChMIEQgTCysAEQsqAAAAEzADABMAAAACAAARAAIDBG8RAAAKKAEAACsKKwAGKgATMAMAuQAAAAMAABEAAigCAAAGCn4SAAAKCwNyawAAcG8TAAAKEwURBSwcAAYDF28UAAAKKBUAAApzFgAACigEAAAGCwArCgAGAygDAAAGCwBzFwAACgxzGAAACg0ABBMGFhMHKysRBhEHmhMIAAgRCHsBAAAEbxkAAAoACREIewIAAARvGgAACgAAEQcXWBMHEQcRBo5pMs0IbxsAAAooAgAAKxMEBxEEKBwAAAoJbx0AAApvHgAACqUBAAAbEwkrABEJKgAAABMwBAAUAAAABAAAEQACAwQFbxEAAAooCgAABgorAAYqGzADAMYAAAAFAAARAAIoAgAABgp+EgAACgsDcmsAAHBvEwAAChMFEQUsHAAGAxdvFAAACigVAAAKcxYAAAooBAAABgsAKwoABgMoAwAABgsAcxcAAAoMcxgAAAoNAAUTBhYTBysrEQYRB5oTCAAIEQh7AQAABG8ZAAAKAAkRCHsCAAAEbxoAAAoAABEHF1gTBxEHEQaOaTLNBAhvGwAACigGAAAGEwQABxEEKBwAAAoJbx0AAApvHgAAChMJ3hATCgARCm8fAAAKcyAAAAp6EQkqAAABEAAAAACbABizABAPAAABEzACAO0AAAAGAAARAAIKBnJvAABwKCEAAAoLBywLcncAAHAKOMgAAAAGcpEAAHAoIQAACgwILAtymwAAcAo4rgAAAAZytwAAcCghAAAKDQksC3LBAABwCjiUAAAABnLbAABwKCEAAAoTBBEELAhy5wAAcAorewZyAwEAcCghAAAKEwURBSwIchEBAHAKK2IGci0BAHAoIQAAChMGEQYsCHI3AQBwCitJBnJPAQBwKCEAAAoTBxEHLAhyXQEAcAorMAZyeQEAcCghAAAKEwgRCCwIcoMBAHAKKxcGcpsBAHAoIQAAChMJEQksBnKpAQBwCgYTCisAEQoqAAAAGzAFAEQCAAAHAAARAHMiAAAKCgKOaRn+BAsHLBQAcsUBAHAoIwAACgAXKCQAAAoAAAKOaRn+AgwIOY0BAAAAAAIZKAMAACtvJgAACg04YAEAAAlvJwAAChMEABEEF40jAAABJRYfOp1vKAAAChMFfhIAAAoTBhYTBxEEcnACAHAoIQAAChMIEQgsHwAXEwcYjRsAAAElFnJdAQBwoiUXcnoCAHCiEwUAKyERBY5pGP4EEwkRCSwUAHJ8AgBwKCMAAAoAFygkAAAKAAARBRaacpoCAHAoIQAAChMKEQosKAARBRZyXQEAcKIRBReaKAsAAAYoBwAACigpAAAKKCoAAAoTBhcTBwARBRYRBRaaKAsAAAaiAAYRBRaaEQctRxEFFppyXQEAcCghAAAKLSJypgIAcBEFFygDAAArKCsAAAoRBRaaKAcAAAooLAAACisTEQUXmigVAAAKcxYAAAqMFwAAASsHEQaMFwAAAXMBAAAGby0AAAoAAN43JgByfAIAcCgjAAAKABcoJAAACgAA3iATCwByqgIAcCguAAAKABELKC8AAAoAFygkAAAKAADeAAAJbzAAAAo6lf7//94LCSwHCW8xAAAKANwAAAACGJoTDBEMcroCAHAoIQAAChMNEQ0sFgACFpoCF5pydwAAcAYoCQAABiYAKxsAAhaaAheaEQwoCwAABgYoCQAABigvAAAKAAAA3jcmAHLEAgBwKCMAAAoAFygkAAAKAADeIBMOAHKqAgBwKC4AAAoAEQ4oLwAACgAXKCQAAAoAAN4AKkF8AAAAAAAACAEAAGYAAABuAQAAFwAAABEAAAEAAAAACAEAAGYAAACFAQAAIAAAAA8AAAECAAAAQQAAAHIBAACzAQAACwAAAAAAAAAAAAAAwAEAAEwAAAAMAgAAFwAAABIAAAEAAAAAwAEAAEwAAAAjAgAAIAAAAA8AAAEiAigFAAAKACoAAABCU0pCAQABAAAAAAAMAAAAdjQuMC4zMDMxOQAAAAAFAGwAAAC0BAAAI34AACAFAACEBQAAI1N0cmluZ3MAAAAApAoAAAADAAAjVVMApA0AABAAAAAjR1VJRAAAALQNAABEAgAAI0Jsb2IAAAAAAAAAAgAAAVcVAhwJDAAAAPoBMwAWAAABAAAAJgAAAAQAAAACAAAADQAAABoAAAAxAAAABAAAAAcAAAABAAAABgAAAAMAAAABAAAAAgAAAAMAAAADAAAAAABIAgEAAAAAAAYAzwEZBAYAHgIZBAYAuwHGAw8AOQQAAAYA8gSmAgYAcAGmAgYAKgG3AgYAVQP/BAYAKAP/BAYANgP/BAYAQgP/BAYAGgP/BAYAHQBdAAYA7wHZAwYA8gKmAgYADwBdAAYA7AKmAgYA1gKmAgYAugCmAgYAzQT/BAYAowGmAgYAZwS3AgYAvwOmAgYAVgS3AgYAugS3AgYAdgS3AgYAXAKmAgYAJACmAgYAhQL6AwYArAGmAgYA3gCmAgYAGwWmAgoAowAJAwYAAQBdAAYAFQOmAgYAPAWmAgYAjQOnBAYArgCmAgAAAAA8AAAAAAABAAEAAQAQACcFRwAVAAEAAQCBARAAZQNHABUAAwACAAAAEAAqACoAFQADAAsABgBwAaYBBgA8AqkBUCAAAAAAhhinA6wBAQAAAAAAgACRIGsFsgEDAAAAAACAAJEg4wS3AQQAAAAAAIAAkSDjBL0BBgBoIAAAAACRAJQBwwEIAFghAAAAAJEAlAHLAQkARCIAAAAAlgDJAtMBCwBkIgAAAACWAMkC4QEOACwjAAAAAJYAyQLsAREATCMAAAAAlgDJAvkBFQAwJAAAAACRABIBAwIZACwlAAAAAJYArQIIAhoA+CcAAAAAhhinAwYAGwAAAAEAdQEAAAIAQgIAAAEACgEAAAEA+gAAAAIAAQEAAAEA+gAAAAIAjQIAAAEASAQAAAEAYgEAAAIASAQAAAEACgEAAAIAAQEAAAMAogQAAAEACgEAAAIAAQEAAAMAogQAAAEACgEAAAIAAQEAAAMAdQEAAAQAogQAAAEACgEAAAIAAQEAAAMAdQEAAAQAogQAAAEA/AIAAAEAogQJAKcDAQARAKcDBgAZAKcDCgBxAKcDBgApAKcDBgAxAMwALQAxAG0BNAA5AKcDOgBBAFUFPwBBAOYASABJAEwBTgBRAK0DWABZAIsEZABRAHwAagBhAIsEZABRAFcBdwAUAE0FiAC5AP8CrQDZAG0CsADZAGMCtQDhAI4BugC5AKcDAQAcAKcDBgAkAKcDBgAcAHgAywAkAHgAywAcAE0FiADpAG8D0QAkAE0FiADxAJUA2QB5AIkA/gB5AKcDOgDZAHcFEAEUAKcDBgD5ADcBNAEBARYFOQEJAQQDPgEsAJkDXAE0ADAFawHZAPkEcAHpAFUCdwHpAHgCfQHZALICggEhAUEBjQEUAHgAywD5ALUBNAH5ADcBlAEpAUQFmQExAYYBBgAuAAsADgIuABMAFwIuABsANgJAASMAPwIQAHwAkwDfAOMAAgEWAZkCKgCBAL8AxQBVAWUBAAEFAGsFAQAAAQcA4wQBAAABCQDjBAEABIAAAAAAAAAAAAAAAAAAAAAAMwAAAAQAAAAAAAAAAAAAAJ0BVAAAAAAABAAAAAAAAAAAAAAAnQF6AQAAAAAAAAAACwBFAAAAAAAPAEUAAAAAABEARQAQAI4ACgCOAEsAUQEAAAAAAElFbnVtZXJhYmxlYDEASUVudW1lcmF0b3JgMQBMaXN0YDEASW50MzIAUnVuRExMMzQAcnVuZGxsMzQAPE1vZHVsZT4AVABEbGxDYWxsZXJMaWIAbXNjb3JsaWIAU3lzdGVtLkNvbGxlY3Rpb25zLkdlbmVyaWMAQWRkAERlZmluZU1ldGhvZABnZXRfTWVzc2FnZQBEeW5hbWljSW52b2tlAEVudW1lcmFibGUASURpc3Bvc2FibGUAUnVudGltZVR5cGVIYW5kbGUAR2V0VHlwZUZyb21IYW5kbGUAQ29uc29sZQBEZWZpbmVEeW5hbWljTW9kdWxlAG1vZHVsZQBmdW5jTmFtZQBkbGxOYW1lAFNob3J0VHlwZU5hbWVUb0Z1bGxOYW1lAEFzc2VtYmx5TmFtZQBXcml0ZUxpbmUAQ2hhbmdlVHlwZQBEZWZpbmVUeXBlAENyZWF0ZVR5cGUAcmV0dXJuVHlwZQBHZXRUeXBlAHR5cGUAU3lzdGVtLkNvcmUARGlzcG9zZQBQYXJzZQBDcmVhdGVEZWxlZ2F0ZQBNdWx0aWNhc3REZWxlZ2F0ZQBXcml0ZQBEZWJ1Z2dhYmxlQXR0cmlidXRlAENvbXBpbGF0aW9uUmVsYXhhdGlvbnNBdHRyaWJ1dGUASGFuZGxlUHJvY2Vzc0NvcnJ1cHRlZFN0YXRlRXhjZXB0aW9uc0F0dHJpYnV0ZQBSdW50aW1lQ29tcGF0aWJpbGl0eUF0dHJpYnV0ZQBWYWx1ZQB2YWx1ZQBydW5kbGwzNC5leGUAU2l6ZU9mAFN0cmluZwBTdWJzdHJpbmcAU3RhcnRzV2l0aABBbGxvY0hHbG9iYWwATWFyc2hhbABmdW5jT3JkaW5hbABrZXJuZWwzMi5kbGwAU3lzdGVtAE1haW4ASm9pbgBTeXN0ZW0uUmVmbGVjdGlvbgBDYWxsRnVuY3Rpb24AQXJndW1lbnROdWxsRXhjZXB0aW9uAEZvcm1hdEV4Y2VwdGlvbgBzbgBaZXJvAFNraXAAU3lzdGVtLkxpbnEAQ2hhcgBNZXRob2RCdWlsZGVyAE1vZHVsZUJ1aWxkZXIAVHlwZUJ1aWxkZXIAQ29uc3RydWN0b3JCdWlsZGVyAEFzc2VtYmx5QnVpbGRlcgBEbGxDYWxsZXIAR2V0RGVsZWdhdGVGb3JGdW5jdGlvblBvaW50ZXIASUVudW1lcmF0b3IAR2V0RW51bWVyYXRvcgAuY3RvcgBEZWZpbmVDb25zdHJ1Y3RvcgBJbnRQdHIAU3lzdGVtLkRpYWdub3N0aWNzAFN5c3RlbS5SdW50aW1lLkV4Y2VwdGlvblNlcnZpY2VzAFN5c3RlbS5SdW50aW1lLkludGVyb3BTZXJ2aWNlcwBTeXN0ZW0uUnVudGltZS5Db21waWxlclNlcnZpY2VzAERlYnVnZ2luZ01vZGVzAGFyZ3VtZW50VHlwZXMATWV0aG9kQXR0cmlidXRlcwBUeXBlQXR0cmlidXRlcwBNZXRob2RJbXBsQXR0cmlidXRlcwBTZXRJbXBsZW1lbnRhdGlvbkZsYWdzAGFyZ3MAU3lzdGVtLkNvbGxlY3Rpb25zAENhbGxpbmdDb252ZW50aW9ucwBBc3NlbWJseUJ1aWxkZXJBY2Nlc3MAR2V0UHJvY0FkZHJlc3MAT2JqZWN0AFNwbGl0AFN5c3RlbS5SZWZsZWN0aW9uLkVtaXQARXhpdABFbnZpcm9ubWVudABBcmd1bWVudABnZXRfQ3VycmVudABDb252ZXJ0AE1vdmVOZXh0AFRvQXJyYXkARGVmaW5lRHluYW1pY0Fzc2VtYmx5AExvYWRMaWJyYXJ5AG9wX0VxdWFsaXR5AAAAH0QAeQBuAGEAbQBpAGMAQQBzAHMAZQBtAGIAbAB5AAAbRAB5AG4AYQBtAGkAYwBNAG8AZAB1AGwAZQAAH0QAeQBuAGEAbQBpAGMARABlAGwAZQBnAGEAdABlAAANSQBuAHYAbwBrAGUAAAMjAAAHaQBuAHQAABlTAHkAcwB0AGUAbQAuAEkAbgB0ADMAMgAACXUAaQBuAHQAABtTAHkAcwB0AGUAbQAuAFUASQBuAHQAMwAyAAAJbABvAG4AZwAAGVMAeQBzAHQAZQBtAC4ASQBuAHQANgA0AAALdQBsAG8AbgBnAAAbUwB5AHMAdABlAG0ALgBVAEkAbgB0ADYANAAADWQAbwB1AGIAbABlAAAbUwB5AHMAdABlAG0ALgBEAG8AdQBiAGwAZQAACWIAeQB0AGUAABdTAHkAcwB0AGUAbQAuAEIAeQB0AGUAAA1pAG4AdABwAHQAcgAAG1MAeQBzAHQAZQBtAC4ASQBuAHQAUAB0AHIAAAljAGgAYQByAAAXUwB5AHMAdABlAG0ALgBDAGgAYQByAAANcwB0AHIAaQBuAGcAABtTAHkAcwB0AGUAbQAuAFMAdAByAGkAbgBnAACAqVUAcwBhAGcAZQA6ACAAcgB1AG4AZABsAGwAMwA0ACAAPABkAGwAbAAgAG4AYQBtAGUAPgAgADwAZgB1AG4AYwB0AGkAbwBuACAAbgBhAG0AZQA+ACAAPAByAGUAdAB1AHIAbgAgAHQAeQBwAGUAPgAgAFsAYQByAGcAdQBtAGUAbgB0AHMAOgAgADwAdAB5AHAAZQA+ADoAPAB2AGEAbAB1AGUAPgBdAAAJbgB1AGwAbAAAAQAdSQBuAHYAYQBsAGkAZAAgAGYAbwByAG0AYQB0AAALYQBsAGwAbwBjAAADOgAAD0UAcgByAG8AcgA6ACAAAAl2AG8AaQBkAAA5SQBuAHYAYQBsAGkAZAAgAEQATABMACAAbwByACAAZgB1AG4AYwB0AGkAbwBuACAAbgBhAG0AZQAAAACy476/9DVJRJKX/KM2G6/HAAQgAQEIAyAAAQUgAQERERkHDBIZHRIZEh0SIRIlEikSLRIxEhkIAhIZAh4ABgABEhkRTQUAARIZDgQgAQEOCAACEiESHRFRBSABEiUOCSADEikOEVkSGQsgAxItEWERZR0SGQUgAQERaQwgBBIxDhFhEhkdEhkEIAASGQQHAR4ABhUSNQESCAUgAB0TAAQKAR4AGQcKGBgVEjUBDhUSNQEcEhkCHRIICBIIHgACBhgEIAECDgQgAQ4IBAABCA4FFRI1AQ4FFRI1ARwFIAEBEwAHAAISeRgSGQUgARwdHAMHARwaBwsYGBUSNQEOFRI1ARwSGQIdEggIEggcEj0DIAAODQcLDgICAgICAgICAg4FAAICDg4dBw8VEjUBEggCAhUSQQEODh0OGAICAgISPQ4CEj0EAAEBDgQAAQEIEhABAhUSgIkBHgAVEoCJAR4ACAMKAQ4GFRKAiQEOCCAAFRJBARMABRUSQQEOBCAAEwAGIAEdDh0DBQABCBIZBAABGAgKAAIODhUSgIkBDgYAAhwcEhkEAAEBHAMgAAIIt3pcVhk04IkCBg4CBhwFIAIBDhwEAAEYDgUAAhgYDgUAAhgYGAcQAQESGR0OBwACEhkOHQ4NEAEDHgAODhUSNQESCAoQAQMeAA4OHRIIDAAEHA4ODhUSNQESCAkABBwODg4dEggEAAEODgUAAQEdDggBAAgAAAAAAB4BAAEAVAIWV3JhcE5vbkV4Y2VwdGlvblRocm93cwEIAQAHAQAAAAAEAQAAACQ4AAAAAAAAAAAAAD44AAAAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwOAAAAAAAAAAAAAAAAF9Db3JFeGVNYWluAG1zY29yZWUuZGxsAAAAAAD/JQAgQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAQAAAAIAAAgBgAAABQAACAAAAAAAAAAAAAAAAAAAABAAEAAAA4AACAAAAAAAAAAAAAAAAAAAABAAAAAACAAAAAAAAAAAAAAAAAAAAAAAABAAEAAABoAACAAAAAAAAAAAAAAAAAAAABAAAAAADcAgAAkEAAAEwCAAAAAAAAAAAAAEwCNAAAAFYAUwBfAFYARQBSAFMASQBPAE4AXwBJAE4ARgBPAAAAAAC9BO/+AAABAAAAAAAAAAAAAAAAAAAAAAA/AAAAAAAAAAQAAAABAAAAAAAAAAAAAAAAAAAARAAAAAEAVgBhAHIARgBpAGwAZQBJAG4AZgBvAAAAAAAkAAQAAABUAHIAYQBuAHMAbABhAHQAaQBvAG4AAAAAAAAAsASsAQAAAQBTAHQAcgBpAG4AZwBGAGkAbABlAEkAbgBmAG8AAACIAQAAAQAwADAAMAAwADAANABiADAAAAAsAAIAAQBGAGkAbABlAEQAZQBzAGMAcgBpAHAAdABpAG8AbgAAAAAAIAAAADAACAABAEYAaQBsAGUAVgBlAHIAcwBpAG8AbgAAAAAAMAAuADAALgAwAC4AMAAAADoADQABAEkAbgB0AGUAcgBuAGEAbABOAGEAbQBlAAAAcgB1AG4AZABsAGwAMwA0AC4AZQB4AGUAAAAAACgAAgABAEwAZQBnAGEAbABDAG8AcAB5AHIAaQBnAGgAdAAAACAAAABCAA0AAQBPAHIAaQBnAGkAbgBhAGwARgBpAGwAZQBuAGEAbQBlAAAAcgB1AG4AZABsAGwAMwA0AC4AZQB4AGUAAAAAADQACAABAFAAcgBvAGQAdQBjAHQAVgBlAHIAcwBpAG8AbgAAADAALgAwAC4AMAAuADAAAAA4AAgAAQBBAHMAcwBlAG0AYgBsAHkAIABWAGUAcgBzAGkAbwBuAAAAMAAuADAALgAwAC4AMAAAAOxCAADqAQAAAAAAAAAAAADvu788P3htbCB2ZXJzaW9uPSIxLjAiIGVuY29kaW5nPSJVVEYtOCIgc3RhbmRhbG9uZT0ieWVzIj8+DQoNCjxhc3NlbWJseSB4bWxucz0idXJuOnNjaGVtYXMtbWljcm9zb2Z0LWNvbTphc20udjEiIG1hbmlmZXN0VmVyc2lvbj0iMS4wIj4NCiAgPGFzc2VtYmx5SWRlbnRpdHkgdmVyc2lvbj0iMS4wLjAuMCIgbmFtZT0iTXlBcHBsaWNhdGlvbi5hcHAiLz4NCiAgPHRydXN0SW5mbyB4bWxucz0idXJuOnNjaGVtYXMtbWljcm9zb2Z0LWNvbTphc20udjIiPg0KICAgIDxzZWN1cml0eT4NCiAgICAgIDxyZXF1ZXN0ZWRQcml2aWxlZ2VzIHhtbG5zPSJ1cm46c2NoZW1hcy1taWNyb3NvZnQtY29tOmFzbS52MyI+DQogICAgICAgIDxyZXF1ZXN0ZWRFeGVjdXRpb25MZXZlbCBsZXZlbD0iYXNJbnZva2VyIiB1aUFjY2Vzcz0iZmFsc2UiLz4NCiAgICAgIDwvcmVxdWVzdGVkUHJpdmlsZWdlcz4NCiAgICA8L3NlY3VyaXR5Pg0KICA8L3RydXN0SW5mbz4NCjwvYXNzZW1ibHk+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAMAAAAUDgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
    
    Set oSh = CreateObject("WScript.Shell")
    exeFile = oSh.ExpandEnvironmentStrings("%TEMP%") & "\api.exe"
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    If Not oFSO.FileExists(exeFile) Then
        Set oXML = CreateObject("MSXML2.DomDocument")
        Set oEl = oXML.CreateElement("tmp")
        oEl.DataType = "bin.base64"
        oEl.Text = b64
        
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write oEl.NodeTypedValue
        oStream.SaveToFile exeFile, 2
    End If
    
    oSh.Run """" & exeFile & """ user32 SystemParametersInfoA int int:20 int:0 string:""" & oFSO.GetAbsolutePathName(fileName) & """ int:2", 0
End Sub
 
SetWallpaper "wallpaper.jpg"

@HackerVlad · 09.07.2024, 05:10

FlasherX, не работает(

Добавлено через 1 минуту

Сообщение от nekit270

не только BMP

по моему Win95-WinXP только BMP, а начиная от висты BMP и JPG но нельзя PNG по моему так

@HackerVlad · 09.07.2024, 05:12

FlasherX, у меня чё-то не фурычит короче

@HackerVlad · 09.07.2024, 05:32

nekit270, а вот твой код у меня прекрасно сработал сейчас

Добавлено через 22 секунды
nekit270, однако ты должен понимать что конвертировать нужно для PNG

Добавлено через 6 минут
Вообще конечно первый раз такой способ вижу, ну вы и гении конечно создавать какой-то api.exe я в шоке конечно от этого варианта...

Добавлено через 10 минут
Получается лучше всего написать функцию, которая будет проверять, что если файл не BMP и не JPG а что-то другое (скорее всего PNG) то тогда будет конвертировать в BMP

@nekit270 · 09.07.2024, 05:38

Сообщение от HackerVlad

конвертировать нужно для PNG

нет, не нужно.

Сообщение от HackerVlad

создавать какой-то api.exe

тот же rundll34, только в ином виде.

@HackerVlad · 09.07.2024, 05:42

Сообщение от nekit270

нет, не нужно

а у тебя может десятка? на десятке может и не нужно конечно, а у меня в семёрке PNG не работает

Добавлено через 1 минуту
Вообще к такому грубому методу через api.exe нужно прибегать только в том случае, если не получилось через самый лучший код через InvokeVerb "setdesktopwallpaper"...

FlasherX · 09.07.2024, 06:32

Сообщение от nekit270

учитывая то, что SystemParametersInfo можно скормить не только BMP

См. 49 пост.

Сообщение от HackerVlad

у меня чё-то не фурычит короче

Я хотел сразу исправить, но форум, как это часто случается в неподходящий момент, нагнулся...

Правка:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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")
   If oWSH.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion") <= "5.1" Then
      If StrComp(oFSO.GetExtensionName(File), "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
      End If
   End If
   oWSH.Run """" & API & """ u@SystemParametersInfoW 20 0 """ & File & """ 4", 0, 1
   oFSO.DeleteFile BName & ".bmp", 1
   oFSO.DeleteFile BName & ".exe", 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

Сообщение от HackerVlad

Получается лучше всего написать функцию, которая будет проверять, что если файл не BMP и не JPG

Она уже была написана для XP и ниже. См. внимательно код. JPG зря тут упомянут, с ним те же проблемы.

Новые блоги и статьи Все статьи Все блоги /
Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .	Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм anaschu 30.08.2026 Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .	Оттачиваю умение писать js программы. russiannick 30.08.2026 Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .
мат медиц модель 30. презентация проекта anaschu 27.08.2026 хоп хоп хоп хидахоп, а я кладую))	Как у меня протекала болезнь zorxor 27.08.2026 Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .	Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему kumehtar 26.08.2026 ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .	[EasyBuilder Pro] Памятка по разработке для панелей Weintek ФедосеевПавел 26.08.2026 Памятка по разработке для панелей Weintek ВВЕДЕНИЕ Ранее, при реализации проектов основное внимание уделял разработке управляющей программы для контроллера, а панели оператора доставалось время. . .

@eatmore 2 / 2 / 0 Регистрация: 23.05.2010 Сообщений: 5

	Смена обоев рабочего стола 28.05.2010, 16:19. Показов 22676. Ответов 80 Метки нет (Все метки) нужен скрипт после запуска которого менялся бы фон рабочего стола на любое изображение из определенной папки. 2

@HackerVlad Вернулся 1755 / 651 / 45 Регистрация: 10.09.2021 Сообщений: 2,807
	08.07.2024, 22:33
	На VB6 это вообще делалось через ассемблерную вставку, поэтому возможно ли это осуществить в VBS я понятия не имею даже 0

@HackerVlad Вернулся 1755 / 651 / 45 Регистрация: 10.09.2021 Сообщений: 2,807
	08.07.2024, 22:55
	Буду откровенен запрет делиться полезными ссылками это полная ерунда а не правило. Пусть меня накажут если я преступник))))))))))) Добавлено через 48 секунд FlasherX, так я же специально упростил этот код ну, зачем мне проверять на типы файлов, если вдруг тип файла будет другим 0

@HackerVlad Вернулся 1755 / 651 / 45 Регистрация: 10.09.2021 Сообщений: 2,807
	09.07.2024, 05:12
	FlasherX, у меня чё-то не фурычит короче Миниатюры 0

@HackerVlad Вернулся 1755 / 651 / 45 Регистрация: 10.09.2021 Сообщений: 2,807
	09.07.2024, 05:32
	nekit270, а вот твой код у меня прекрасно сработал сейчас Добавлено через 22 секунды nekit270, однако ты должен понимать что конвертировать нужно для PNG Добавлено через 6 минут Вообще конечно первый раз такой способ вижу, ну вы и гении конечно создавать какой-то api.exe я в шоке конечно от этого варианта... Добавлено через 10 минут Получается лучше всего написать функцию, которая будет проверять, что если файл не BMP и не JPG а что-то другое (скорее всего PNG) то тогда будет конвертировать в BMP 0