批处理之家 - Powered by Discuz! Board

Option Explicit
Dim oWshShell, oFSO, oShell, WallpaperStyle, TileWallpaper, s, i
Const PATH = "D:\1" '图片文件夹
Const STYLE = "适应" '适应居中平铺拉伸填充
Set oWshShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Shell.Application")
oWshShell.CurrentDirectory = PATH
Select Case STYLE
Case "适应"
WallpaperStyle = "6"
TileWallpaper = "0"
Case "居中"
WallpaperStyle = "0"
TileWallpaper = "0"
Case "平铺"
WallpaperStyle = "0"
TileWallpaper = "1"
Case "拉伸"
WallpaperStyle = "2"
TileWallpaper = "0"
Case "填充"
WallpaperStyle = "10"
TileWallpaper = "0"
End Select
s = ""
For Each i In oFSO.GetFolder(oWshShell.CurrentDirectory).Files
If LCase(Right(i.Name, 4)) = ".jpg" Or LCase(Right(i.Name, 4)) = ".bmp" Then
s = s & i.Name & "|"
End If
Next
If s = "" Then Wsh.Quit()
i = Split(Left(s, Len(s) - 1), "|")
Randomize
s = i(Int((UBound(i) + 1) * Rnd()))
oWshShell.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\WallpaperStyle", WallpaperStyle, "REG_SZ"
oWshShell.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\TileWallpaper", TileWallpaper, "REG_SZ"
For Each i In oShell.NameSpace(oWshShell.CurrentDirectory).ParseName(s).Verbs
If i.Name = "设置为桌面背景(&B)" Then i.DoIt() : Wsh.Sleep 2000
Next