[AHK]Bing Desktop Wallpaper Changer(必应壁纸随心换)

先来个【简版的bing壁纸】

Winhttp := ComObjCreate("WinHttp.WinHttpRequest.5.1")
Winhttp.Open("GET", "https://cn.bing.com/HPImageArchive.aspx?format=js&idx=0&n=1",true)
Winhttp.Send()
Winhttp.WaitForResponse()
r := Winhttp.ResponseText
RegExMatch(r, "O)urlbase"":""(.*?)""", Match)
path := Match.Value(1)
RegExMatch(path, "\d*$", fname)
fname := fname . ".jpg"
url := "https://cn.bing.com" . path . "_1920x1080.jpg"
URLDownloadToFile, % url, % fname
imgpath := A_ScriptDir . "\" . fname
DllCall("SystemParametersInfo", UINT, 20, UINT, uiParam, STR, imgpath, UINT, 2)

【复杂版的】

在使用《必应换壁纸By-Zz》过程经常出现问题，且需要依赖GDIP.AHK库函数，一直想重写一个，参考了python版本的《Bing Desktop Wallpaper Changer》

使用方法：

启动运行会自动下载最近15天壁纸，如已经存在则跳过不下载

启动完成后会自动设置最新一天图片为壁纸

F1热键是设置前一天图片为壁纸，最多可以按15次，设置壁纸时间稍长需要耐心等待。

F2热键是设置后一天图片为壁纸，直到最新一天为止。

 

/*  
╔═════════════════════════════════  
║ 名称：Bing Desktop Wallpaper Changer(必应壁纸随心换)  
║ 版本：v1.5Beta  
║ 作者：Quant(1576157)  
║ 测试环境：WinXP Win10  
║ AutoHotkey：1.1.25.2 U32  
║ 更新时间：2018年8月22日17:05:15
║ --热键--  
║ F3键 显示主界面，  
║ 方向键 选择某一项，  
║ 空格键 应用当前选择的壁纸，  
║ 回车 应用并关闭主界面。  
║ --说明--  
║ 屏幕比例4:3时，下载1366x768分辨率图片，如不满意可以尝试修改DPI数组  
║ 最新版本：http://blog.youkuaiyun.com/liuyukuan/article/details/73656922  
╚═════════════════════════════════  
;~ Bing Desktop Wallpaper Changer  
;~ What does it do?  
;~ It grabs images exactly the same way Microsoft uses to put it up on its page - using XML/RSS/JSON. You can"t scrape the website directly. After searching on the internet for long I found out the link - http://www.bing.com/HPImageArchive.aspx?format=xml&idx=0&n=1&mkt=en-US  
;~ Here we can get data in any of the formats but substituting the value of format=[value] in the link.  
;~ idx denotes the day before the current day. idx=0 means current day, idx=1 means yesterday and so on. n is an integer denoting the number of days before the day denoted by idx. It grabs data about all the n number of images. mkt denotes the area. The script will try to match your locale to one of the supported Bing Market areas, falling back to "en-US" if it fails to do so. You can also force a particular market area (see list of valid markets in https://msdn.microsoft.com/en-us/library/dd251064.aspx) in the config file:  
  
;~ ~/.config/bing-desktop-wallpaper-changer/config.ini  
;~ Example:  
  
;~ [market]  
;~ # If you want to override the current Bing market dectection,  
;~ # set your preferred market here. For a list of markets, see  
;~ # https://msdn.microsoft.com/en-us/library/dd251064.aspx  
;~ area = "zh-CN"  
;~ To force your area to be "bg-BG" (Chinese – China).  
;~ area = "bg-BG"  
;~ To force your area to be "bg-BG" (Bulgarian - Bulgaria).  
;~ All the wallpapers are stored in "%A_ScriptDir%\BingWallpapers/"  
*/  
#SingleInstance,force
FileEncoding,UTF-8  
GroupAdd,Desktop,ahk_class Progman  
GroupAdd,Desktop,ahk_class WorkerW
GroupAdd,Desktop,ahk_class Shell_TrayWnd  
GroupAdd,Desktop,ahk_class qqpcdesktopmgr_background  
;全局变量  
WallpapersPath=%A_ScriptDir%\BingWallpapers\  
appname:="Bing Desktop Wallpaper Changer(必应壁纸随心换) "
IfNotExist,%WallpapersPath%  
{
    FileCreateDir,%WallpapersPath%  
}
ini= %A_ScriptDir%\cfg.ini
IfNotExist,%ini%
{
    MsgBox 不存在配置文件，将自动配置！
	FileAppend,
    (LTrim Join`r`n
    [cfg]
    auto=0
    n=15
    item=1
    ),%ini%,CP1200
 	
}

IniRead, chkValue, %ini%,cfg,auto
IniRead, n, %ini%, cfg, n,15
IniRead, item, %ini%, cfg, item,1

if (chkValue=1)
{
    ;直接设置最近1天图片为壁纸，不显示界面。  
    pic:=downAll(WallpapersPath,n)  
    List:=ArrayToGuiString(pic,1)  
    IniWrite,1,%ini%,cfg,item
    changeWallpaper(1)  

}else{
    
    ;下载最近15天的bing图片，最多支持15天的，显示界面以设置。 
    pic:=downAll(WallpapersPath,n)  
    List:=ArrayToGuiString(pic,item)  
    gosub Main
}
    
return


Main:  
;界面设计  
Gui, Add, Text, xm ym w325 Section, Select the wallpaper item you wish to change:  
Gui, Add, Text, w325 Section, <最新图片在最上面>:  
Gui, Add, ListBox, r15  wp AltSubmit gItemSelection vitem, %List%  
Gui, Add, Button, xs+150 w70 Section gCancel, Cancel 
Gui, Add, Button, xs+100 w70 ys gChangeItem Default,Ok
Gui, Add, CheckBox,xm vAuto w270 h20 gCheck Checked%chkValue% , 下次启动不开启本窗口直接设置壁纸为最新图片
Gui, Add, Link, xm, 查看最新代码 http://blog.youkuaiyun.com/liuyukuan

Gui, Show, AutoSize Center, %appname%  
return  
 
Check:
Gui,Submit,NoHide
return 
#z::
 WinGet, active_id, ID, A
 WinGetClass, this_class, ahk_id %active_id%
 WinGetTitle, this_title, ahk_id %active_id%
 MsgBox %this_class%
return 

#IfWinActive, appname . " ahk_class AutoHotkeyGUI"
Space::  
Gui, Submit,NoHide  
changeWallpaper(item)  
return  
  
Enter::  
ItemSelection:  
ChangeItem:  
if   (A_ThisLabel="ItemSelection" && A_GuiEvent<>"DoubleClick")  
   return  
Gui, Submit  
;将第1张作为壁纸 ：第1张 为今天，第2张 为昨天，以此类推  
changeWallpaper(item)  
;~ Gui, Destroy  
IniWrite, %n%, %ini%, cfg,n
IniWrite,%auto%,%ini%,cfg,auto
if (chkValue=1)
{
    IniWrite,1,%ini%,cfg,item
}
else
{
    IniWrite,%item%,%ini%,cfg,item
}
return  
#IfWinActive  
GuiEscape:
GuiCancel:  
GuiClose: 
Cancel:
Gui, Destroy  
return  
#IfWinActive   ahk_group Desktop  
f3::  
Gui, Destroy  
List:=ArrayToGuiString(pic,item)  
gosub main

return  
  
f1::  
item+=1  
if(item>n)  
{  
    item:=n  
    MsgBox  已经没有更早的了!  
}  
else  
{  
    SplashTextOn, , , 设置中，请耐心等待...
    changeWallpaper(item)  
    SplashTextOff  
}  
IniWrite,%item%,%ini%,cfg,item
return  
  
  
f2::  
item-=1  
if (item<=0)  
{         
    item:=1  
    MsgBox  已经是最新了!  
}  
else  
{  
    SplashTextOn, , , 设置中，请耐心等待...
    changeWallpaper(item)  
    SplashTextOff  
}  
IniWrite,%item%,%ini%,cfg,item
return  
#IfWinActive  
ArrayToGuiString(items , Select){  
    str := ""  
    for each, item in items  
        str .= item "|" (( A_Index == Select&& Select<=items.MaxIndex()) ? "|" : "")  
    return str  
}
changeWallpaper(idx)  
{  
    global  
    sFile:=WallpapersPath . pic[idx]  
    dsc:=desc[idx]  
    ;~ SplashTextOn, , , 设置中，请耐心等待...  
    setWallpapers(sFile)                  
    ;~ SplashTextOff  
    ;~ MsgBox,,设置成功：%sFile%,[%idx%]说明: %dsc%,10  
    ToolTip,设置成功：[%idx%]说明: %dsc%`n%sFile%,,%A_ScreenHeight%  
    FileAppend,%dsc%,% sFile . ".txt"  
  
    sleep,3000  
    ToolTip  
}  
downAll(savePath,num=1)  
{  
    global  
    wallpapers:=[]  
    desc:=[]  
    DPI:={   16_10:["1920x1200","1680x1050","1440x900","1280x800"]   
            ,16_9:["1920x1080","1600x900","1366x768"]  
            ,4_3:["1366x768","1152x864","800x600"]}  
    分辨率选项:=StrSplit(getDPI(),"|")       ;通过自动获取电脑分辨率智能匹配  
      
    ;~ 分辨率选项:=StrSplit("16_9|4_3","|")      ;手动指定  
      
    最佳分辨率:=DPI[分辨率选项[1]]  
  
    备选分辨率:=DPI[分辨率选项[2]]  
      
    ;xml2url(index,number)最多可下载15张  
    ; index=0               ;~有效值范围[0，7],索引值,从哪一天获取壁纸信息，是个相对值，最小值为0为从今天开始,1为从昨天开始,以此类推可下载历史壁纸  
    ; number=8              ;~有效值范围[1，8],wallpapers:=xml2url(0,8)获取一批壁纸信息,必填项，最小为1，大于8默认返回8张壁纸信息  
  
    if (num<=8)  
    {  
        xml:=getXml(0,num)  
        wallpapers:=xml2url(xml)  
        desc:=xml2Dscript(xml)  
    }  
    else  
    {  
        xml:=getXml(0,8)  
        wallpapers1:=xml2url(xml)  
        desc1:=xml2Dscript(xml)  
          
        xml:=getXml(7,num-8+1)  
        wallpapers2:=xml2url(xml)  
        desc2:=xml2Dscript(xml)  
          
        wallpapers.push(wallpapers1*)  
        desc.push(desc1*)  
          
        wallpapers.pop() ;有个重复项目  
        desc.pop() ;有个重复项目  
          
        wallpapers.push(wallpapers2*)  
        desc.push(desc2*)  
    }  
      
    for k,v in wallpapers  
    {  
       
        OutputDebug 下载中...,%k%/%num%  
        ToolTip 下载中...%k%/%num%  
        sleep,200
        ; TrayTip,下载中...,%k%/%num%  
        ;从bing网站的xml解析出来的图片原始url  
        fromUrl:=v  
          
        ;根据电脑DPI下载最适合电脑分辨率的壁纸  
        ret:=url2pic(fromUrl,savePath,最佳分辨率)  
          
        if(ret=0)  
        {  
            ret:=url2pic(fromUrl,savePath,备选分辨率)      
            if(ret=0)  
            {  
                MsgBox 下载失败！  
            }  
            else  
            {  
                out=%out%√-%k%-%ret%`n  
                ;~ wallpapers[k]:=savePath . ret  
                wallpapers[k]:=ret  
            }  
        }  
        else  
        {  
            out=%out%√-%k%-%ret%`n  
            ;~ wallpapers[k]:=savePath . ret  
            wallpapers[k]:=ret  
        }  
    }  
    ;SplashTextOn,400, 300, 下载完成！,%out%  
    ;~ Sleep, 2000  
    ; TrayTip  
    ToolTip
    return wallpapers  
}  
url2pic(fromUrl,savePath,DPI)  
{  
    bing:="http://cn.bing.com"  
    IF !IsObject(DPI)  
    {  
        MsgBox 获取DPI失败  
        ExitApp  
    }  
    for k,v in DPI  
    {  
        OutputDebug 测试DPI值%v%  
        _fromUrl:=bing . RegExReplace(fromUrl, "i)[^_]+\.jpg$", v ".jpg")     
        SplitPath,_fromUrl,filename  
        toFile:=savePath . filename  
        OutputDebug 测试%foFile%文件是否存在
        IfExist,%toFile%  
        {  
            break  
        }  
        else  
        {  
            OutputDebug  开始下载 %toFile% 
            URLDownloadToFile, %_fromUrl%, %toFile%  
            Loop  
            {  
                Sleep,200  
            }until (FileExist(toFile))  
  
            ;检查是否下载成功  
            FileGetSize, fileSize, %toFile%  
            if  (fileSize>0) 
            {
                OutputDebug 文件大小为 %fileSize%
                break  
            }
            else  
                FileDelete,%toFile%  
        }  
    }  
      
    if (!FileExist(toFile) || bgSize=0){  
        return 0  
    }  
    else  
    {  
        return %filename%  
    }  
}  
  
setWallpapers(sFile){  
; https://autohotkey.com/board/topic/15533-setwallpaper/  
sOpt  := "STRETCH"  
WPSTYLE_CENTER  := 0  
WPSTYLE_TILE    := 1  
WPSTYLE_STRETCH := 2  
WPSTYLE_MAX     := 3  
AD_APPLY_ALL    := 7  
pad := ComObjCreate("{75048700-EF1F-11D0-9888-006097DEACF9}", "{F490EB00-1240-11D1-9888-006097DEACF9}")  
DllCall(vtable(pad, 7), "Ptr", pad, "int64P", WPSTYLE_%sOpt%<<32|8, "Uint", 0)  ; SetWallpaperOptions  
DllCall(vtable(pad, 5), "Ptr", pad, "WStr", sFile, "Uint", 0)  ; SetWallpaper  
DllCall(vtable(pad, 3), "Ptr", pad, "Uint", AD_APPLY_ALL)  ; ApplyChanges  
ObjRelease(pad)  
return  
  
}  
vtable(ptr, n) {  
    return NumGet(NumGet(ptr+0), n*A_PtrSize)  
}  
getXml(index=0,number=8)  
{  
    ; index=0               ;~索引值:从哪一天获取壁纸信息，是个相对值，最小值为0为从今天开始,1为从昨天开始,以此类推可下载历史壁纸  
    ; number=8              ;~获取一批壁纸信息,必填项，最小为1，大于8默认返回8张壁纸信息  
    ;【必应壁纸XML信息】  
    Url_bingImgXml:= "http://cn.bing.com/HPImageArchive.aspx?idx=" index "&n=" number "&mkt=zh-CN"  
    xmlFile=%A_ScriptDir%\bingImg.xml   
    URLDownloadToFile,%Url_bingImgXml%,%xmlFile%      
    FileRead, xml, %xmlFile%  
    return xml  
}  
xml2url(xml)  
{  
    return % RegExMatchAll(xml,"<url>(.*?)</url>",1)  
    ;~ return % RegExMatchAll(xml,"<urlBase>(.*?)</urlBase>",1)  
}  
xml2Dscript(xml)  
{  
    return % RegExMatchAll(xml, "<copyright>(.*?)</copyright>",1)  
}  
;【正则匹配所有url段】  
RegExMatchAll(ByRef Haystack, NeedleRegEx, SubPat="") {  
  
    arr := [], startPos := 1  
    while ( pos := RegExMatch(Haystack, NeedleRegEx, match, startPos) ) {  
        arr.push(match%SubPat%)  
        startPos := pos + StrLen(match)  
    }  
    return arr.MaxIndex() ? arr : ""  
}  
;【获取屏幕的分辨率】  
getDPI(){  
    SysGet, Mon, Monitor  
  
    ratio := MonRight/MonBottom  
    if (Abs(ratio -16/10)<0.003)  
        return  "16_10|16_9"  
    else if (Abs(ratio - 16/9)<0.003)  ;(MonRight = 1366 && MonBottom = 768)  ;特殊一点实质是16:9  
        return "16_9|16_10"  
    else  
        return "4_3|16_9"  
}