如何读取1个EXE文件的版本号？

[zanze]

如题····

网上看到一些教程···代码编译都有点问题···

我想读取一个游戏的版本号

[贝隆]

关注

[贝隆]

学习

[zanze]

仅仅是关注····

[of123]

Option Explicit

'Declarations:
Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long

Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)

Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) As Long

Private 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

Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)

Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long

'Functions:

Public Function StringFromBuffer(buffer As String) As String
Dim nPos As Long

nPos = InStr(buffer, vbNullChar)
If nPos > 0 Then
StringFromBuffer = Left$(buffer, nPos - 1)
Else
StringFromBuffer = buffer
End If
End Function

Public Function GetFileDescription(ByVal sFile As String) As String
Dim lVerSize As Long
Dim lTemp As Long
Dim lRet As Long
Dim bInfo() As Byte
Dim lpBuffer As Long
Dim sDesc As String
Dim sKEY As 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 & "\FileDescription", lpBuffer, lVerSize)
If lRet <> 0 Then
sDesc = Space$(lVerSize)
lstrcpyn sDesc, lpBuffer, lVerSize
GetFileDescription = StringFromBuffer(sDesc)
End If
lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & "\FileVersion", lpBuffer, lVerSize)
If lRet <> 0 Then
sDesc = Space$(lVerSize)
lstrcpyn sDesc, lpBuffer, lVerSize
GetFileDescription = GetFileDescription & " " & StringFromBuffer(sDesc)
End If
End If
End If
End Function

Public Function GetNLSKey(byteVerData() As Byte) As String
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)), "\VarFileInfo\Translation", lpBufPtr, lVerSize) <> 0 Then
If Len(strLANGCP) = 0 Then
lLCID = GetUserDefaultLCID()
If lLCID > 0 Then
strTmp = Space$(8)
GetLocaleInfoA lLCID, 11, strTmp, 8
strLANGCP = StringFromBuffer(strTmp)
Do While Len(strLANGCP) < 4
strLANGCP = "0" & strLANGCP
Loop
GetLocaleInfoA lLCID, 9, strTmp, 8
strLANGCP = StringFromBuffer(strTmp) & strLANGCP
Do While Len(strLANGCP) < 8
strLANGCP = "0" & strLANGCP
Loop
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)
Do While Len(strTmp) < 8
strTmp = "0" & strTmp
Loop
strNLSKey = "\StringFileInfo\" & 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 = "\StringFileInfo\040904E4"
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

Private Sub Command1_Click()
MsgBox GetFileDescription("c:\windows\calc.exe")
End Sub

[X800329]

关注！

[倒大霉的上帝]

路过，回帖可得10个可用分。
模块代码:

Option Explicit

Private FileName As String
Private Directory As String
Private FullFileName As String

Private StrucVer As String
Private FileVer As String
Private ProdVer As String
Private FileFlags As String
Private FileOS As String
Private FileType As String
Private FileSubType As String

Type VS_NEWINFO
    astr As String * 1024
End Type

Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersionl As Integer
    dwStrucVersionh As Integer
    dwFileVersionMSl As Integer
    dwFileVersionMSh As Integer
    dwFileVersionLSl As Integer
    dwFileVersionLSh As Integer
    dwProductVersionMSl As Integer
    dwProductVersionMSh As Integer
    dwProductVersionLSl As Integer
    dwProductVersionLSh As Integer
    dwFileFlagsMask As Long
    dwFileFlags As Long
    dwFileOS As Long
    dwFileType As Long
    dwFileSubtype As Long
    dwFileDateMS As Long
    dwFileDateLS As Long
End Type

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
Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal Path As String, ByVal cbBytes As Long) As Long

Private Const VS_FFI_SIGNATURE = &HFEEF04BD
Private Const VS_FFI_STRUCVERSION = &H10000
Private Const VS_FFI_FILEFLAGSMASK = &H3F&

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

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

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

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

Public Function GetFileVersion(vstrFullFileName As String) As String
    Dim rc As Long
    Dim lDummy As Long
    Dim sBuffer() As Byte
    Dim lBufferLen As Long
    Dim lVerPointer As Long
    Dim udtVerBuffer As VS_FIXEDFILEINFO
    Dim lVerbufferLen As Long
    Dim aBuffer() As Byte
    Dim lAdd As Long
    Dim astr As String
    Dim lTran As Long
    Dim FullFileName As String
    
    FullFileName = vstrFullFileName
    GetFileVersion = ""
    
    lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
    If lBufferLen < 1 Then
        Exit Function
    End If

    ReDim sBuffer(lBufferLen)
    rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
    rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
    MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)

    StrucVer = Format$(udtVerBuffer.dwStrucVersionh) & "." & Format$(udtVerBuffer.dwStrucVersionl)
    FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
    ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)

    GetFileVersion = FileVer
    
End Function

[king06]

有点晕晕的~··~

[chinaboyzyq]

标注~~

[qyaohai]

Dim objfso As New FileSystemObject

Debug.Print objfso.GetFileVersion("C:\Program Files\Microsoft ActiveSync\astu.exe")

[rmini]

mark