给个现成的你看看:
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 Byte) As Long
Private 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 LongPublic Function GetFileVersionString(ByVal sFileName As String) As String
Dim lSize As Long
Dim sTmp As String
Dim aTmp() As Byte
Dim I As Long
lSize = GetFileVersionInfoSize(sFileName, 0)
If lSize <> 0 Then
ReDim aTmp(0 To lSize - 1) As Byte
GetFileVersionInfo sFileName, 0, lSize, aTmp(0)
For I = 0 To lSize - 1
sTmp = sTmp & Chr(aTmp(I))
Next I
sTmp = Replace(sTmp, vbNullChar, "")
GetFileVersionString = Trim(sTmp)
End If
End Function
================================================================
[* 我是僵尸我怕谁 *]
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 Byte) As Long
Private 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 LongPublic Function GetFileVersionString(ByVal sFileName As String) As String
Dim lSize As Long
Dim sTmp As String
Dim aTmp() As Byte
Dim I As Long
lSize = GetFileVersionInfoSize(sFileName, 0)
If lSize <> 0 Then
ReDim aTmp(0 To lSize - 1) As Byte
GetFileVersionInfo sFileName, 0, lSize, aTmp(0)
For I = 0 To lSize - 1
sTmp = sTmp & Chr(aTmp(I))
Next I
sTmp = Replace(sTmp, vbNullChar, "")
GetFileVersionString = Trim(sTmp)
End If
End Function
================================================================
[* 我是僵尸我怕谁 *]
或许就是你要的Public Function GetMyVersion() As String
Static strMyVer As String
If strMyVer = "" Then
strMyVer = Trim$(Str$(App.Major)) & "." & Format$(App.Minor, "##00") & "." & Format$(App.Revision, "000")
End If
GetMyVersion = strMyVer
End FunctionPrivate Sub Command1_Click()
MsgBox GetMyVersion
End Sub试一试。
msgbox "版本 " & App.Major & "." & App.Minor & "." & App.Revision
先谢谢两位朋友,我的意思是:我拿到一个现成的VB程序XXX,不是我写的。需要从另外一个我写的程序中得到XXX的版本号!说明白一点,就是需要一个函数,传入参数为完整的路径和VB程序名称,例如“C:\XXX.exe”,然后输出一个版本号,例如“1.3.123”。并不是用APP.major之类的。
4VS_VERSION_INFODVarFileInfo$Translation`StringFileInfo<080404B08ProductNameSVBxveNHr,gS4FileVersion1.02.00038ProductVersion1.02.00038InternalNameSVBxveNHr,gSHOriginalFilenameSVBxveNHr,gS.exeFE2X
里面倒是含有有我需要的版本号:1.2.3
但是如何准确分析这个字符串?我想得出具体的各项内容的意思。
{ DWORD dwInfoSize;
LPTSTR lpBuffer;
unsigned int i;
char lpszName[]="c:\\windows\\system\\msdxm.ocx";
dwInfoSize=GetFileVersionInfoSize(lpszName,NULL);
LPTSTR chData=(LPSTR)malloc(dwInfoSize);
GetFileVersionInfo(lpszName,NULL,dwInfoSize,chData);
VerQueryValue(chData,
(LPTSTR)TEXT("\\StringFileInfo\\040904E4\\FileVersion"), //英语\文件版本
(LPVOID*)&lpBuffer,
(UINT*)&i);
MessageBox(lpBuffer,"");
free(chData);
}
天哪,请看清题意。
请问输出结果是什么样的字符串?
' 文件属性类
' File Version Info Class
' Uses
' clsFile
' Exposes
' Property File
' Property FileType
' Property FileVersion
' Property OS
' Property ProductVersion
' Property SubType
Option Explicit
Private iFileVersion As String
Private iProductVersion As String
Private iFlags As String
Private iOS As String
Private iFileType As String
Private iSubType As String
' -------------------------
Private Type VS_VERSION
dwSignature As Long
dwStrucVersion As Long ' e.g. 0x00000042 = "0.42"
dwFileVersionMS As Long ' e.g. 0x00030075 = "3.75"
dwFileVersionLS As Long ' e.g. 0x00000031 = "0.31"
dwProductVersionMS As Long ' e.g. 0x00030010 = "3.10"
dwProductVersionLS As Long ' e.g. 0x00000031 = "0.31"
dwFileFlagsMask As Long ' = 0x3F for version "0.42"
dwFileFlags As Long ' e.g. VFF_DEBUG Or 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
Private Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer ' e.g. = &h0000 = 0
dwStrucVersionh As Integer ' e.g. = &h0042 = .42
dwFileVersionMSl As Integer ' e.g. = &h0003 = 3
dwFileVersionMSh As Integer ' e.g. = &h0075 = .75
dwFileVersionLSl As Integer ' e.g. = &h0000 = 0
dwFileVersionLSh As Integer ' e.g. = &h0031 = .31
dwProductVersionMSl As Integer ' e.g. = &h0003 = 3
dwProductVersionMSh As Integer ' e.g. = &h0010 = .1
dwProductVersionLSl As Integer ' e.g. = &h0000 = 0
dwProductVersionLSh As Integer ' e.g. = &h0031 = .31
dwFileFlagsMask As Long ' = &h3F For version "0.42"
dwFileFlags As Long ' e.g. VFF_DEBUG Or 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
#If Win32 Then
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 Byte) As Long
Private Declare Function VerLanguageName Lib "version.dll" Alias "VerLanguageNameA" (ByVal wLang As Long, ByVal szLang As String, ByVal nSize As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Byte, ByVal lpSubBlock As String, lplpBuffer As Long, 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
stvDest As Any, _
stvSource As Any, _
ByVal cbCopy As Long)
#End If
' **** VS_VERSION.dwFileFlags ****
Private Const VS_FF_DEBUG = &H1
Private Const VS_FF_PRERELEASE = &H2
Private Const VS_FF_PATCHED = &H4
Private Const VS_FF_PRIVATEBUILD = &H8
Private Const VS_FF_INFOINFERRED = &H10
Private Const VS_FF_SPECIALBUILD = &H20
' **** VS_VERSION.dwFileOS ****
Private Const VOS_UNKNOWN = &H0
Private Const VOS_DOS = &H10000
Private Const VOS_OS216 = &H20000
Private Const VOS_OS232 = &H30000
Private Const VOS_NT = &H40000
Private Const VOS__BASE = &H0
Private Const VOS__WINDOWS16 = &H1
Private Const VOS__PM16 = &H2
Private Const VOS__PM32 = &H3
Private Const VOS__WINDOWS32 = &H4
Private Const VOS_DOS_WINDOWS16 = &H10001
Private Const VOS_DOS_WINDOWS32 = &H10004
Private Const VOS_OS216_PM16 = &H20002
Private Const VOS_OS232_PM32 = &H30003
Private Const VOS_NT_WINDOWS32 = &H40004
' **** VS_VERSION.dwFileType ****
Private Const VFT_UNKNOWN = &H0
Private Const VFT_APP = &H1
Private Const VFT_DLL = &H2
Private Const VFT_DRV = &H3
Private Const VFT_FONT = &H4
Private Const VFT_VXD = &H5
Private Const VFT_STATIC_LIB = &H7
' **** VS_VERSION.dwFileSubtype for VFT_WINDOWS_DRV ****
Private Const VFT2_UNKNOWN = &H0
Private Const VFT2_DRV_PRINTER = &H1
Private Const VFT2_DRV_KEYBOARD = &H2
Private Const VFT2_DRV_LANGUAGE = &H3
Private Const VFT2_DRV_DISPLAY = &H4
Private Const VFT2_DRV_MOUSE = &H5
Private Const VFT2_DRV_NETWORK = &H6
Private Const VFT2_DRV_SYSTEM = &H7
Private Const VFT2_DRV_INSTALLABLE = &H8
Private Const VFT2_DRV_SOUND = &H9
Private Const VFT2_DRV_COMM = &HA
' **** VS_VERSION.dwFileSubtype for VFT_WINDOWS_FONT ****
Private Const VFT2_FONT_RASTER = &H1
Private Const VFT2_FONT_VECTOR = &H2
Private Const VFT2_FONT_TRUETYPE = &H3
FileType = iFileType
End Property
Public Property Get FileVersion() As String
FileVersion = iFileVersion
End Property
Public Property Get OS() As String
OS = iOS
End Property
Public Property Get ProductVersion() As String
ProductVersion = iProductVersion
End Property
Public Property Get SubType() As String
SubType = iSubType
End PropertyPublic Function CheckFileVersion(FilenameAndPath As Variant) As Variant
On Error GoTo HandelCheckFileVersionError
Dim lDummy As Long, lsize As Long, rc As Long
Dim lVerbufferLen As Long, lVerPointer As Long
Dim sBuffer() As Byte
Dim udtVerBuffer As VS_FIXEDFILEINFO
Dim ProdVer As String
lsize = GetFileVersionInfoSize(FilenameAndPath, lDummy)
If lsize < 1 Then Exit Function
ReDim sBuffer(lsize)
rc = GetFileVersionInfo(FilenameAndPath, 0&, lsize, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
If rc = 0 Then
Exit Function
End If
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer) iFileVersion = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl)
iFileVersion = iFileVersion & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
CheckFileVersion = iFileVersion
' Determine Product Version number
iProductVersion = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl)
iProductVersion = iProductVersion & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
If udtVerBuffer.dwFileFlags And VS_FF_DEBUG Then iFlags = "Debug"
If udtVerBuffer.dwFileFlags And VS_FF_PRERELEASE Then iFlags = iFlags + "Pre release"
If udtVerBuffer.dwFileFlags And VS_FF_PATCHED Then iFlags = iFlags + "Patched"
If udtVerBuffer.dwFileFlags And VS_FF_PRIVATEBUILD Then iFlags = iFlags + "Private build"
If udtVerBuffer.dwFileFlags And VS_FF_INFOINFERRED Then iFlags = iFlags + "Info"
If udtVerBuffer.dwFileFlags And VS_FF_DEBUG Then iFlags = iFlags + "Special"
If udtVerBuffer.dwFileFlags And &HFF00 Then iFlags = iFlags + "Unknown"
' Determine OS for which file was designed
Select Case udtVerBuffer.dwFileOS
Case VOS_DOS_WINDOWS16
iOS = "DOS-Win16"
Case VOS_DOS_WINDOWS32
iOS = "DOS-Win32"
Case VOS_OS216_PM16
iOS = "OS/2-16 PM-16"
Case VOS_OS232_PM32
iOS = "OS/2-32 PM-32"
Case VOS_NT_WINDOWS32
iOS = "NT-Win32"
Case Else
iOS = "Unknown"
End Select
' Determine Type and SubType of File
Select Case udtVerBuffer.dwFileType
Case VFT_APP
iFileType = "App"
Case VFT_DLL
iFileType = "DLL"
Case VFT_DRV
iFileType = "Driver"
Select Case udtVerBuffer.dwFileSubtype
Case VFT2_DRV_PRINTER
iSubType = "Printer drv"
Case VFT2_DRV_KEYBOARD
iSubType = "Keyboard drv"
Case VFT2_DRV_LANGUAGE
iSubType = "Language drv"
Case VFT2_DRV_DISPLAY
iSubType = "Display drv"
Case VFT2_DRV_MOUSE
iSubType = "Mouse drv"
Case VFT2_DRV_NETWORK
iSubType = "Network drv"
Case VFT2_DRV_SYSTEM
iSubType = "System drv"
Case VFT2_DRV_INSTALLABLE
iSubType = "Installable"
Case VFT2_DRV_SOUND
iSubType = "Sound drv"
Case VFT2_DRV_COMM
iSubType = "Comm drv"
Case VFT2_UNKNOWN
iSubType = "Unknown"
End Select
Case VFT_FONT
iFileType = "Font"
Select Case udtVerBuffer.dwFileSubtype
Case VFT2_FONT_RASTER
iSubType = "Raster Font"
Case VFT2_FONT_VECTOR
iSubType = "Vector Font"
Case VFT2_FONT_TRUETYPE
iSubType = "TrueType Font"
End Select
Case VFT_VXD
iFileType = "VxD"
Case VFT_STATIC_LIB
iFileType = "Lib"
Case Else
iFileType = "Unknown"
End Select
Exit Function
HandelCheckFileVersionError:
CheckFileVersion = "N/A"
Exit Function
End Function
问:在我的程序的“关于……”中显示程序的版本(以标准方式显示:即 x.xx.xxxx),该怎么做?
答:你可以使用以下子程序:
Public Function GetMyVersion() As String
Static strMyVer As String
If strMyVer = "" Then
strMyVer = Trim$(Str$(App.Major)) & "." & Format$(App.Minor, "##00") & "." Format$(App.Revision, "000")
End If
GetMyVersion = strMyVer
End Function
很遗憾,我知道在程序中可以用App.Major App.Minor App.Revision
得出版本。现在的问题是:程序已经编译好了,而且根本不是自己写的。我需要象读取文件时间那样(例如VB6的FileDateTime函数)得到磁盘文件的版本号。
试试hongzhen225() 的方法先。
不过,给点分吧:)