请问如何取得可执行文件的版本号

[9527]

在可执行文件的右键菜单中，可以看到该文件的版本信息，诸如内部版本，版权信息，公司名称之类，请问该如何取得这些信息，我想用他来做版本控制。

[Un1]

Window Version information API, VB source:

Declare Function VerInstallFile Lib "version.dll" Alias "VerInstallFileA" (ByVal Flags&, ByVal SrcName$, ByVal DestName$, ByVal SrcDir$, ByVal DestDir$, ByVal CurrDir As Any, ByVal TmpName$, lpTmpFileLen&) As Long
Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen) As Long
Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long
Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long
Declare Function OSGetShortPathName Lib "Kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long



'-----------------------------------------------------------
' FUNCTION: GetFileVersion
'
' Returns the internal file version number for the specified
' file. This can be different than the 'display' version
' number shown in the File Manager File Properties dialog.
' It is the same number as shown in the VB5 SetupWizard's
' File Details screen. This is the number used by the
' Windows VerInstallFile API when comparing file versions.
'
' IN: [strFilename] - the file whose version # is desired
' [fIsRemoteServerSupportFile] - whether or not this file is
' a remote ActiveX component support file (.VBR)
' (Enterprise edition only). If missing, False is assumed.
'
' Returns: The Version number string if found, otherwise
' vbnullstring
'-----------------------------------------------------------
'
Function GetFileVersion(ByVal strFilename As String, Optional ByVal fIsRemoteServerSupportFile As Boolean = False) As String
Dim sVerInfo As VERINFO
Dim strVer As String

On Error GoTo GFVError

'
'Get the file version into a VERINFO struct, and then assemble a version string
'from the appropriate elements.
'
If GetFileVerStruct(strFilename, sVerInfo, fIsRemoteServerSupportFile) = True Then
strVer = Format$(sVerInfo.FileVerPart1) & gstrDECIMAL & Format$(sVerInfo.FileVerPart2) & gstrDECIMAL
strVer = strVer & Format$(sVerInfo.FileVerPart3) & gstrDECIMAL & Format$(sVerInfo.FileVerPart4)
GetFileVersion = strVer
Else
GetFileVersion = vbNullString
End If

Exit Function

GFVError:
GetFileVersion = vbNullString
Err = 0
End Function

'-----------------------------------------------------------
' FUNCTION: GetFileVerStruct
'
' Gets the file version information into a VERINFO TYPE
' variable
'
' IN: [strFilename] - name of file to get version info for
' [fIsRemoteServerSupportFile] - whether or not this file is
' a remote ActiveX component support file (.VBR)
' (Enterprise edition only). If missing, False is assumed.
' OUT: [sVerInfo] - VERINFO Type to fill with version info
'
' Returns: True if version info found, False otherwise
'-----------------------------------------------------------
'
Function GetFileVerStruct(ByVal sFile As String, sVer As VERINFO, Optional ByVal fIsRemoteServerSupportFile As Boolean = False) As Boolean
Dim lVerSize As Long, lTemp As Long, lRet As Long
Dim bInfo() As Byte
Dim lpBuffer As Long
Const sEXE As String * 1 = "\"
Dim fFoundVer As Boolean

GetFileVerStruct = False
fFoundVer = False

If fIsRemoteServerSupportFile Then
GetFileVerStruct = GetRemoteSupportFileVerStruct(sFile, sVer)
fFoundVer = True
Else
'
'Get the size of the file version info, allocate a buffer for it, and get the
'version info. Next, we query the Fixed file info portion, where the internal
'file version used by the Windows VerInstallFile API is kept. We then copy
'the fixed file info into a VERINFO structure.
'
lVerSize = GetFileVersionInfoSize(sFile, lTemp)
ReDim bInfo(lVerSize)
If lVerSize > 0 Then
lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))
If lRet <> 0 Then
lRet = VerQueryValue(VarPtr(bInfo(0)), sEXE & vbNullChar, lpBuffer, lVerSize)
If lRet <> 0 Then
CopyMemory sVer, ByVal lpBuffer, lVerSize
fFoundVer = True
GetFileVerStruct = True
End If
End If
End If
End If
If Not fFoundVer Then
'
' We were unsuccessful in finding the version info from the file.
' One possibility is that this is a dependency file.
'
If UCase(Extension(sFile)) = gstrEXT_DEP Then
GetFileVerStruct = GetDepFileVerStruct(sFile, sVer)
End If
End If
End Function
'-----------------------------------------------------------
' FUNCTION: GetFileDescription
'
' Gets the file description information.
'
' IN: [strFilename] - name of file to get description of.
'
' Returns: Description (vbNullString if not found)
'-----------------------------------------------------------
'
Function GetFileDescription(ByVal sFile As String) As String
Dim lVerSize As Long, lTemp As Long, lRet As Long
Dim bInfo() As Byte
Dim lpBuffer As Long
Dim sDesc As String
Dim sKEY As String
Const sEXE As String = "\FileDescription"

GetFileDescription = vbNullString

'
'Get the size of the file version info, allocate a buffer for it, and get the
'version info. Next, we query the Fixed file info portion, where the internal
'file version used by the Windows VerInstallFile API is kept. We then copy
'the info into a string.
'
lVerSize = GetFileVersionInfoSize(sFile, lTemp)
ReDim bInfo(lVerSize)
If lVerSize > 0 Then
lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))
If lRet <> 0 Then
sKEY = GetNLSKey(bInfo)
lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & sEXE, lpBuffer, lVerSize)
If lRet <> 0 Then
sDesc = Space$(lVerSize)
lstrcpyn sDesc, lpBuffer, lVerSize
GetFileDescription = sDesc
End If
End If
End If
End Function
Private Function GetNLSKey(byteVerData() As Byte) As String
Const strTRANSLATION$ = "\VarFileInfo\Translation"
Const strSTRINGFILEINFO$ = "\StringFileInfo\"
Const strDEFAULTNLSKEY$ = "040904E4"
Const LOCALE_IDEFAULTLANGUAGE& = &H9&
Const LOCALE_IDEFAULTCODEPAGE& = &HB&

Static strLANGCP As String

Dim lpBufPtr As Long
Dim strNLSKey As String
Dim fGotNLSKey As Integer
Dim intOffset As Integer
Dim lVerSize As Long
Dim ltmp As Long
Dim lBufLen As Long
Dim lLCID As Long
Dim strTmp As String

On Error GoTo GNLSKCleanup

If VerQueryValue(VarPtr(byteVerData(0)), strTRANSLATION, lpBufPtr, lVerSize) <> 0 Then ' (Pass byteVerData array via reference to first element)
If Len(strLANGCP) = 0 Then
lLCID = GetUserDefaultLCID()
If lLCID > 0 Then
strTmp = Space$(8)

GetLocaleInfoA lLCID, LOCALE_IDEFAULTCODEPAGE, strTmp, 8
strLANGCP = StripTerminator(strTmp)
While Len(strLANGCP) < 4
strLANGCP = gsZERO & strLANGCP
Wend

GetLocaleInfoA lLCID, LOCALE_IDEFAULTLANGUAGE, strTmp, 8
strLANGCP = StripTerminator(strTmp) & strLANGCP
While Len(strLANGCP) < 8
strLANGCP = gsZERO & strLANGCP
Wend
End If
End If

If VerQueryValue(VarPtr(byteVerData(0)), strLANGCP, ltmp, lBufLen) <> 0 Then
strNLSKey = strLANGCP
Else
For intOffset = 0 To lVerSize - 1 Step 4
CopyMemory ltmp, ByVal lpBufPtr + intOffset, 4
strTmp = Hex$(ltmp)
While Len(strTmp) < 8
strTmp = gsZERO & strTmp
Wend

strNLSKey = strSTRINGFILEINFO & Right$(strTmp, 4) & Left$(strTmp, 4)

If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, ltmp, lBufLen) <> 0 Then
fGotNLSKey = True
Exit For
End If
Next

If Not fGotNLSKey Then
strNLSKey = strSTRINGFILEINFO & strDEFAULTNLSKEY
If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, ltmp, lBufLen) <> 0 Then
fGotNLSKey = True
End If
End If
End If
End If

GNLSKCleanup:
If fGotNLSKey Then
GetNLSKey = strNLSKey
End If
End Function
'-----------------------------------------------------------
' FUNCTION: GetDepFileVerStruct
'
' Gets the file version information from a dependency
' file (*.dep). Such files do not have a Windows version
' stamp, but they do have an internal version stamp that
' we can look for.
'
' IN: [strFilename] - name of dep file to get version info for
' OUT: [sVerInfo] - VERINFO Type to fill with version info
'
' Returns: True if version info found, False otherwise
'-----------------------------------------------------------
'
Function GetDepFileVerStruct(ByVal strFilename As String, sVerInfo As VERINFO) As Boolean
Const strVersionKey = "Version="
Dim cchVersionKey As Integer
Dim iFile As Integer

GetDepFileVerStruct = False

cchVersionKey = Len(strVersionKey)
sVerInfo.FileVerPart1 = gintNOVERINFO

On Error GoTo Failed

iFile = FreeFile

Open strFilename For Input Access Read Lock Read Write As #iFile

' Loop through each line, looking for the key
While (Not EOF(iFile))
Dim strLine As String

Line Input #iFile, strLine
If Left$(strLine, cchVersionKey) = strVersionKey Then
' We've found the version key. Copy everything after the equals sign
Dim strVersion As String

strVersion = Mid$(strLine, cchVersionKey + 1)

'Parse and store the version information
PackVerInfo strVersion, sVerInfo

GetDepFileVerStruct = True
Close iFile
Exit Function
End If
Wend

Close iFile
Exit Function

Failed:
GetDepFileVerStruct = False
End Function

'-----------------------------------------------------------
' FUNCTION: GetRemoteSupportFileVerStruct
'
' Gets the file version information of a remote ActiveX component
' support file into a VERINFO TYPE variable (Enterprise
' Edition only). Such files do not have a Windows version
' stamp, but they do have an internal version stamp that
' we can look for.
'
' IN: [strFilename] - name of file to get version info for
' OUT: [sVerInfo] - VERINFO Type to fill with version info
'
' Returns: True if version info found, False otherwise
'-----------------------------------------------------------
'
Function GetRemoteSupportFileVerStruct(ByVal strFilename As String, sVerInfo As VERINFO) As Boolean
Const strVersionKey = "Version="
Dim cchVersionKey As Integer
Dim iFile As Integer

cchVersionKey = Len(strVersionKey)
sVerInfo.FileVerPart1 = gintNOVERINFO

On Error GoTo Failed

iFile = FreeFile

Open strFilename For Input Access Read Lock Read Write As #iFile

' Loop through each line, looking for the key
While (Not EOF(iFile))
Dim strLine As String

Line Input #iFile, strLine
If Left$(strLine, cchVersionKey) = strVersionKey Then
' We've found the version key. Copy everything after the equals sign
Dim strVersion As String

strVersion = Mid$(strLine, cchVersionKey + 1)

'Parse and store the version information
PackVerInfo strVersion, sVerInfo

'Convert the format 1.2.3 from the .VBR into
'1.2.0.3, which is really want we want
sVerInfo.FileVerPart4 = sVerInfo.FileVerPart3
sVerInfo.FileVerPart3 = 0

GetRemoteSupportFileVerStruct = True
Close iFile
Exit Function
End If
Wend

Close iFile
Exit Function

Failed:
GetRemoteSupportFileVerStruct = False
End Function

[Wingsun]

你可以使用Windows API GetFileVersionInfo.详情可参见帮助信息。

[9527]

多谢Un1和Wingsun

[9527]

un1,非常抱歉,加分加错了,原本要给您多一些的,结果加颠倒了,请见谅.希望以后继续得到您的帮助