modglobal.bas

VB开发的自动更新程序

Attribute VB_Name = "modGlobal"
'***********************************************************************
'Chris Cochran          [e-mail]        Updated: 11 Sep 05
'***********************************************************************
Option Explicit

'//Declares for GetFolderPath Routine
Public Enum CSIDL_VALUES
    CSIDL_STARTMENU = &HB '------------------ Values currently in use
    CSIDL_DESKTOPDIRECTORY = &H10
    CSIDL_COMMON_STARTMENU = &H16
    CSIDL_COMMON_DESKTOPDIRECTORY = &H19
    CSIDL_WINDOWS = &H24
    CSIDL_SYSTEM = &H25
    CSIDL_PROGRAM_FILES = &H26
    CSIDL_PROGRAM_FILES_COMMON = &H2B
    CSIDL_FLAG_PER_USER_INIT = &H800
'    CSIDL_DESKTOP = &H0 '------------------- Values available for future expansion
'    CSIDL_INTERNET = &H1
'    CSIDL_PROGRAMS = &H2
'    CSIDL_CONTROLS = &H3
'    CSIDL_PRINTERS = &H4
'    CSIDL_PERSONAL = &H5
'    CSIDL_FAVORITES = &H6
'    CSIDL_STARTUP = &H7
'    CSIDL_RECENT = &H8
'    CSIDL_SENDTO = &H9
'    CSIDL_BITBUCKET = &HA
'    CSIDL_MYDOCUMENTS = &HC
'    CSIDL_MYMUSIC = &HD
'    CSIDL_MYVIDEO = &HE
'    CSIDL_DRIVES = &H11
'    CSIDL_NETWORK = &H12
'    CSIDL_NETHOOD = &H13
'    CSIDL_FONTS = &H14
'    CSIDL_TEMPLATES = &H15
'    CSIDL_COMMON_PROGRAMS = &H17
'    CSIDL_COMMON_STARTUP = &H18
'    CSIDL_APPDATA = &H1A
'    CSIDL_PRINTHOOD = &H1B
'    CSIDL_LOCAL_APPDATA = &H1C
'    CSIDL_ALTSTARTUP = &H1D
'    CSIDL_COMMON_ALTSTARTUP = &H1E
'    CSIDL_COMMON_FAVORITES = &H1F
'    CSIDL_INTERNET_CACHE = &H20
'    CSIDL_COOKIES = &H21
'    CSIDL_HISTORY = &H22
'    CSIDL_COMMON_APPDATA = &H23
'    CSIDL_MYPICTURES = &H27
'    CSIDL_PROFILE = &H28
'    CSIDL_SYSTEMX86 = &H29
'    CSIDL_PROGRAM_FILESX86 = &H2A
'    CSIDL_PROGRAM_FILES_COMMONX86 = &H2C
'    CSIDL_COMMON_TEMPLATES = &H2D
'    CSIDL_COMMON_DOCUMENTS = &H2E
'    CSIDL_COMMON_ADMINTOOLS = &H2F
'    CSIDL_ADMINTOOLS = &H30
'    CSIDL_CONNECTIONS = &H31
'    CSIDL_COMMON_MUSIC = &H35
'    CSIDL_COMMON_PICTURES = &H36
'    CSIDL_COMMON_VIDEO = &H37
'    CSIDL_RESOURCES = &H38
'    CSIDL_RESOURCES_LOCALIZED = &H39
'    CSIDL_COMMON_OEM_LINKS = &H3A
'    CSIDL_CDBURN_AREA = &H3B
'    CSIDL_COMPUTERSNEARME = &H3D
'    CSIDL_FLAG_NO_ALIAS = &H1000
'    CSIDL_FLAG_DONT_VERIFY = &H4000
'    CSIDL_FLAG_CREATE = &H8000
'    CSIDL_FLAG_MASK = &HFF00
End Enum
Private Const S_OK                      As Long = 0
Private Const SHGFP_TYPE_CURRENT        As Long = &H0
Private Declare Function SHGetFolderPath Lib "shfolder.dll" Alias "SHGetFolderPathA" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, ByVal lpszPath As String) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long

'//Running App declares
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WM_CLOSE                  As Long = &H10
Private pClassName                      As String
Private pSearchTitle                    As String
Private pAppFound                       As Boolean
Public Type typeRunningApps
    lWndHwnd()                          As Long
    lWndProcessID()                     As Long
End Type
Public tRunningApps                     As typeRunningApps

'//Windows Shutdown declares
Private Const ERROR_NOT_ALL_ASSIGNED    As Long = 1300
Private Const SE_PRIVILEGE_ENABLED      As Long = 2
Private Const TOKEN_QUERY               As Long = &H8
Private Const TOKEN_ADJUST_PRIVILEGES   As Long = &H20
Private Const EWX_REBOOT                As Long = 2
Private Type LUID
    lowpart                             As Long
    highpart                            As Long
End Type
Private Type LUID_AND_ATTRIBUTES
    pLuid                               As LUID
    Attributes                          As Long
End Type
Private Type TOKEN_PRIVILEGES
    PrivilegeCount                      As Long
    Privileges                          As LUID_AND_ATTRIBUTES
End Type
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpUid As LUID) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

'//DrawText declares
Private Const DT_WORD_ELLIPSIS      As Long = &H40000
Private Const DT_WORDBREAK          As Long = &H10
Public Const DT_FLAGS               As Long = DT_WORD_ELLIPSIS + DT_WORDBREAK '--- Used by all
Public Const DT_LEFT                As Long = &H0
Public Const DT_CENTER              As Long = &H1
Public Const DT_NOPREFIX            As Long = &H800
Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

'//DrawBorder declares
Private Const BF_LEFT               As Long = &H1
Private Const BF_RIGHT              As Long = &H4
Private Const BF_TOP                As Long = &H2
Private Const BF_BOTTOM             As Long = &H8
Private Const BF_RECT               As Long = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Public Enum mBorderStyles
    RaiseShallow = &H4
    SunkenShallow = &H2
    RaisedHigh = &H5
    SunkenDeep = &HA
    Etched = &H6
    Bump = &H9
    FocusRect = &H99
End Enum
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long

'//Gradient Fill Declares
Public Enum ePlane
    VERTICAL = 0
    HORIZONTAL = 1
End Enum
Private Type RGBColor
    R                   As Single
    G                   As Single
    B                   As Single
End Type
Public Type POINTAPI
    x                   As Long
    y                   As Long
End Type
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

'//Finds "HotSpots" within a form (title bars, icons, text)
Public Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long

'//Moves form when titlebar "HotSpot" is selected
Public Declare Function ReleaseCapture Lib "user32" () As Long

'//Show cursor declares
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Public Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Public Const IDC_HAND           As Long = 32649&
Public Const IDC_SIZEALL        As Long = 32646&

'//Remove title bar declares
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'Already declared in this module - Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Private Const GWL_STYLE         As Long = (-16)
Private Const WS_CAPTION        As Long = &HC00000
Private Const SWP_FRAMECHANGED  As Long = &H20
Private Const SWP_NOZORDER      As Long = &H4
Public Const SWP_NOMOVE         As Long = &H2
Public Const SWP_NOSIZE         As Long = &H1
Private Const SWP_FLAGS         As Long = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOSIZE

'//Remove menu items declares
Private Const MF_BYPOSITION     As Long = &H400&
Private Const WM_GETSYSMENU     As Long = &H313
Public Const HTCAPTION          As Long = 2
Public Const WM_NCLBUTTONDOWN   As Long = &HA1
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

'//Paint specific hDC area by RECT declares (far more efficient than Me.Refresh)
Private Const RDW_INVALIDATE    As Long = &H1
Private Const RDW_UPDATENOW     As Long = &H100
Public Const RDW_FLAGS          As Long = RDW_INVALIDATE + RDW_UPDATENOW
Public Declare Function RedrawWindow Lib "user32" (ByVal hWnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long

'//ShellExecute Declares
Public Const SW_HIDE            As Long = 0 '--- Used for executing regsvr32.exe
Public Const SW_NORMAL          As Long = 1 '--- Used for restarting applications
Public Const SW_MAXIMIZE        As Long = 3 '--- Used when displaying HTML report
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'//SetWindowPos declares
Public Const HWND_TOPMOST      As Long = -1
Public Const SWP_NOACTIVATE    As Long = &H10
Public Const SWP_SHOWWINDOW    As Long = &H40
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long

'//Detect if in Terminal Services mode declares (***NOT YET IMPLEMENTED***)
'!Private Const SM_REMOTESESSION  As Long = &H1000
'!Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

'//Misc and shared declares
Public Type RECT
    lLeft                       As Long
    lTop                        As Long
    lRight                      As Long
    lBottom                     As Long
End Type
Public Const MAX_PATH           As Long = 260
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function DrawIconEx Lib "user32" (ByVal lHdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpSectionName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetLongPathName Lib "kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long

'//Private module level variables
Private lProcessToKill          As Long

'//Public application level variables
Public bADMIN                   As Boolean
Public bOS                      As Byte
Public sTEMPDIR                 As String   '//Temp folder location for downloaded files not yet proccessed
Public lPREVWINDOW              As Long
Public sUpdateMessage           As String   '//Collection of update messages for display on exit
'!Public bREMOTESESSION           As Boolean  '//True when running in a remote Terminal Services environment (***NOT YET IMPLEMENTED***)

Public Sub Main()
'***************************************************************************************************
'Explanation of three possible arguments: (NONE ARE REQUIRED)
'
'Usage: ReVive.exe /n /a scriptpath
'   /n              Notify: Check for updates and notify when they are available.
'
'   /a              Auto: Check for and install updates without notice.
'                   Does notify user when updates are complete. (is case reboot is required)
'                   Overrides /n argument.
'
'   scriptpath      Path of ReVive initilization script to use for updating.
'                   If not passed or not found, will assume App.Path & "\update.ris" of this exe.
'
'   EXAMPLE:        To run LiveUpdate in Notify mode execute:
'                       lResult = "C:\Progra~1\LiveUp~1\ReVive.exe /n C:\Progra~1\MyProg\myapp.ris"
'****************************************************************************************************
On Error GoTo Errs
Dim args    As String
Dim i       As Integer
Dim path    As String
Dim x       As Long
Dim sRISDir As String
Dim bRemote As Boolean

    If App.PrevInstance Then Exit Sub '----------------- Not a good idea to have two LiveUpdates running simultaneously
    lPREVWINDOW = GetForegroundWindow '----------------- Get previously active window
    args = Replace(LCase$(Command$), Chr(34), "") '----- Remove quotation marks if exist
    '!bREMOTESESSION = CBool(GetSystemMetrics(SM_REMOTESESSION)) (***NOT YET IMPLEMENTED***)
    
    If Len(args) Then
        '//Check for Auto mode
        If InStr(1, args, "/a", vbTextCompare) Then
            Setup.RunMode = eAUTO '--------------------- Auto mode
            args = Trim$(Replace(args, "/a", ""))
            args = Trim$(Replace(args, "/n", ""))
        '//Check for Notify mode if Auto wasn't specified
        ElseIf InStr(1, args, "/n", vbTextCompare) Then
            Setup.RunMode = eNOTIFY '------------------- Notify mode
            args = Trim$(Replace(args, "/n", ""))
        End If
        '//Check if setup script path was passed and if it long enough to constitute a script location
        If Len(args) > 6 Then
            '//We need to validate that the passed folder path exist. If the file doesn't
            '..we are OK because we will create it on exit for the next LiveUpdate run,