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)
Public Type tFileInfo
FullFileName As String
StrucVer As String
FileVer As String
ProdVer As String
FileFlags As String
FileOS As String
FileType As String
FileSubType As String
End Type
Public Sub DisplayVerInfo(Directory As String, FileName As String, FInfo As tFileInfo)
Dim rc As Long, lDummy As Long, sBuffer() As Byte
Dim lBufferLen As Long, lVerPointer As Long, udtVerBuffer As VS_FIXEDFILEINFO
Dim lVerbufferLen As Long
With FInfo
'*** Get size ****
.FullFileName = Directory & IIf(Right$(Directory, 1) = "\", "", "\") & FileName
lBufferLen = GetFileVersionInfoSize(.FullFileName, lDummy)
If lBufferLen < 1 Then
MsgBox "No Version Info available!"
Exit Sub
End If
'**** Store info to udtVerBuffer struct ****
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(.FullFileName, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
'**** Determine Structure Version number - NOT USED ****
.StrucVer = Format$(udtVerBuffer.dwStrucVersionh) & "." & Format$(udtVerBuffer.dwStrucVersionl)
'**** Determine File Version number ****
''' .FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." _
''' & Format$(udtVerBuffer.dwFileVersionMSl) & "." _
''' & Format$(udtVerBuffer.dwFileVersionLSh) & "." _
''' & Format$(udtVerBuffer.dwFileVersionLSl)
'''
.FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." _
& Format$(udtVerBuffer.dwFileVersionMSl) & "." _
& Format$(udtVerBuffer.dwFileVersionLSl)
'**** Determine Product Version number ****
.ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & _
Format$(udtVerBuffer.dwProductVersionMSl) & "." & _
Format$(udtVerBuffer.dwProductVersionLSh) & "." & _
Format$(udtVerBuffer.dwProductVersionLSl)
'**** Determine Boolean attributes of File ****
.FileFlags = ""
If udtVerBuffer.dwFileFlags And VS_FF_DEBUG Then .FileFlags = "Debug "
If udtVerBuffer.dwFileFlags And VS_FF_PRERELEASE Then .FileFlags = .FileFlags & "PreRel "
If udtVerBuffer.dwFileFlags And VS_FF_PATCHED Then .FileFlags = .FileFlags & "Patched "
If udtVerBuffer.dwFileFlags And VS_FF_PRIVATEBUILD Then .FileFlags = .FileFlags & "Private "
If udtVerBuffer.dwFileFlags And VS_FF_INFOINFERRED Then .FileFlags = .FileFlags & "Info "
If udtVerBuffer.dwFileFlags And VS_FF_SPECIALBUILD Then .FileFlags = .FileFlags & "Special "
If udtVerBuffer.dwFileFlags And VFT2_UNKNOWN Then .FileFlags = .FileFlags + "Unknown "
'**** Determine OS for which file was designed ****
Select Case udtVerBuffer.dwFileOS
Case VOS_DOS_WINDOWS16
.FileOS = "DOS-Win16"
Case VOS_DOS_WINDOWS32
.FileOS = "DOS-Win32"
Case VOS_OS216_PM16
.FileOS = "OS/2-16 PM-16"
Case VOS_OS232_PM32
.FileOS = "OS/2-16 PM-32"
Case VOS_NT_WINDOWS32
.FileOS = "NT-Win32"
Case Else
.FileOS = "Unknown"
End Select
Select Case udtVerBuffer.dwFileType
Case VFT_APP
.FileType = "App"
Case VFT_DLL
.FileType = "DLL"
Case VFT_DRV
.FileType = "Driver"
Select Case udtVerBuffer.dwFileSubtype
Case VFT2_DRV_PRINTER
.FileSubType = "Printer drv"
Case VFT2_DRV_KEYBOARD
.FileSubType = "Keyboard drv"
Case VFT2_DRV_LANGUAGE
.FileSubType = "Language drv"
Case VFT2_DRV_DISPLAY
.FileSubType = "Display drv"
Case VFT2_DRV_MOUSE
.FileSubType = "Mouse drv"
Case VFT2_DRV_NETWORK
.FileSubType = "Network drv"
Case VFT2_DRV_SYSTEM
.FileSubType = "System drv"
Case VFT2_DRV_INSTALLABLE
.FileSubType = "Installable"
Case VFT2_DRV_SOUND
.FileSubType = "Sound drv"
Case VFT2_DRV_COMM
.FileSubType = "Comm drv"
Case VFT2_UNKNOWN
.FileSubType = "Unknown"
End Select
Case VFT_FONT
.FileType = "Font"
' Select Case udtVerBuffer.dwFileSubtype
' Case VFT_FONT_RASTER
' .FileSubType = "Raster Font"
' Case VFT_FONT_VECTOR
' .FileSubType = "Vector Font"
' Case VFT_FONT_TRUETYPE
' .FileSubType = "TrueType Font"
' End Select
Case VFT_VXD
.FileType = "VxD"
Case VFT_STATIC_LIB
.FileType = "Lib"
Case Else
.FileType = "Unknown"
End Select
End With
End Sub
Private Sub Command1_Click()
MsgBox GetFileVersion(App.Path & "\", "File.Exe")
End Sub
Private Function GetFileVersion(Path As String, FileName As String)
Dim FInfo As tFileInfo
DisplayVerInfo UtilPath, FileName, FInfo
GetFileVersion = FInfo.FileVer
End Function