7,785
社区成员




'---------------------------------------------------------------------------------------
' 模块 : mdlVersion
' 时间 : 2013-1-30 21:21
' 作者 : 杨过.网狐.cn
' 功能 :
' 备注 : 其实还想写一个计算两个版本具体版本号差别的函数,不过规则还不好定下来。用途之一:
' 现在网络时代,不少软件升级太频繁,用这个判断版本升级量小的就不频繁升级了
'---------------------------------------------------------------------------------------
Option Explicit
'---------------------------------------------------------------------------------------
' 过程名 : VerComp
' 时间 : 2013-1-30 18:34
' 作者 : 杨过.网狐.cn(csdn bcrun)
' 功能 : 比较版本字符串的大小,参数一较大则返回值大于0,较小则小于0,相等则为0
' 说明 : 使用Val处理来做了容错,比如1234b这样的部分就当1234处理,不报错
' 备注 : CSDN之VB一群:283362041,星辰学园BASIC辅导群:289219875
'---------------------------------------------------------------------------------------
'
Public Function VerComp(sVersion1 As String, sVersion2 As String) As Long
Dim i As Long, iUbound As Long, iCha As Long
Dim sTemp As String
Dim arrVer1() As String, arrVer2() As String
arrVer1 = Split(sVersion1, ".")
arrVer2 = Split(sVersion2, ".")
If (UBound(arrVer1) > UBound(arrVer2)) Then
iUbound = UBound(arrVer2)
Else
iUbound = UBound(arrVer1)
End If
'先做都有的节的比较
For i = LBound(arrVer1) To iUbound
iCha = Val(arrVer1(i)) - Val(arrVer2(i))
If (iCha > 0) Then
VerComp = 1: Exit Function
ElseIf (iCha < 0) Then
VerComp = -1: Exit Function
End If
Next
'都有的节判断完毕,分不出大小
VerComp = UBound(arrVer1) - UBound(arrVer2)
End Function
'---------------------------------------------------------------------------------------
' 过程名 : GetFileVersion
' 时间 : 2013-1-30 20:13
' 作者 : 杨过.网狐.cn(csdn bcrun)
' 功能 : 返回文件版本字符串,注意,不是“文件属性”中其它版本信息中的那个,区别嘛,自己比较一下vb6.exe的
' 说明 :
' 备注 : CSDN之VB一群:283362041,星辰学园BASIC辅导群:289219875
'---------------------------------------------------------------------------------------
'
Public Function GetFileVersion(FileName As String) As String
Const ForReading = 1, ForWriting = 2, ForAppending = 3
On Error GoTo GetFileVersion_Error
GetFileVersion = ""
Dim fs 'As FileSystemObject
Dim sVersion As String 'as File
Set fs = CreateObject("Scripting.FileSystemObject")
sVersion = fs.GetFileVersion(FileName)
GetFileVersion = sVersion
On Error GoTo 0
Exit Function
GetFileVersion_Error:
'MsgBox "错误 " & Err.Number & " (" & Err.Description & ") in procedure GetFileVersion of Module mdlVersion"
End Function
'---------------------------------------------------------------------------------------
' 过程名 : VerPlus
' 时间 : 2013-1-30 20:32
' 作者 : 杨过.网狐.cn(csdn bcrun)
' 功能 : 类似VB那个版本号“自动升级”的配置,注意这里默认是给最后一节加1个版本
' 说明 :
' 备注 : CSDN之VB一群:283362041,星辰学园BASIC辅导群:289219875
'---------------------------------------------------------------------------------------
'
Public Function VerPlus(sVersion As String, Optional iPlusNum As Long = 1) As String
Dim arrVer1() As String
arrVer1 = Split(sVersion, ".")
arrVer1(UBound(arrVer1)) = Val(arrVer1(UBound(arrVer1))) + iPlusNum
VerPlus = Join(arrVer1, ".")
End Function
Dim strVer1 As String, strVer2 As String
Dim strItem1() As String, strItem2() As String
Dim i As Integer, n As Integer, d As Long
strVer1 = "5.2.3790.24123"
strVer2 = "5.11.7883"
strItem1 = Split(strVer1, ".")
strItem2 = Split(strVer2, ".")
n = UBound(strItem1)
If n < UBound(strItem2) Then n = UBound(strItem2)
For i = 0 To n
If strItem1(i) <> strItem2(i) Then Exit For
Next i
If i < n + 1 Then
d = CLng(strItem1(i)) - CLng(strItem2(i))
If d < 0 Then
MsgBox strVer1 & " < " & strVer2
Else
MsgBox strVer1 & " > " & strVer2
End If
Else
MsgBox strVer1 & " = " & strVer2
End If
Option Explicit
Sub Main()
Debug.Print CompVer("5.2.3790.24123", "5.2.3790.24123")
Debug.Print CompVer("5.2.3790.24123", "5.2.3790.999")
Debug.Print CompVer("5.2.3790.24123", "5.11.7883")
End Sub
Function CompVer(ByVal v1 As String, ByVal v2 As String) As Long
Dim a1() As String
Dim a2() As String
Dim i As Long
a1 = Split(v1, ".")
a2 = Split(v2, ".")
For i = 0 To 3
Select Case Sgn(CInt(a1(i)) - CInt(a2(i)))
Case -1: GoTo LT
Case 0
Case 1: GoTo GT
End Select
Next
CompVer = 0
Exit Function
LT:
CompVer = -1
Exit Function
GT:
CompVer = 1
End Function