none
VBscript to change your desktop wallpaper everyday from a daily changed Astronomy Picture Of the Day website. It's a testing version so be ware ((((( I want testers just save the code as "vbs" and run it))))) RRS feed

  • General discussion

  • Dim path ,IE ,destpath ,rslt
    Dim oFSO, wshShell, sUserName, oShell, sWinDir, wp, oText
    Dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
    dim bStrm: Set bStrm = createobject("Adodb.Stream")
    Set wshShell = WScript.CreateObject("WScript.Shell")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set IE = WScript.CreateObject("InternetExplorer.Application")
    path = ""
    rslt = 0
    destpath1 = wshShell.ExpandEnvironmentStrings("%temp%") & "\apod1.jpg" 
    destpath2 = wshShell.ExpandEnvironmentStrings("%temp%") & "\apod2.jpg"
    destpath = destpath1
    IE.Visible = 0
    IE.Navigate "https://apod.nasa.gov/apod/astropix.html"
    Do
      WScript.Sleep 100
    Loop Until IE.ReadyState = 4
    set Elements = IE.document.getElementsBytagname("img")
    For Each Element In Elements
     path = Element.getAttribute("src")
    Next
    If Not path = "" Then
    	path = "https://apod.nasa.gov/apod/" & path
    	Else
    	path = "https://apod.nasa.gov/apod/image/1904/SouthernCrabHST_853x1000.jpg"
    End If
    If oFSO.FileExists(destpath1) = True Then
    	oFSO.DeleteFile destpath1
    	destpath = destpath2
    	ElseIf oFSO.FileExists(destpath2) = True Then
    	oFSO.DeleteFile destpath2
    	destpath = destpath1
    End If
    xHttp.Open "GET", path
    xHttp.Send
    Do
      WScript.Sleep 100
    Loop Until xHttp.ReadyState = 4
    with bStrm
        .type = 1 
        .open
        .write xHttp.responseBody
        .savetofile destpath, 2 
    end With
    Do
    	WScript.Sleep 100
    Loop Until oFSO.FileExists(destpath) = True
    Wscript.echo "done2!"
    wshShell.Run "cmd /c start " & destpath,0
    do
         wscript.sleep 100
    loop until wshShell.appactivate("Windows Photo Viewer") = true
    Wscript.sleep 500
    wshShell.Sendkeys  ("+{F10}")
    wshShell.Sendkeys  "k"
    wshShell.Run "cmd /c taskkill /im dllhost.exe",0

    Thursday, July 18, 2019 6:00 PM