用VB6寫在線更新程序（中篇）
「修改主程序入口」
在本篇中，主要對主程序的啓動入口進行適當的修改，讓其在啓動時檢測XML配置文件中的版本信息，提示版本更新，並啓動更新程序下載更新（如果有可用更新）。
首先，在主窗體（這裏不是主窗體，而是在啓動屏）裝載時，進行必要的初始化並裝載XML配置：
' 下載地址。
Private Const UPDATE_CONFIG_FILE = "http://solid-system/Apps/BCC/BCCUpdate.xml" ' 更新配置文件地址。
Private AppFile As String ' 當前程序執行文件名。
Private AppVer As String ' 當前程序版本號。
Private XmlConfig As XmlConfiguration
Private Sub Form_Load()
Label1.Caption = "正在啓動程序..."
' 顯示程序版本號。
AppFile = App.Path & "/" & App.EXEName & ".EXE"
AppVer = GetFileVersion(AppFile)
lblVersion.Caption = "版本：" & AppVer
' 裝載XML更新配置。
Set XmlConfig = New XmlConfiguration
If InitXmlConfig(UPDATE_CONFIG_FILE) Then
Timer1.Enabled = True
Else
Unload Me ' 直接運行程序。
End If
End Sub
'{ 初始化配置處理對象，並裝載配置文件。Cable Fan 2009-08-15 }
Private Function InitXmlConfig(ConfigUrl As String) As Boolean
On Error GoTo CATCH
If XmlConfig.Load(ConfigUrl) Then ' 裝載配置信息。
InitXmlConfig = True
Else
MsgBox "裝載XML配置文件：“" & ConfigUrl & "”失敗！" & vbCrLf & err.Description
InitXmlConfig = False
End If
Exit Function
CATCH:
MsgBox "無法下載在線更新配置文件。" & vbCrLf & err.Description
InitXmlConfig = False
End Function
Private Const UPDATE_CONFIG_FILE = "http://solid-system/Apps/BCC/BCCUpdate.xml" ' 更新配置文件地址。
Private AppFile As String ' 當前程序執行文件名。
Private AppVer As String ' 當前程序版本號。
Private XmlConfig As XmlConfiguration
Private Sub Form_Load()
Label1.Caption = "正在啓動程序..."
' 顯示程序版本號。
AppFile = App.Path & "/" & App.EXEName & ".EXE"
AppVer = GetFileVersion(AppFile)
lblVersion.Caption = "版本：" & AppVer
' 裝載XML更新配置。
Set XmlConfig = New XmlConfiguration
If InitXmlConfig(UPDATE_CONFIG_FILE) Then
Timer1.Enabled = True
Else
Unload Me ' 直接運行程序。
End If
End Sub
'{ 初始化配置處理對象，並裝載配置文件。Cable Fan 2009-08-15 }
Private Function InitXmlConfig(ConfigUrl As String) As Boolean
On Error GoTo CATCH
If XmlConfig.Load(ConfigUrl) Then ' 裝載配置信息。
InitXmlConfig = True
Else
MsgBox "裝載XML配置文件：“" & ConfigUrl & "”失敗！" & vbCrLf & err.Description
InitXmlConfig = False
End If
Exit Function
CATCH:
MsgBox "無法下載在線更新配置文件。" & vbCrLf & err.Description
InitXmlConfig = False
End Function
這裏需要一個Timer來等待XML的讀取完成，這也是關鍵的代碼了：
Private Sub Timer1_Timer()
If XmlConfig.Ready Then
'Label1.Caption = "等待配置加載完成..."
Timer1.Enabled = False
Label1.Caption = "正在處理更新配置..."
' 解析XML配置。
If XmlConfig.Analysis Then
Label1.Caption = "正在比較更新版本..."
Select Case CheckUpdate(AppVer)
Case -1
' 取消更新則退出程序。
End
Case 0
Label1.Caption = "正在驗證當前數據庫有效性連接..."
DBConnect
Label1.Caption = "當前數據庫有效"
Unload Me
Case 1
' 需要更新，啓動更新程序。
Dim CmdLine As String ' 執行更新程序的命令行。
CmdLine = App.Path & "/Update.exe"
If FileExists(CmdLine) Then
CmdLine = CmdLine & " """ & UPDATE_CONFIG_FILE & """ """ & App.Path & "/" _
& App.EXEName & ".exe"
Shell CmdLine, vbNormalFocus
End ' 啓動更新程序後退出程序。
Else
MsgBox "更新程序不存在，請重新安裝程序！"
End ' 退出程序。
End If
End Select
Else
Label1.Caption = "無法解析XML配置，直接啓動舊程序！"
Unload Me
End If
End If
End Sub
'{ 檢查在線更新，無需更新返回0，執行更新返回1，取消更新返回-1（將退出程序）。Cable Fan 2009-08-15 }
Private Function CheckUpdate(AppVer As String) As Integer
On Error GoTo CATCH
If CompareVersion(XmlConfig.Version, AppVer) > 0 Then
' 有可用更新。
Dim Msg As String '更新提示內容。
Msg = "您現在使用的版本是：" & AppVer & "，服務器上有可用的更新版本：" & XmlConfig.Version & "。"
If XmlConfig.Force Then
Msg = Msg & vbCrLf & "當前版本的程序已經不可用，您必須更新到新版本才能繼續使用！"
Else
Msg = Msg & vbCrLf & "當前版本仍然可用，但建議你更新到新版本。"
End If
If MsgBox(Msg, vbQuestion + vbYesNo + vbDefaultButton1) = vbYes Then
CheckUpdate = 1 '執行更新。
Else
If XmlConfig.Force Then
CheckUpdate = -1 '取消了強制更新。
Else
CheckUpdate = 0 '取消了非強制更新。
End If
End If
Else
CheckUpdate = 0 ' 無需更新。
End If
Exit Function
CATCH:
MsgBox "無法檢查程序版本。" & vbCrLf & err.Description
CheckUpdate = 0 ' 無法檢查更新時允許跳過。
End Function
If XmlConfig.Ready Then
'Label1.Caption = "等待配置加載完成..."
Timer1.Enabled = False
Label1.Caption = "正在處理更新配置..."
' 解析XML配置。
If XmlConfig.Analysis Then
Label1.Caption = "正在比較更新版本..."
Select Case CheckUpdate(AppVer)
Case -1
' 取消更新則退出程序。
End
Case 0
Label1.Caption = "正在驗證當前數據庫有效性連接..."
DBConnect
Label1.Caption = "當前數據庫有效"
Unload Me
Case 1
' 需要更新，啓動更新程序。
Dim CmdLine As String ' 執行更新程序的命令行。
CmdLine = App.Path & "/Update.exe"
If FileExists(CmdLine) Then
CmdLine = CmdLine & " """ & UPDATE_CONFIG_FILE & """ """ & App.Path & "/" _
& App.EXEName & ".exe"
Shell CmdLine, vbNormalFocus
End ' 啓動更新程序後退出程序。
Else
MsgBox "更新程序不存在，請重新安裝程序！"
End ' 退出程序。
End If
End Select
Else
Label1.Caption = "無法解析XML配置，直接啓動舊程序！"
Unload Me
End If
End If
End Sub
'{ 檢查在線更新，無需更新返回0，執行更新返回1，取消更新返回-1（將退出程序）。Cable Fan 2009-08-15 }
Private Function CheckUpdate(AppVer As String) As Integer
On Error GoTo CATCH
If CompareVersion(XmlConfig.Version, AppVer) > 0 Then
' 有可用更新。
Dim Msg As String '更新提示內容。
Msg = "您現在使用的版本是：" & AppVer & "，服務器上有可用的更新版本：" & XmlConfig.Version & "。"
If XmlConfig.Force Then
Msg = Msg & vbCrLf & "當前版本的程序已經不可用，您必須更新到新版本才能繼續使用！"
Else
Msg = Msg & vbCrLf & "當前版本仍然可用，但建議你更新到新版本。"
End If
If MsgBox(Msg, vbQuestion + vbYesNo + vbDefaultButton1) = vbYes Then
CheckUpdate = 1 '執行更新。
Else
If XmlConfig.Force Then
CheckUpdate = -1 '取消了強制更新。
Else
CheckUpdate = 0 '取消了非強制更新。
End If
End If
Else
CheckUpdate = 0 ' 無需更新。
End If
Exit Function
CATCH:
MsgBox "無法檢查程序版本。" & vbCrLf & err.Description
CheckUpdate = 0 ' 無法檢查更新時允許跳過。
End Function
在Timer事件中，每一個步驟都顯示一個提示信息，因爲程序啓動時通常都是顯示一個啓動屏的，而啓動屏上顯示一句提示，也好讓用戶知道程序在做什麼呀。等到XML配置信息讀取完畢（即XmlConfig.Ready爲True）時，對XML配置信息進行解析（即XmlConfig.Analysis過程），使配置信息存儲到XmlConfig的各個屬性中去。
僅接着，通過CheckUpdate函數進行發佈信息的比較，對返回的結果進行分別處理，共有3種情況：
1)有更新，而且是強制更新時，用戶主動取消了更新，這種情況下程序終止執行，直接退出；
2)無更新時，程序不作提示繼續執行。後面的DBConnect爲數據庫連接過程；
3)有更新，且用戶同意執行更新時，啓動更新程序，然後終止執行主程序；當然，如果更新程序不存在是無法執行更新的，作出提示後同樣終止執行主程序。
另外，在其它無法預測各種情況，致使無法正常檢測更新配置時，允許直接運行舊程序。對於更新檢測過程CheckUpdate，主要是拿當前發佈的版本號與當前主程序的版本號進行比較，比較結果作出明瞭（讓用戶知道自己用的什麼版本，當前發佈了什麼版本，是否強制更新，新版本作了什麼修訂等等）的提示。當然，更新提示應該做得更細緻些，使用自定義對話框，將各個元素表現得更形象。在這裏沒有這樣做，而是使用一個簡單的消息框（偷了一下懶，呵呵）。
所有的代碼就這麼多了（嫌少了？後面還有…），對於Xmlconfiguration類的定義可以參考上篇。而其中用到的CompareVersion函數、FileExists函數等，都是一些比較獨立的通用函數，一併寫在一個名爲FileCtrls.bas（盜用了Delphi的單元名，哈哈）模塊裏了。其實這些函數並沒有什麼技術含量，可是沒辦法，在Delphi裏這些都是Borland的帥哥們寫好的，在VB6裏卻要自己寫。也不知道是不是我笨，或許有更好的實現方式呢，嗚…
差點忘了，代碼~
Option Explicit
' API函數聲明
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
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Public Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As
Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXPLORER = &H80000 ' new look commdlg
Public Const MAX_PATH1 = 260
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH1
cAlternate As String * 14
End Type
' 文件信息結構。
Public Type FILEINFO
CompanyName As String
FileDescription As String
FileVersion As String
InternalName As String
LegalCopyright As String
OriginalFileName As String
ProductName As String
ProductVersion As String
End Type
Public Type FIXEDFILEINFO
dwSignature As Long ' e.g. $feef04bd
dwStrucVersion As Long ' e.g. $00000042 = "0.42"
dwFileVersionMS As Long ' e.g. $00030075 = "3.75"
dwFileVersionLS As Long ' e.g. $00000031 = "0.31"
dwProductVersionMS As Long ' e.g. $00030010 = "3.10"
dwProductVersionLS As Long ' e.g. $00000031 = "0.31"
dwFileFlagsMask As Long ' = $3F for version "0.42"
dwFileFlags As Long ' e.g. VFF_DEBUG | VFF_PRERELEASE
dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
dwFileType As Long ' e.g. VFT_DRIVER
dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
dwFileDateMS As Long ' e.g. 0
dwFileDateLS As Long ' e.g. 0
End Type
' 獲取文件信息函數返回值。
Public Enum VerisonReturnValue
eOK = 1
eNoVersion = 2
End Enum
'{ 強制創建路徑中的每個文件夾(如果不存在)。Cable Fan 2009-08-18 }
Public Function ForceDirectories(Path As String) As Boolean
Dim P As String
P = Trim(Path)
If Right(P, 1) = "/" Then P = Left(P, Len(P) - 1)
If P = "" Then
ForceDirectories = False
Exit Function
End If
Dim SA As SECURITY_ATTRIBUTES
If (Len(P) < 3) Or DirectoryExists(P) Or (ExtractFilePath(P) = P & "/") Then
ForceDirectories = True
Exit Function
End If
ForceDirectories = ForceDirectories(ExtractFilePath(P)) And CreateDirectory(P, SA)
End Function
'{ 檢測指定的目錄是否存在。Cable Fan 2009-08-18 }
Public Function DirectoryExists(Path As String) As Boolean
Dim Exists As Boolean
' 去除最後的分隔符。
Dim P As String
P = Path
If Right(P, 1) = "/" Then P = Mid(P, 1, Len(P) - 1)
Dim WFD As WIN32_FIND_DATA
Dim FHnd As Long
FHnd = FindFirstFile(P, WFD)
If FHnd = 0 Then
Exists = False ' 未找到配置的目錄。
Else
If WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY > 0 Then '檢找到的結果是否目錄
Exists = True
Else
Exists = False
End If
FindClose FHnd
End If
DirectoryExists = Exists
End Function
' { 將指定文件名與指定路徑合併得到完整文件名。Cable Fan 2009-08-18 }
Public Function GetFullFileName(Path As String, Short As String) As String
'{ 類似“C:/Folder1/Folder2/../../abc.txt”的文件名是有效的，所以本函數其實也是多餘的。}
' 去除最後的分隔符。
Dim P As String
P = Path
If Right(P, 1) = "/" Then P = Left(P, Len(P) - 1)
' 將路徑與文件名拆分到數組。
Dim Paths() As String, Files() As String
Paths = Split(P, "/"): Files = Split(Short, "/")
' 如果以盤符開頭則直接返回。
If Mid(Short, 2, 1) = ":" Then
GetFullFileName = Short
Exit Function
End If
' 不含路徑的文件名直接添加到路徑後返回。
If UBound(Files) < 1 Then
GetFullFileName = P & "/" & Short
Exit Function
End If
Dim i As Integer
Dim j As Integer
Dim S As String, S1 As String ' 分別保存路徑與文件名。
' 逐個比較路徑中的每個文件夾
S = ""
S1 = ""
j = 0
For i = 0 To UBound(Files)
If Files(i) = ".." Then ' 退回路徑
j = j + 1 ' 退回的路徑數。
Else
S1 = S1 & "/" & Files(i) ' 添加文件中的路徑及文件名。
End If
Next
' 組合未退回的路徑。
If UBound(Paths) < j Then
S = "" ' 如果退回的路徑超出了指定的路徑則不添加路徑。
Else
For i = 0 To UBound(Paths) - j
S = S & Paths(i) & "/"
Next
End If
' 去除路徑最後的分隔符。
If Right(S, 1) = "/" Then S = Left(S, Len(S) - 1)
GetFullFileName = S & S1
End Function
'{ 獲取指定文件名相對於指定路徑的短文件名。Cable Fan 2009-08-18 }
Public Function GetRelativeFileName(Path As String, FileName As String) As String
' 去除最後的分隔符。
Dim P As String
P = Path
If Right(P, 1) = "/" Then P = Left(P, Len(P) - 1)
' 將路徑與文件名拆分到數組。
Dim Paths() As String, Files() As String
Paths = Split(P, "/"): Files = Split(FileName, "/")
' 不含路徑的文件名直接返回。
If UBound(Files) < 1 Then
GetRelativeFileName = FileName
Exit Function
End If
Dim i As Integer
Dim j As Integer
Dim Diff As Boolean, Same As Boolean
Dim S As String
' 逐個比較路徑中的每個文件夾
S = ""
Diff = False ' 尚未遇到不同路徑。
Same = False ' 尚未遇到相同路徑。
For i = 0 To UBound(Paths)
If i <= UBound(Files) - 1 Then ' 不計文件名
If UCase(Paths(i)) = UCase(Files(i)) Then
' 出現了相同路徑且尚未出現不同路徑。
If Not Diff Then Same = True
' 如果出現過不同路徑並且，則出現的相同路徑要退回（添加“../”）。
If Diff And Same Then S = "/.." & S
' 出現不同路徑後直接將後面的路徑添加到返回值，相同則忽略。
If Diff Then S = S & "/" & Files(i)
Else
Diff = True ' 到此處開始不相同。
' 如果已經出現過相同路徑，則要將後面的路徑退回（添加“../”）。
If Same Then S = "/.." & S
S = S & "/" & Files(i)
End If
Else
' 如果已經出現過相同路徑，則要將後面的路徑退回（添加“../”）。
If Same Then S = "/.." & S
End If
j = i
Next
' 將多出的路徑添加到最後。
For i = j + 1 To UBound(Files) - 1 ' 不計文件名
S = S & "/" & Files(i)
Next
S = S & "/" & Files(UBound(Files)) ' 將文件名添加到最後。
If Left(S, 1) = "/" Then S = Mid(S, 2, Len(S)) ' 去除開頭的分隔符。
GetRelativeFileName = S
End Function
'{ 獲取指定文件的文件信息。Cable Fan 2009-08-04 }
Public Function GetFileInfo(ByRef pstrFieName As String, ByRef tFileInfo As FILEINFO) As VerisonReturnValue
Dim lBufferLen As Long, lDummy As Long
Dim sBuffer() As Byte
Dim lVerPointer As Long
Dim lRet As Long
Dim Lang_Charset_String As String
Dim HexNumber As Long
Dim i As Integer
Dim strTemp As String
'Clear the Buffer tFileInfo
tFileInfo.CompanyName = ""
tFileInfo.FileDescription = ""
tFileInfo.FileVersion = ""
tFileInfo.InternalName = ""
tFileInfo.LegalCopyright = ""
tFileInfo.OriginalFileName = ""
tFileInfo.ProductName = ""
tFileInfo.ProductVersion = ""
lBufferLen = GetFileVersionInfoSize(pstrFieName, lDummy)
If lBufferLen < 1 Then
GetFileInfo = eNoVersion
Exit Function
End If
ReDim sBuffer(lBufferLen)
lRet = GetFileVersionInfo(pstrFieName, 0&, lBufferLen, sBuffer(0))
If lRet = 0 Then
GetFileInfo = eNoVersion
Exit Function
End If
lRet = VerQueryValue(sBuffer(0), "/VarFileInfo/Translation", lVerPointer, lBufferLen)
If lRet = 0 Then
GetFileInfo = eNoVersion
Exit Function
End If
Dim bytebuffer(255) As Byte
MoveMemory bytebuffer(0), lVerPointer, lBufferLen
HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
Lang_Charset_String = Hex(HexNumber)
Do While Len(Lang_Charset_String) < 8
Lang_Charset_String = "0" & Lang_Charset_String
Loop
Dim strVersionInfo(7) As String
strVersionInfo(0) = "CompanyName"
strVersionInfo(1) = "FileDescription"
strVersionInfo(2) = "FileVersion"
strVersionInfo(3) = "InternalName"
strVersionInfo(4) = "LegalCopyright"
strVersionInfo(5) = "OriginalFileName"
strVersionInfo(6) = "ProductName"
strVersionInfo(7) = "ProductVersion"
Dim buffer As String
For i = 0 To 7
buffer = String(255, 0)
strTemp = "/StringFileInfo/" & Lang_Charset_String & "/" & strVersionInfo(i)
lRet = VerQueryValue(sBuffer(0), strTemp, lVerPointer, lBufferLen)
If lRet <> 0 Then
lstrcpy buffer, lVerPointer
buffer = Mid$(buffer, 1, InStr(buffer, vbNullChar) - 1)
Select Case i
Case 0
tFileInfo.CompanyName = buffer
Case 1
tFileInfo.FileDescription = buffer
Case 2
tFileInfo.FileVersion = buffer
Case 3
tFileInfo.InternalName = buffer
Case 4
tFileInfo.LegalCopyright = buffer
Case 5
tFileInfo.OriginalFileName = buffer
Case 6
tFileInfo.ProductName = buffer
Case 7
tFileInfo.ProductVersion = buffer
End Select
End If
Next i
GetFileInfo = eOK
End Function
'{ 截取指定文件名中的短文件名(不含路徑)。Cable Fan 2009-08-13 }
Public Function ExtractFileName(FileName As String) As String
Dim i As Integer
i = LastDelimiter("/", FileName)
If i <= 0 Then i = LastDelimiter("/", FileName)
ExtractFileName = Mid(FileName, i + 1, Len(FileName))
End Function
'{ 截取指定文件名中的路徑。Cable Fan 2009-08-14 }
Public Function ExtractFilePath(FileName As String) As String
Dim i As Integer
i = LastDelimiter("/", FileName)
ExtractFilePath = Left(FileName, i)
End Function
'{ 獲取指定分隔在指定字符串中最後出現的位置。Cable Fan 2009-08-13 }
Public Function LastDelimiter(Delimiters As String, S As String) As Integer
Dim i As Integer: Dim j As Integer
j = 0
For i = Len(S) To 1 Step -1
If Mid(S, i, Len(Delimiters)) = Delimiters Then
j = i
Exit For
End If
Next
LastDelimiter = j
End Function
'{ 判斷指定的文件是否存在。Cable Fan 2009-08-14 }
Public Function FileExists(FileName As String) As Boolean
On Error Resume Next
Dim FSO As New FileSystemObject
FileExists = FSO.FileExists(FileName)
Set FSO = Nothing
End Function
'{ 獲取指定文件的修改時間。Cable Fan 2009-08-14 }
Public Function GetFileModifiedDate(FileName As String) As Date
On Error GoTo CATCH
Dim FSO As New FileSystemObject
Dim F As File
Set F = FSO.GetFile(FileName)
If Not F Is Nothing Then
GetFileModifiedDate = F.DateLastModified
Exit Function
End If
CATCH:
GetFileModifiedDate = CDate(0) ' 默認返回0時間。
End Function
''{ 獲取指定文件的版本號。Cable Fan 2009-08-14 }
'Public Function GetFileVersion(FileName As String) As String
' Dim udtFileInfo As FILEINFO
'
' On Error Resume Next
'
' If GetFileInfo(FileName, udtFileInfo) = eNoVersion Then
' GetFileVersion = "0.0.0.0"
' Else
' GetFileVersion = udtFileInfo.FileVersion
' End If
'End Function
'{ 獲取指定文件的版本號。Cable Fan 2009-08-14 }
Public Function GetFileVersion(FileName As String) As String
Dim V1 As Long, V2 As Long, V3 As Long, V4 As Long
V1 = 0: V2 = 0: V3 = 0: V4 = 0
Dim VerInfoSize As Long, dummy As Long
VerInfoSize = GetFileVersionInfoSize(FileName, dummy)
If VerInfoSize > 0 Then
Dim VerInfo() As Byte
ReDim VerInfo(VerInfoSize)
If GetFileVersionInfo(FileName, 0&, VerInfoSize, VerInfo(0)) <> 0 Then
Dim VerValue(255) As Byte
Dim VerPointer As Long
Dim VerValueSize As Long
If VerQueryValue(VerInfo(0), "/", VerPointer, VerValueSize) <> 0 Then
MoveMemory VerValue(0), VerPointer, VerValueSize
V1 = VerValue(11) * 2 ^ 8 + VerValue(10)
V2 = VerValue(9) * 2 ^ 8 + VerValue(8)
V3 = VerValue(15) * 2 ^ 8 + VerValue(14)
V4 = VerValue(13) * 2 ^ 8 + VerValue(12)
End If
End If
End If
GetFileVersion = V1 & "." & V2 & "." & V3 & "." & V4
End Function
'{ 獲取指定文件的產品版本號。Cable Fan 2009-08-14 }
Public Function GetProductVersion(FileName As String) As String
Dim udtFileInfo As FILEINFO
On Error Resume Next
If GetFileInfo(FileName, udtFileInfo) = eNoVersion Then
GetProductVersion = "0.0.0.0"
Else
GetProductVersion = udtFileInfo.ProductVersion
End If
End Function
'{ 將版本號拆分爲主版本、次版本、發行版本與修訂版本。Cable Fan 2009-08-14 }
Public Sub SplitVersion(AVersion As String, ByRef AMajor As Integer, ByRef AMinor As Integer, _
ByRef ARelease As Integer, ByRef ARevision As Integer)
Dim Ver() As String
Ver = Split(AVersion, ".")
If UBound(Ver) >= 0 Then If IsNumeric(Ver(0)) Then AMajor = Ver(0)
If UBound(Ver) >= 1 Then If IsNumeric(Ver(1)) Then AMinor = Ver(1)
If UBound(Ver) >= 2 Then If IsNumeric(Ver(2)) Then ARelease = Ver(2)
If UBound(Ver) >= 3 Then If IsNumeric(Ver(3)) Then ARevision = Ver(3)
End Sub
'{ 比較兩個指定的版本號的新舊，V1比V2新返回1,相等返回0,舊則返回-1。Cable Fan 2009-08-14}
Public Function CompareVersion(V1 As String, V2 As String) As Integer
Dim Result As Integer
Result = 0
' 拆分版本號。
Dim S1 As Integer: Dim S2 As Integer: Dim S3 As Integer: Dim S4 As Integer
Dim D1 As Integer: Dim D2 As Integer: Dim D3 As Integer: Dim D4 As Integer
SplitVersion V1, S1, S2, S3, S4
SplitVersion V2, D1, D2, D3, D4
' 比較主版本號。
If S1 > D1 Then
Result = 1
ElseIf S1 < D1 Then
Result = -1
Else
' 主版本號相等時繼續比較次版本號。
If S2 > D2 Then
Result = 1
ElseIf S2 < D2 Then
Result = -1
Else
' 次要版本號也相等時繼續比較發行版本號。
If S3 > D3 Then
Result = 1
ElseIf S3 < D3 Then
Result = -1
Else
' 發行版本號也相等則比較修訂版本號。
If S4 > D4 Then
Result = 1
ElseIf S4 < D4 Then
Result = -1
Else
Result = 0 ' 最終相等。
End If
End If
End If
End If
CompareVersion = Result ' 返回比較結果。
End Function
'{ 檢查指定版本號與當前程序版本號的新舊，指定的新返回1,相等返回0,指定的版本號舊則返回-1。}
Public Function CheckVersion(AMajor As Integer, AMinor As Integer, ARevision As Integer) As Integer
Dim Result As Integer
Result = 0
' 比較主版本號。
If AMajor > App.Major Then
Result = 1
ElseIf AMajor < App.Major Then
Result = -1
Else
' 主版本號相等時繼續比較次版本號。
If AMinor > App.Minor Then
Result = 1
ElseIf AMinor < App.Minor Then
Result = -1
Else
' 次要版本號也相等時繼續比較修訂號。
If ARevision > App.Revision Then
Result = 1
ElseIf ARevision < App.Revision Then
Result = -1
Else
Result = 0 ' 最終相等。
End If
End If
End If
CheckVersion = Result ' 返回比較結果。
End Function
' API函數聲明
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
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Public Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As
Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXPLORER = &H80000 ' new look commdlg
Public Const MAX_PATH1 = 260
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH1
cAlternate As String * 14
End Type
' 文件信息結構。
Public Type FILEINFO
CompanyName As String
FileDescription As String
FileVersion As String
InternalName As String
LegalCopyright As String
OriginalFileName As String
ProductName As String
ProductVersion As String
End Type
Public Type FIXEDFILEINFO
dwSignature As Long ' e.g. $feef04bd
dwStrucVersion As Long ' e.g. $00000042 = "0.42"
dwFileVersionMS As Long ' e.g. $00030075 = "3.75"
dwFileVersionLS As Long ' e.g. $00000031 = "0.31"
dwProductVersionMS As Long ' e.g. $00030010 = "3.10"
dwProductVersionLS As Long ' e.g. $00000031 = "0.31"
dwFileFlagsMask As Long ' = $3F for version "0.42"
dwFileFlags As Long ' e.g. VFF_DEBUG | VFF_PRERELEASE
dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
dwFileType As Long ' e.g. VFT_DRIVER
dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
dwFileDateMS As Long ' e.g. 0
dwFileDateLS As Long ' e.g. 0
End Type
' 獲取文件信息函數返回值。
Public Enum VerisonReturnValue
eOK = 1
eNoVersion = 2
End Enum
'{ 強制創建路徑中的每個文件夾(如果不存在)。Cable Fan 2009-08-18 }
Public Function ForceDirectories(Path As String) As Boolean
Dim P As String
P = Trim(Path)
If Right(P, 1) = "/" Then P = Left(P, Len(P) - 1)
If P = "" Then
ForceDirectories = False
Exit Function
End If
Dim SA As SECURITY_ATTRIBUTES
If (Len(P) < 3) Or DirectoryExists(P) Or (ExtractFilePath(P) = P & "/") Then
ForceDirectories = True
Exit Function
End If
ForceDirectories = ForceDirectories(ExtractFilePath(P)) And CreateDirectory(P, SA)
End Function
'{ 檢測指定的目錄是否存在。Cable Fan 2009-08-18 }
Public Function DirectoryExists(Path As String) As Boolean
Dim Exists As Boolean
' 去除最後的分隔符。
Dim P As String
P = Path
If Right(P, 1) = "/" Then P = Mid(P, 1, Len(P) - 1)
Dim WFD As WIN32_FIND_DATA
Dim FHnd As Long
FHnd = FindFirstFile(P, WFD)
If FHnd = 0 Then
Exists = False ' 未找到配置的目錄。
Else
If WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY > 0 Then '檢找到的結果是否目錄
Exists = True
Else
Exists = False
End If
FindClose FHnd
End If
DirectoryExists = Exists
End Function
' { 將指定文件名與指定路徑合併得到完整文件名。Cable Fan 2009-08-18 }
Public Function GetFullFileName(Path As String, Short As String) As String
'{ 類似“C:/Folder1/Folder2/../../abc.txt”的文件名是有效的，所以本函數其實也是多餘的。}
' 去除最後的分隔符。
Dim P As String
P = Path
If Right(P, 1) = "/" Then P = Left(P, Len(P) - 1)
' 將路徑與文件名拆分到數組。
Dim Paths() As String, Files() As String
Paths = Split(P, "/"): Files = Split(Short, "/")
' 如果以盤符開頭則直接返回。
If Mid(Short, 2, 1) = ":" Then
GetFullFileName = Short
Exit Function
End If
' 不含路徑的文件名直接添加到路徑後返回。
If UBound(Files) < 1 Then
GetFullFileName = P & "/" & Short
Exit Function
End If
Dim i As Integer
Dim j As Integer
Dim S As String, S1 As String ' 分別保存路徑與文件名。
' 逐個比較路徑中的每個文件夾
S = ""
S1 = ""
j = 0
For i = 0 To UBound(Files)
If Files(i) = ".." Then ' 退回路徑
j = j + 1 ' 退回的路徑數。
Else
S1 = S1 & "/" & Files(i) ' 添加文件中的路徑及文件名。
End If
Next
' 組合未退回的路徑。
If UBound(Paths) < j Then
S = "" ' 如果退回的路徑超出了指定的路徑則不添加路徑。
Else
For i = 0 To UBound(Paths) - j
S = S & Paths(i) & "/"
Next
End If
' 去除路徑最後的分隔符。
If Right(S, 1) = "/" Then S = Left(S, Len(S) - 1)
GetFullFileName = S & S1
End Function
'{ 獲取指定文件名相對於指定路徑的短文件名。Cable Fan 2009-08-18 }
Public Function GetRelativeFileName(Path As String, FileName As String) As String
' 去除最後的分隔符。
Dim P As String
P = Path
If Right(P, 1) = "/" Then P = Left(P, Len(P) - 1)
' 將路徑與文件名拆分到數組。
Dim Paths() As String, Files() As String
Paths = Split(P, "/"): Files = Split(FileName, "/")
' 不含路徑的文件名直接返回。
If UBound(Files) < 1 Then
GetRelativeFileName = FileName
Exit Function
End If
Dim i As Integer
Dim j As Integer
Dim Diff As Boolean, Same As Boolean
Dim S As String
' 逐個比較路徑中的每個文件夾
S = ""
Diff = False ' 尚未遇到不同路徑。
Same = False ' 尚未遇到相同路徑。
For i = 0 To UBound(Paths)
If i <= UBound(Files) - 1 Then ' 不計文件名
If UCase(Paths(i)) = UCase(Files(i)) Then
' 出現了相同路徑且尚未出現不同路徑。
If Not Diff Then Same = True
' 如果出現過不同路徑並且，則出現的相同路徑要退回（添加“../”）。
If Diff And Same Then S = "/.." & S
' 出現不同路徑後直接將後面的路徑添加到返回值，相同則忽略。
If Diff Then S = S & "/" & Files(i)
Else
Diff = True ' 到此處開始不相同。
' 如果已經出現過相同路徑，則要將後面的路徑退回（添加“../”）。
If Same Then S = "/.." & S
S = S & "/" & Files(i)
End If
Else
' 如果已經出現過相同路徑，則要將後面的路徑退回（添加“../”）。
If Same Then S = "/.." & S
End If
j = i
Next
' 將多出的路徑添加到最後。
For i = j + 1 To UBound(Files) - 1 ' 不計文件名
S = S & "/" & Files(i)
Next
S = S & "/" & Files(UBound(Files)) ' 將文件名添加到最後。
If Left(S, 1) = "/" Then S = Mid(S, 2, Len(S)) ' 去除開頭的分隔符。
GetRelativeFileName = S
End Function
'{ 獲取指定文件的文件信息。Cable Fan 2009-08-04 }
Public Function GetFileInfo(ByRef pstrFieName As String, ByRef tFileInfo As FILEINFO) As VerisonReturnValue
Dim lBufferLen As Long, lDummy As Long
Dim sBuffer() As Byte
Dim lVerPointer As Long
Dim lRet As Long
Dim Lang_Charset_String As String
Dim HexNumber As Long
Dim i As Integer
Dim strTemp As String
'Clear the Buffer tFileInfo
tFileInfo.CompanyName = ""
tFileInfo.FileDescription = ""
tFileInfo.FileVersion = ""
tFileInfo.InternalName = ""
tFileInfo.LegalCopyright = ""
tFileInfo.OriginalFileName = ""
tFileInfo.ProductName = ""
tFileInfo.ProductVersion = ""
lBufferLen = GetFileVersionInfoSize(pstrFieName, lDummy)
If lBufferLen < 1 Then
GetFileInfo = eNoVersion
Exit Function
End If
ReDim sBuffer(lBufferLen)
lRet = GetFileVersionInfo(pstrFieName, 0&, lBufferLen, sBuffer(0))
If lRet = 0 Then
GetFileInfo = eNoVersion
Exit Function
End If
lRet = VerQueryValue(sBuffer(0), "/VarFileInfo/Translation", lVerPointer, lBufferLen)
If lRet = 0 Then
GetFileInfo = eNoVersion
Exit Function
End If
Dim bytebuffer(255) As Byte
MoveMemory bytebuffer(0), lVerPointer, lBufferLen
HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
Lang_Charset_String = Hex(HexNumber)
Do While Len(Lang_Charset_String) < 8
Lang_Charset_String = "0" & Lang_Charset_String
Loop
Dim strVersionInfo(7) As String
strVersionInfo(0) = "CompanyName"
strVersionInfo(1) = "FileDescription"
strVersionInfo(2) = "FileVersion"
strVersionInfo(3) = "InternalName"
strVersionInfo(4) = "LegalCopyright"
strVersionInfo(5) = "OriginalFileName"
strVersionInfo(6) = "ProductName"
strVersionInfo(7) = "ProductVersion"
Dim buffer As String
For i = 0 To 7
buffer = String(255, 0)
strTemp = "/StringFileInfo/" & Lang_Charset_String & "/" & strVersionInfo(i)
lRet = VerQueryValue(sBuffer(0), strTemp, lVerPointer, lBufferLen)
If lRet <> 0 Then
lstrcpy buffer, lVerPointer
buffer = Mid$(buffer, 1, InStr(buffer, vbNullChar) - 1)
Select Case i
Case 0
tFileInfo.CompanyName = buffer
Case 1
tFileInfo.FileDescription = buffer
Case 2
tFileInfo.FileVersion = buffer
Case 3
tFileInfo.InternalName = buffer
Case 4
tFileInfo.LegalCopyright = buffer
Case 5
tFileInfo.OriginalFileName = buffer
Case 6
tFileInfo.ProductName = buffer
Case 7
tFileInfo.ProductVersion = buffer
End Select
End If
Next i
GetFileInfo = eOK
End Function
'{ 截取指定文件名中的短文件名(不含路徑)。Cable Fan 2009-08-13 }
Public Function ExtractFileName(FileName As String) As String
Dim i As Integer
i = LastDelimiter("/", FileName)
If i <= 0 Then i = LastDelimiter("/", FileName)
ExtractFileName = Mid(FileName, i + 1, Len(FileName))
End Function
'{ 截取指定文件名中的路徑。Cable Fan 2009-08-14 }
Public Function ExtractFilePath(FileName As String) As String
Dim i As Integer
i = LastDelimiter("/", FileName)
ExtractFilePath = Left(FileName, i)
End Function
'{ 獲取指定分隔在指定字符串中最後出現的位置。Cable Fan 2009-08-13 }
Public Function LastDelimiter(Delimiters As String, S As String) As Integer
Dim i As Integer: Dim j As Integer
j = 0
For i = Len(S) To 1 Step -1
If Mid(S, i, Len(Delimiters)) = Delimiters Then
j = i
Exit For
End If
Next
LastDelimiter = j
End Function
'{ 判斷指定的文件是否存在。Cable Fan 2009-08-14 }
Public Function FileExists(FileName As String) As Boolean
On Error Resume Next
Dim FSO As New FileSystemObject
FileExists = FSO.FileExists(FileName)
Set FSO = Nothing
End Function
'{ 獲取指定文件的修改時間。Cable Fan 2009-08-14 }
Public Function GetFileModifiedDate(FileName As String) As Date
On Error GoTo CATCH
Dim FSO As New FileSystemObject
Dim F As File
Set F = FSO.GetFile(FileName)
If Not F Is Nothing Then
GetFileModifiedDate = F.DateLastModified
Exit Function
End If
CATCH:
GetFileModifiedDate = CDate(0) ' 默認返回0時間。
End Function
''{ 獲取指定文件的版本號。Cable Fan 2009-08-14 }
'Public Function GetFileVersion(FileName As String) As String
' Dim udtFileInfo As FILEINFO
'
' On Error Resume Next
'
' If GetFileInfo(FileName, udtFileInfo) = eNoVersion Then
' GetFileVersion = "0.0.0.0"
' Else
' GetFileVersion = udtFileInfo.FileVersion
' End If
'End Function
'{ 獲取指定文件的版本號。Cable Fan 2009-08-14 }
Public Function GetFileVersion(FileName As String) As String
Dim V1 As Long, V2 As Long, V3 As Long, V4 As Long
V1 = 0: V2 = 0: V3 = 0: V4 = 0
Dim VerInfoSize As Long, dummy As Long
VerInfoSize = GetFileVersionInfoSize(FileName, dummy)
If VerInfoSize > 0 Then
Dim VerInfo() As Byte
ReDim VerInfo(VerInfoSize)
If GetFileVersionInfo(FileName, 0&, VerInfoSize, VerInfo(0)) <> 0 Then
Dim VerValue(255) As Byte
Dim VerPointer As Long
Dim VerValueSize As Long
If VerQueryValue(VerInfo(0), "/", VerPointer, VerValueSize) <> 0 Then
MoveMemory VerValue(0), VerPointer, VerValueSize
V1 = VerValue(11) * 2 ^ 8 + VerValue(10)
V2 = VerValue(9) * 2 ^ 8 + VerValue(8)
V3 = VerValue(15) * 2 ^ 8 + VerValue(14)
V4 = VerValue(13) * 2 ^ 8 + VerValue(12)
End If
End If
End If
GetFileVersion = V1 & "." & V2 & "." & V3 & "." & V4
End Function
'{ 獲取指定文件的產品版本號。Cable Fan 2009-08-14 }
Public Function GetProductVersion(FileName As String) As String
Dim udtFileInfo As FILEINFO
On Error Resume Next
If GetFileInfo(FileName, udtFileInfo) = eNoVersion Then
GetProductVersion = "0.0.0.0"
Else
GetProductVersion = udtFileInfo.ProductVersion
End If
End Function
'{ 將版本號拆分爲主版本、次版本、發行版本與修訂版本。Cable Fan 2009-08-14 }
Public Sub SplitVersion(AVersion As String, ByRef AMajor As Integer, ByRef AMinor As Integer, _
ByRef ARelease As Integer, ByRef ARevision As Integer)
Dim Ver() As String
Ver = Split(AVersion, ".")
If UBound(Ver) >= 0 Then If IsNumeric(Ver(0)) Then AMajor = Ver(0)
If UBound(Ver) >= 1 Then If IsNumeric(Ver(1)) Then AMinor = Ver(1)
If UBound(Ver) >= 2 Then If IsNumeric(Ver(2)) Then ARelease = Ver(2)
If UBound(Ver) >= 3 Then If IsNumeric(Ver(3)) Then ARevision = Ver(3)
End Sub
'{ 比較兩個指定的版本號的新舊，V1比V2新返回1,相等返回0,舊則返回-1。Cable Fan 2009-08-14}
Public Function CompareVersion(V1 As String, V2 As String) As Integer
Dim Result As Integer
Result = 0
' 拆分版本號。
Dim S1 As Integer: Dim S2 As Integer: Dim S3 As Integer: Dim S4 As Integer
Dim D1 As Integer: Dim D2 As Integer: Dim D3 As Integer: Dim D4 As Integer
SplitVersion V1, S1, S2, S3, S4
SplitVersion V2, D1, D2, D3, D4
' 比較主版本號。
If S1 > D1 Then
Result = 1
ElseIf S1 < D1 Then
Result = -1
Else
' 主版本號相等時繼續比較次版本號。
If S2 > D2 Then
Result = 1
ElseIf S2 < D2 Then
Result = -1
Else
' 次要版本號也相等時繼續比較發行版本號。
If S3 > D3 Then
Result = 1
ElseIf S3 < D3 Then
Result = -1
Else
' 發行版本號也相等則比較修訂版本號。
If S4 > D4 Then
Result = 1
ElseIf S4 < D4 Then
Result = -1
Else
Result = 0 ' 最終相等。
End If
End If
End If
End If
CompareVersion = Result ' 返回比較結果。
End Function
'{ 檢查指定版本號與當前程序版本號的新舊，指定的新返回1,相等返回0,指定的版本號舊則返回-1。}
Public Function CheckVersion(AMajor As Integer, AMinor As Integer, ARevision As Integer) As Integer
Dim Result As Integer
Result = 0
' 比較主版本號。
If AMajor > App.Major Then
Result = 1
ElseIf AMajor < App.Major Then
Result = -1
Else
' 主版本號相等時繼續比較次版本號。
If AMinor > App.Minor Then
Result = 1
ElseIf AMinor < App.Minor Then
Result = -1
Else
' 次要版本號也相等時繼續比較修訂號。
If ARevision > App.Revision Then
Result = 1
ElseIf ARevision < App.Revision Then
Result = -1
Else
Result = 0 ' 最終相等。
End If
End If
End If
CheckVersion = Result ' 返回比較結果。
End Function