@echo off
color 0a
::小宝 aaaaa0808 原创于2011-10-14

:获得当前当前路径
echo.
set /p wallpath=请拖入壁纸所在文件夹,并回车:
if %wallpath%*==* set wallpath="%cd%"
if exist %wallpath% (set wallpath=%wallpath:~1,-1%) else exit

::判断是否存在图片
Dir /b /s "%wallpath%\*.*" |Findstr /i ".bmp .jpg .gif .png" |Find /i /n "." >%temp%\ImgList.tmp
For %%i in (%temp%\ImgList.tmp) do If %%~zi EQU 0 Del %temp%\ImgList.tmp & exit

::设置更换频率
echo.
set /p tt=请输入更换频率( 秒 ),并回车:
set /a tt=%tt%

::获得分辨率
for /f "tokens=1,3 eol=H skip=8" %%a in ('reg query hkcc\system\currentcontrolset\control\video /s') do (
  if /i "%%a"=="DefaultSettings.XResolution" (set /a X=%%b) else (
    if /i "%%a"=="DefaultSettings.YResolution" set /a Y=%%b
  )
)
echo.
echo 当前分辨率: %X% * %Y%

::注册图片转换组件
If not exist %SystemRoot%\system32\WIAAut.dll (
	Copy /y %开机共享目录%\WIAAut.dll %SystemRoot%\system32
	RegSvr32 /s WIAAut.dll
)

::生成VBS脚本
set "ImgVbs=%temp%\ImgVbs.vbs"
echo Dim Fso,ImgFile,BmpFile,Img,IP >"%ImgVbs%"
echo ImgFile=WScript.Arguments(0)>>"%ImgVbs%"
echo BmpFile="%USERPROFILE%\Local Settings\Application Data\Microsoft\Wallpaper1.bmp">>"%ImgVbs%"
echo Set Fso = CreateObject("Scripting.FileSystemObject")>>"%ImgVbs%"
echo If Fso.FileExists(BmpFile) Then Fso.DeleteFile(BmpFile)>>"%ImgVbs%"
echo Set Img = CreateObject("WIA.ImageFile")>>"%ImgVbs%"
echo Set IP = CreateObject("WIA.ImageProcess")>>"%ImgVbs%"
echo Img.LoadFile ImgFile>>"%ImgVbs%"
echo IP.Filters.Add IP.FilterInfos("Convert").FilterID>>"%ImgVbs%"
echo IP.Filters(1).Properties("FormatID").Value = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}" >>"%ImgVbs%"
echo IP.Filters(1).Properties("Quality").Value =9 >>"%ImgVbs%"
echo Set Img = IP.Apply(Img)>>"%ImgVbs%"
echo Img.SaveFile BmpFile>>"%ImgVbs%"
echo Set Img=Nothing>>"%ImgVbs%"
echo Set IP=Nothing>>"%ImgVbs%"
echo Set Fso=Nothing>>"%ImgVbs%"
echo wscript.quit>>"%ImgVbs%"

::随机查找图片
For /f "delims=[]" %%i in (%temp%\ImgList.tmp) do Set "Num1=%%i"
If %Num1% LSS 10 (Set "Num3=1") Else (if %Num1% LSS 100 (Set "Num3=2") Else Set "Num3=3")

::----------循环开始---------
echo.
echo 每%tt%秒后更新一次壁纸...
goto loop

:loop
::获得新地址
Call Set "Num2=%%random:~-%Num3%%%"
If %Num2% GTR %Num1% Goto loop
For /f "tokens=* delims=0" %%i in ("%Num2%") do Set "Num2=%%i"
If "%Num2%!"=="!" Set "Num2=%Num1%"
Set ImgPath=
For /f "tokens=1* delims=[]" %%i in (%temp%\ImgList.tmp) do If /i %%i==%Num2% Set "ImgPath=%%j"

::生成新壁纸
Start /wait WScript.exe "%ImgVbs%" "%ImgPath%"

::刷新桌面
Reg add "HKCU\Control Panel\Desktop" /v Wallpaper /d "%USERPROFILE%\Local Settings\Application Data\Microsoft\Wallpaper1.bmp" /f >nul
Reg add "HKCU\Control Panel\Desktop" /v TileWallpaper /d "0" /f >nul
Reg add "HKCU\Control Panel\Desktop" /v WallpaperStyle /d "0" /f >nul 
Reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v ListviewShadow /d "1" /f >nul
RunDll32.exe USER32.DLL,UpdatePerUserSystemParameters 
ping 127.1 /n %tt% >nul
goto loop
复制代码