Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Feb 24, 2017 08:02 Post subject: Сделать произвольную/заданную картинку фоном Рабочего стола |
|
|
Посмотрел на старые решения (1, 2) и решил выложить свой скрипт без использования утилит:
Code: | '••••••••••••••••••••••••••••••••••••••••••••• VBS ••••••••••••••••••••••••••••••••••••••••••••••
' Сделать произвольный в заданной папке или подкурсорный файл фоновым изображением Рабочего стола
' Параметр: "<Путь к папке с картинками или к графическому файлу>"
' Примеры: "%P" | %P%N | D:\MyWallpapers
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
Item = WSH.Arguments(0)
Set FSO = CreateObject("Scripting.FileSystemObject")
Filt = "*.bmp;*.gif;*.jpg;*.jpeg;*.png;*.tif;*.tiff"
If FSO.FileExists(Item) Then
If InStr(Filt & ";*", "." & LCase(FSO.GetExtensionName(Item)) & ";*") Then File = Item Else WSH.Quit
ElseIf FSO.FolderExists(Item) Then
Set Items = CreateObject("Shell.Application").NameSpace(Item).Items
Items.Filter 73920, Filt
Cnt = Items.Count : If Cnt = 0 Then WSH.Quit
Randomize: File = Items.Item(CLng(Round(Rnd * (Cnt - 1), 0))).Path
Else WSH.Quit : End If
GetObject("new:{9BA05972-F6A8-11CF-A442-00A0C90A8F39}").Item.document. _
Application.NameSpace(0).ParseName(File).InvokeVerb "setdesktopwallpaper" |
_________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|