Source code for checkcalibreupdate.vbs

Option Explicit

Dim arrCurrentVersion, arrLatestVersion

Dim blnQuiet, blnUpdateRequired

Dim i

Dim colMatches, objFSO, objRE, wshShell

Dim strCurrentVersion, strDownloadURL, strExecPath, strInstallFolder, strLatestVersion, strRegKey, strVersionText, strVersionURL

blnQuiet = False

If WScript.Arguments.Unnamed.Count > 0 Then Syntax

Select Case WScript.Arguments.Named.Count

	Case 0:

		' No action required

	Case 1:

		If WScript.Arguments.Named.Exists( "Q" ) Then

			blnQuiet = True

		Else

			Syntax

		End If

	Case Else:

		Syntax

End Select

Set objFSO   = CreateObject( "Scripting.FileSystemObject" )

Set wshShell = CreateObject( "WScript.Shell" )

Set objRE    = New RegExp

strCurrentVersion = ""

' Read the Calibre installation folder from the registry

strRegKey = "HKEY_LOCAL_MACHINE\SOFTWARE\calibre 64bit\Installer\InstallPath"

On Error Resume Next

strInstallFolder = wshShell.RegRead( strRegKey )

On Error Goto 0

' Get the Calibre executable's full path

strExecPath = objFSO.BuildPath( strInstallFolder, "calibre.exe" )

' Check if the Calibre executable file can be found

If objFSO.FileExists( strExecPath ) Then

	' Get the Calibre file version

	strCurrentVersion = objFSO.GetFileVersion( strExecPath )

End If

strDownloadURL   = "https://calibre-ebook.com/dist/win64"

' Read a Calibre web page stating the latest available version

strVersionURL    = "https://calibre-ebook.com/download_windows64"

strVersionText   = GetURLContentIE( strVersionURL )

strLatestVersion = ""

' Use a RegExp to extract the latest available version from the web page

objRE.Pattern    = "<a[^>]*>\s*<img [^>]+>\s*Download\s+calibre\s+64bit\s*</a><br[^>]*>Version:\s+(\d+\.\d+\.\d+)\s*<a[^>]*>What's new</a>"

objRE.Global     = False

objRE.IgnoreCase = False

If objRE.Test( strVersionText ) Then

	Set colMatches = objRE.Execute( strVersionText )

	If colMatches.Count > 0 Then

		strLatestVersion = colMatches(0).SubMatches(0)

	End If

	Set colMatches = Nothing

End If

' Prepare version strings for comparison

arrCurrentVersion = Split( strCurrentVersion, "." )

arrLatestVersion  = Split( strLatestVersion,  "." )

If UBound( arrCurrentVersion ) > 0 and UBound( arrLatestVersion ) > 0 Then

	If UBound( arrCurrentVersion ) > UBound( arrLatestVersion ) Then

		ReDim Preserve arrCurrentVersion( UBound( arrLatestVersion ) )

	ElseIf UBound( arrCurrentVersion ) < UBound( arrLatestVersion ) Then

		ReDim Preserve arrLatestVersion( UBound( arrCurrentVersion ) )

	End If

End If

' Check if latest version exceeds currently installed version

blnUpdateRequired = False

For i = 0 To Min( UBound( arrCurrentVersion ), UBound( arrLatestVersion ) )

	If CInt( arrLatestVersion(i) ) > CInt( arrCurrentVersion(i) ) Then

		blnUpdateRequired = True ' assuming current version can never exceed latest version

	End If

Next

' Display update status and start download if required

If blnUpdateRequired Then

	' Display installed and latest versions

	WScript.Echo "Calibre 64 bit update check" & vbCrLf & vbCrLf _

	           & "Currently installed version" & vbTab & ":" & vbTab & strCurrentVersion & vbCrLf _

	           & "Latest available version   " & vbTab & ":" & vbTab & strLatestVersion & vbCrLf & vbCrLf _

	           & "An update is available, please download and install it..."

	wshShell.Run strDownloadURL

Else

	If Not blnQuiet Then

		WScript.Echo "Calibre 64 bit update check" & vbCrLf & vbCrLf _

		           & "Currently installed version" & vbTab & ":" & vbTab & strCurrentVersion & vbCrLf _

		           & "Latest available version   " & vbTab & ":" & vbTab & strLatestVersion & vbCrLf & vbCrLf _

		           & "You have the latest version, no update required."

	End If

End If

Set objRE    = Nothing

Set wshShell = Nothing

Set objFSO   = Nothing

' Using IE because WinHTTP and XMLHTTP get 405 "not allowed" response

Function GetURLContentIE( strURL )

    Dim blnTimedOut, i, objIE, objMatch, objRE, strText

    ' Return value if IP address couldn't be retrieved

    GetURLContentIE = ""

    ' Open the appropriate URL in Internet Explorer

    Set objIE = CreateObject( "InternetExplorer.Application" )

    objIE.Visible = False

    objIE.Navigate2 strURL

    ' Wait till IE is ready

    i = 0

    blnTimedOut = False

    Do While objIE.Busy

        WScript.Sleep 100

        i = i + 1

        ' Time out after 10 seconds

        If i > 100 Then

            blnTimedOut = True

            Exit Do

        End If

    Loop

    ' Retrieve the URL's text

    If Not blnTimedOut Then GetURLContentIE = objIE.Document.Body.innerHTML

    ' Close the Internet Explorer session

    objIE.Quit

    Set objIE = Nothing

End Function

Function Min( num1, num2 )

	If num1 < num2 Then

		Min = num1

	Else

		Min = num2

	End If

End Function

Sub Syntax

	Dim strMsg

	strMsg = "CheckCalibreUpdate.vbs,  Version 1.01" _

	       & vbCrLf _

	       & "Check if an update is available for Calibre eBook Management" _

	       & vbCrLf & vbCrLf _

	       & "Usage:" & vbTab & "CheckCalibreUpdate.vbs  [ /Q ]" _

	       & vbCrLf & vbCrLf _

	       & "Where:" & vbTab & "/Q" & vbTab & "Hides results unless an update is required" _

	       & vbCrLf & vbCrLf _

	       & "Written by Rob van der Woude" _

	       & vbCrLf _

	       & "http://www.robvanderwoude.com"

	WScript.Echo strMsg

	WScript.Quit 1

End Sub