' Calvin + NASA - VBScript version

Dim objFSO, WshShell, picURL

' =================================================
'set this for yourself widthxheight  - no spaces
desksize="1366x768"
' This controls whether you use the preview size image, or the large size one
bUseBigImage = True
' =================================================

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/"
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.
If bUseBigImage Then
    regEx.Pattern = "<a href="".*\.jpg"""   ' Set pattern.
    strRegOffset = Len("<a href=""")
Else
    regEx.Pattern = "<IMG SRC="".+"""   ' Set pattern.
    strRegOffset = Len("<IMG SRC=""")
End If
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
    wscript.echo RetStr
    If LCase(Right(RetStr, 5)) = ".jpg""" Then
        picURL = Right(RetStr, Len(RetStr) - strRegOffset)
        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.ServerXMLHTTP")

    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
    Else
        errorText = "VBSWget Error:" & vbCrLf _
            & "URL: " & vbCrLf _
            & remoteFile & vbCrLf _
            & "Status: " & objXMLHTTP.Status & " " & objXMLHTTP.StatusText
        WScript.echo errorText
        Wscript.Quit
    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.ServerXMLHTTP")
    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."
    strImageMagickData = getHTML(ImageMagickURL)
    strImageMagickCurrent = Left(strImageMagickData, _
        Instr(strImageMagickData, "Q16-windows.zip</a>") + 14)
    strImageMagickCurrent = Right(strImageMagickCurrent, _
        Len(strImageMagickCurrent) - InstrRev(strImageMagickCurrent, ">"))
    VBSWget ImageMagickURL & strImageMagickCurrent, 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