Calvin + NASA

' Calvin + NASA - VBScript version

Dim objFSO, WshShell, picURL

' =================================================
'set this for yourself widthxheight  - no spaces
desksize="1366x768"
' =================================================

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")

picPageURL="http://antwrp.gsfc.nasa.gov/apod/astropix.html"
irfanviewURL="http://irfanview.tuwien.ac.at/iview427.zip"
ImageMagickURL="http://www.imagemagick.org/download/binaries/ImageMagick-6.6.4-Q16-windows.zip"
CalvinImageURL="http://i.imgur.com/pcaNT.png"
strScriptDir = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, "\") - 1)
' The visibility of the ImageMagick commands. 0 = hide, 2 = minimize
iWinVisibility = 0
strTempPath = WshShell.ExpandEnvironmentStrings("%TEMP%")
Const ForReading = 1, ForWriting = 2, ForAppending = 8

' Look for irfanview, Imagemagick and calvincanvas.png
If Not objFSO.FolderExists(strScriptDir & "\iview") then getIrfanview
If Not objFSO.FolderExists(strScriptDir & "\ImageMagick") then getImageMagick
If Not objFSO.FileExists(strScriptDir & "\calvincanvas.png") then VBSWget CalvinImageURL, strScriptDir & "\calvincanvas.png"

' Find the jpg. First get the HTML page
strImagePage = getHTML(picPageURL)
' Find the IMG tag
Set regEx = New RegExp   ' Create a regular expression.
regEx.Pattern = "<IMG SRC="".+"""       ' Set pattern.
regEx.IgnoreCase = True   ' Set case insensitivity.
regEx.Global = True   ' Set global applicability.
Set Matches = regEx.Execute(strImagePage)   ' Execute search.
For Each Match in Matches   ' Iterate Matches collection.
        RetStr = Match.Value
        If LCase(Right(RetStr, 5)) = ".jpg""" Then
                picURL = Right(RetStr, Len(RetStr) - 10)
                picURL = Left(picURL, Len(picURL) - 1)
        End If
Next
If picURL = "" Then
        Wscript.echo "Error: can't find picture"
        Wscript.Quit 1
End If
If LCase(Right(picURL, 4)) <> "http" Then
        ' Returned a relative path; use the web page URL to complete
        picURL = Left(picPageURL, InstrRev(picPageURL, "/")) & picURL
End If

' Download the picture
VBSWget picURL, strScriptDir & "\apod.jpg"

' Combine
strConvert = """" & strScriptDir & "\ImageMagick\convert.exe"""
WshShell.Run strConvert & " """ _
        & strScriptDir & "\calvincanvas.png"" -background transparent -resize " & desksize _
        & " -gravity center -extent " & desksize & " """ & strScriptDir & "\calvincanvasRS.png""", iWinVisibility, True
WshShell.Run strConvert & " """ _
        & strScriptDir & "\apod.jpg"" -background transparent -resize " & desksize _
        & " -gravity center -extent " & desksize & " """ & strScriptDir & "\apodRS.jpg""", iWinVisibility, True
WshShell.Run strConvert & " """ _
        & strScriptDir & "\apodRS.jpg"" """ & strScriptDir & "\calvincanvasRS.png"" -mosaic """ & strScriptDir & "\calvin.jpg""", iWinVisibility, True

' set as wallpaper
WshShell.Run """" & strScriptDir & "\iview\i_view32.exe"" """ & strScriptDir & "\calvin.jpg"" /wall=0 /killmesoftly", 0, True

Set objFSO = Nothing
Set WshShell = Nothing


Sub VBSWget(remoteFile, localFile)
' Download a remote binary file
' From http://blog.netnerds.net/2007/01/vbscript-download-and-save-a-binary-file/
        Dim objXMLHTTP, objADOStream, objFSO

        ' Fetch the file
        Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")

        objXMLHTTP.open "GET", remoteFile, false
        objXMLHTTP.send()

        If objXMLHTTP.Status = 200 Then
                Set objADOStream = CreateObject("ADODB.Stream")
                objADOStream.Open
                objADOStream.Type = 1 'adTypeBinary

                objADOStream.Write objXMLHTTP.ResponseBody
                objADOStream.Position = 0       'Set the stream position to the start

                Set objFSO = Createobject("Scripting.FileSystemObject")
                If objFSO.Fileexists(localFile) Then objFSO.DeleteFile localFile
                Set objFSO = Nothing

                objADOStream.SaveToFile localFile
                objADOStream.Close
                Set objADOStream = Nothing
        End if

        Set objXMLHTTP = Nothing
End Sub ' <==VBSWget

Sub Unzip(zipFile, destFolder)
' Unzip a file
' From http://stackoverflow.com/questions/911053/how-to-unzip-a-file-in-vbscript-using-internal-windows-xp-options-in
        Dim objShell
        If NOT objFSO.FolderExists(destFolder) Then
                'If the extraction location does not exist create it.
           objFSO.CreateFolder(destFolder)
        End If

        'Extract the contents of the zip file.
        set objShell = CreateObject("Shell.Application")
        set FilesInZip=objShell.NameSpace(zipFile).items
        objShell.NameSpace(destFolder).CopyHere(FilesInZip)
        Set objShell = Nothing

End Sub ' <==Unzip

Function getHTML(strURL)
' Get the HTML from a web page
' from http://www.suite101.com/content/how-to-use-vbscript-to-download-a-web-page-a89661
        dim xmlhttp : set xmlhttp = createobject("msxml2.xmlhttp")
        xmlhttp.open "get", strURL, false
        xmlhttp.send
        getHTML = xmlhttp.responseText
End Function    ' <== getHTML

Sub getIrfanview
' Download and unzip Irfanview
        ProgressStart "Now downloading Irfanview. This should only need to be done once. Please wait."
        VBSWget irfanviewURL, strScriptDir & "\iview.zip"
        ProgressStop
        Unzip strScriptDir & "\iview.zip", strScriptDir & "\iview"
    objFSO.DeleteFile(strScriptDir & "\iview.zip")
end Sub ' <== getIrfanview

Sub getImageMagick
' Download and unzip ImageMagick
        ProgressStart "Now downloading ImageMagick. This should only need to be done once. Please wait."
        VBSWget ImageMagickURL, strScriptDir & "\imagemagick.zip"
        ProgressStop
        Unzip strScriptDir & "\imagemagick.zip", strScriptDir
    objFSO.DeleteFile(strScriptDir & "\imagemagick.zip")
        ' Find the Imagemagick folder and rename to 'im' so that the rest of the script can find it
        Set objScriptDir = objFSO.GetFolder(strScriptDir)
        Dim strImageMagickFolder

        For Each oFolder In objScriptDir.SubFolders
                If LCase(Left(oFolder.Name, Len("ImageMagick"))) = "imagemagick" Then
                        strImageMagickFolder = oFolder.Path
                End If
        Next
        If strImageMagickFolder = "" Then
                Wscript.Echo "ERROR: Couldn't find ImageMagick folder!"
                Wscript.Quit 1
        End If
        objFSO.MoveFolder strImageMagickFolder, strScriptDir & "\ImageMagick"
        Set objScriptDir = Nothing
End Sub ' <== getImageMagick

Sub ProgressStart(strMessage)
' Pop up a status message
        strProgressData = "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf _
                & "Set WshShell = WScript.CreateObject(""WScript.Shell"")" & vbCrLf _
                & "strMsg = Wscript.arguments(0)" & vbCrLf _
                & "strScriptDir = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, ""\"") - 1)" & vbCrLf _
                & "strStop = strScriptDir & ""\progress.stop""" & vbCrLf _
                & "If objFSO.FileExists(strStop) Then Wscript.Quit" & vbCrLf _
                & "While Not objFSO.FileExists(strStop)" & vbCrLf _
                & "     ret = WshShell.Popup(strMsg, 10, ""ApodCalvin"", 0)" & vbCrLf _
                & "Wend" & vbCrLf _
                & "objFSO.DeleteFile(strStop)"

        strProgressVBS = strtempPath & "\progress.vbs"
        Set f = objFSO.OpenTextFile(strProgressVBS, ForWriting, True)
        f.Write strProgressData
        f.Close
        If objFSO.FileExists(strtempPath & "\progress.stop") Then
                objFSO.DeleteFile strtempPath & "\progress.stop"
        End If
        WshShell.Run "wscript.exe """ & strProgressVBS & """ """ & strMessage & """", 1, False

End Sub ' <== ProgressStart

Sub ProgressStop
' Close the progress message
        Set f = objFSO.OpenTextFile(strtempPath & "\progress.stop", ForWriting, True)
        f.WriteLine "stop"
        f.Close
        iCount = 0
        While objFSO.FileExists(strtempPath & "\progress.stop") And iCount < 10
                Wscript.Sleep 1000
                iCount = iCount + 1
        Wend
        If objFSO.FileExists(strtempPath & "\progress.vbs") Then
                objFSO.DeleteFile strtempPath & "\progress.vbs"
        End If
        If objFSO.FileExists(strtempPath & "\progress.stop") Then
                objFSO.DeleteFile strtempPath & "\progress.stop"
        End If
End Sub ' <== ProgressStop