VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form formVbUpdate 
   Caption         =   "Form1"
   ClientHeight    =   855
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   1770
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   855
   ScaleWidth      =   1770
   StartUpPosition =   3  'Windows Default
   Begin InetCtlsObjects.Inet inetUpdate 
      Left            =   240
      Top             =   120
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      Protocol        =   4
      URL             =   "http://"
      RequestTimeout  =   15
   End
End
Attribute VB_Name = "formVbUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const KEY_SCOPE = KEY_CURRENT_USER           'select KEY_CURRENT_USER or KEY_LOCAL_MACHINE.
Private Const KEY_PATH = "SOFTWARE\SD\Version Updater"             'the key name (AKA subkey path).
                                                                
                                                                'Following used by UpdateThisApp().
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long

Public Function UpdateThisApp(Mode As Integer, Earl As String) As String
'  Call:    e.g. Debug.Print formVbUpdate.UpdateThisApp (0, "http://www.physics.utoronto.ca/~astummer/pub/mirror/Projects/Util/") _
   Enter:   Earl = the update file's path only, no name.  e.g. "http://www.hi.ca/updates/" _
            Mode = 0: normal automatic checking for updates, once a day. _
                 = 1: user asking to check for updates, verbose too. _
   Returns: 0: File sucessfully downloaded and updated. _
            1: Already using the latest version. _
            2: Update available but turned down. _
            3: Told to not do automatic updates. _
            4: Can't find the file or the version info in the file. _
            5: Told not to automatically check. _
            6: Can't download the new file. _
            7: Can't download the changeover app. _
            8: Could not run the changeover app. _
            9: Already checked today. _
          >10: Error, where error number has 10 added to it (e.g. error #10 returns 20).

'MODUS OPERANDI OF UPDATING AN APPLICATION. _
=============================================== _
Four applications are involved: _
   #1) the app to be updated, which runs the update code "Function UpdateThisApp()". _
   #2) "Updater.exe" which renames the files then starts the updated app. _
   #3) "Make Update Files.exe" which, offline, makes the text files describing the latest _
        version of each app in its directory.

'At anytime after app are revised, Make Update Files.exe is run.  It makes a version file for _
every .exe file it finds in its directory.  The version file name is "[app].ver", for example, _
"Notepad.exe" would get a version file "Notepad.ver".  The version file has a section with the _
version of the executable and, if it exists, a section on comments from the executable describing _
the changes to that version. _
 _
When checking for an update, the process is: _
   1) the app to be updated runs the function UpdateThisApp(). _
   2) if it is not manually requested and it has been cancelled until next update, quit now. _
   3) if it is automatically run and it has been run today, quit now. _
   4) that function goes to the version server and reads the version file. _
   5) If the version file says that a newer version is available then: _
      6) it asks if you want to update (quits UpdateThisApp if answer is No), _
      7) it downloads the newer version and names it "Downloaded Update". _
      8) it downloads "Updater.exe". _
      9) it runs "Updater.exe". _
      10) it ends the app to be updated. _
   11) "Updater.exe" renames the app to be updated with the extension ".OLD", just for safty. _
     12) it renames "Downloaded Update" as the new app. _
     13) it deletes the backup "[app].OLD" file. _
     14) it starts the new version app that was just updated. _
     15) it closes itself. _
  16) when the updated application runs, the function UpdateThisApp() deletes "Updater.exe". _

   Const UPDATE_APP = "Updater.exe", DOWNLOADED_UPDATE = "Downloaded Update"
   Dim DlFile() As Byte, Ptr, LatestVer, AppFullName, FileInfo() As Byte, AppVer, _
       Desc, Txt As String, Length

   On Local Error Resume Next        'if the updating files are found, kill them, no longer needed.
   Kill UPDATE_APP
   Kill DOWNLOADED_UPDATE
   On Local Error GoTo BadUpdate                'nothing could possibly go wrong, but just in case.

   If Mode = 0 Then        'IF TOLD NOT TO AUTOMATICALLY UPDATE OR ALREADY CHECKED TODAY, QUIT NOW.
      If KeyGet(KEY_SCOPE, KEY_PATH, App.EXEName + ": Auto Update Date", Txt) Then  'checked today?
         If Txt = Date Then
            UpdateThisApp = "9: Already checked today."
            Exit Function
         End If
      End If
      If KeyGet(KEY_SCOPE, KEY_PATH, App.EXEName + ": Auto Updates", Txt) Then  'should auto check?
         UpdateThisApp = "5: Told not to automatically check."              'key only has to exist.
         Exit Function
      End If
   End If

   MousePointer = vbHourglass                                                  'GET LATEST VERSION.
   Refresh
   If Right(Earl, 1) <> "/" Then Earl = Earl + "/"
   inetUpdate.URL = Earl + App.EXEName + ".ver"
   DlFile() = inetUpdate.OpenURL(inetUpdate.URL)                                 'get version file.
   Ptr = InStr(DlFile, "[version]" + vbCrLf)
   If Ptr = 0 Then                                'can't find the file or version info in the file.
      UpdateThisApp = "4: Can't find the file or the version info in the file."
      KeySave KEY_SCOPE, KEY_PATH, App.EXEName + ": Auto Update Date", Date         'checked today.
      MousePointer = vbDefault
      Exit Function
   End If
   LatestVer = Right(DlFile, inetUpdate.GetHeader("Content-length") - Ptr - 10)    'trim left side.
   Ptr = InStr(LatestVer, vbCrLf)
   If Ptr > 0 Then LatestVer = Left(LatestVer, Ptr - 1)                           'trim right side.

   AppFullName = App.Path + "\" + App.EXEName + ".exe"                     'GET THIS APP'S VERSION.
   ReDim FileInfo(GetFileVersionInfoSize(AppFullName, 0))              'get size of info structure.
   GetFileVersionInfo AppFullName, 0, GetFileVersionInfoSize(AppFullName, 0), FileInfo(0)
   AppVer = Mid(FileInfo, InStr(FileInfo, "FileVersion") + 13, 50)
   AppVer = Left(AppVer, InStr(AppVer, Chr(0)) - 1)
   KeySave KEY_SCOPE, KEY_PATH, App.EXEName + ": Auto Update Date", Date            'checked today.

   If AppVer = LatestVer Then                                     'ALREADY HAVE THE LATEST VERSION.
      UpdateThisApp = "1: Already using the latest version."
      MousePointer = vbDefault
      Exit Function
   End If

   Ptr = InStr(DlFile, "[comments]")                                             'UPDATE AVAILABLE.
   If Ptr > 0 Then                                                 'Get Description of Updated App.
      Desc = Right(DlFile, inetUpdate.GetHeader("Content-length") - Ptr - 11)      'trim left side.
      Ptr = InStr(Desc, vbCrLf)
      If Ptr > 0 Then Desc = Left(Desc, Ptr - 1)                                  'trim right side.
   End If

   Txt = "A newer version of " + App.EXEName + " is available." + vbCrLf _
        + "It is Version " + LatestVer + "."                                       'WANT TO UPDATE?
   If Len(Desc) > 0 Then Txt = Txt + vbCrLf + Desc
   Txt = Txt + vbCrLf + vbCrLf + "Note that " + App.EXEName _
             + " will have to be restarted to update.  " + vbCrLf _
             + vbCrLf + "Would you like to update?" _
             + vbCrLf + "Hit 'Cancel' to stop checking automatically for updates."
   Txt = MsgBox(Txt, vbYesNoCancel + vbInformation, App.EXEName + " - Update Available")
   If Txt = vbNo Then                                                        'no, don't update now.
      UpdateThisApp = "2: Update available but turned down."
      MousePointer = vbDefault
      Exit Function
   End If
   If Txt = vbCancel Then                                      'no, and don't automatically update.
      KeySave KEY_SCOPE, KEY_PATH, App.EXEName + ": Auto Updates", "Don't check for updates"
      UpdateThisApp = "3: Told to not do automatic updates."
      MousePointer = vbDefault
      Exit Function
   End If

   MousePointer = vbHourglass                                         'DOWNLOAD THE LATEST VERSION.
   inetUpdate.URL = Earl + App.EXEName + ".exe"
   On Local Error Resume Next             'test if string (html 'error 404') or binary (.exe) file.
   DlFile() = inetUpdate.OpenURL(inetUpdate.URL, icString)          'should not open as ASCII file.
   Length = inetUpdate.GetHeader("Content-length")
   If Err <> 13 Or Length < 2000 Then         'want error #13 (Type Mismatch), says file is binary.
      On Local Error Resume Next
      Kill App.Path + "/" + DOWNLOADED_UPDATE
      MousePointer = vbDefault
      MsgBox "OOPS!  Can't download the updated file.", , App.EXEName + " - Problem updating"
      UpdateThisApp = "6: Can't download the new file."
      Exit Function
    End If
   On Local Error GoTo BadUpdate                                     'resume normal error handling.
   DlFile() = inetUpdate.OpenURL(inetUpdate.URL, icByteArray)           'get the new [binary] file.
   Open App.Path + "/" + DOWNLOADED_UPDATE For Binary Access Write As #1
   Put #1, , DlFile()
   Close

   inetUpdate.URL = Earl + UPDATE_APP        'DOWNLOAD THE APP TO HANDLE CHANGEOVER TO UPDATED APP.
   On Local Error Resume Next
   DlFile() = inetUpdate.OpenURL(inetUpdate.URL, icString)      'try to open as ASCII, should fail.
   Length = inetUpdate.GetHeader("Content-length")
   If Err <> 13 Or Length < 2000 Then         'want error #13 (Type Mismatch), says file is binary.
      On Local Error Resume Next
      Kill App.Path + "/" + DOWNLOADED_UPDATE
      MousePointer = vbDefault
      MsgBox "OOPS!  Can't access a necessary file.", , App.EXEName + " - Problem updating"
      UpdateThisApp = "7: Can't download the changeover app."
      Exit Function
    End If
   On Local Error GoTo BadUpdate                                     'resume normal error handling.
   DlFile() = inetUpdate.OpenURL(inetUpdate.URL, icByteArray)                 'get the binary file.
   Open App.Path + "/" + UPDATE_APP For Binary Access Write As #1
   Put #1, , DlFile()
   Close

   If Shell(App.Path + "\" + UPDATE_APP + " " + App.EXEName, vbNormalFocus) > 0 Then  'RUN UPDATER.
      KeyDelete KEY_SCOPE, KEY_PATH, App.EXEName + ": Auto Updates"   'remove registry key, if any.
      MousePointer = vbDefault
      UpdateThisApp = 0 'quite usless considering next line, but just crossing T's and dotting I's.
      End
   End If

   On Local Error Resume Next                   'FAILED TO RUN UPDATE APPLICAION, DELETE THE FILES.
   Kill UPDATE_APP
   Kill DOWNLOADED_UPDATE
   UpdateThisApp = "8: Could not run the changeover app."
   MousePointer = vbDefault
   Exit Function

BadUpdate:
   UpdateThisApp = Trim(Str(Err + 10)) + ": Error, where error number has 10 added to it (e.g. error #10 returns 20)."
   MousePointer = vbDefault
   If Mode = 1 And Err = 35761 Then _
      MsgBox "OOPS! Can't find the updates.", , Caption + " - Updating"         'Request timed out.

End Function