VBS脚本自动更换壁纸

on error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
pt = "C:\WINDOWS\Media\壁纸"
set bmpfol = fso.getfolder(pt)
for each files in bmpfol.files
if fso.GetExtensionName(files.path) = "bmp" then bmppt = bmppt & files.path & "|"
next
bmppt = left(bmppt,len(bmppt) - 1)
if bmppt = "" then
msgbox "您选择的目录中不含有BMP图片，程序将退出！",64
wscript.quit
end if
bmpar = split(bmppt,"|")
Set ws = CreateObject("WScript.Shell")
for i = 0 to ubound(bmpar)
pt = bmpar(i)
ws.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\TileWallpaper","0","REG_SZ"
ws.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\Wallpaper",pt,"REG_SZ"
ws.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\WallpaperStyle","2","REG_SZ"
ws.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ListviewShadow","1","REG_DWORD"
'ws.run "gpupdate /force",0
ws.run "RunDll32.exe USER32.DLL,UpdatePerUserSystemParameters"
wscript.sleep 1000 * 60 * 5
if i = ubound(bmpar) then i = -1
next