VB icon

Get Version Number for EXE, DLL or OCX files

Email
Submitted on: 1/4/2015 10:56:00 AM
By: Serge (from psc cd)  
Level: Advanced
User Rating: By 3 Users
Compatibility: VB 5.0, VB 6.0
Views: 8979
 
     This function will retrieve the version number, product name, original program name (like if you right click on the EXE file and select properties, then select Version tab, it shows you all that information) etc
 

Windows API/Global Declarations:

Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
'**************************************
'Windows API/Global Declarations for :Get Version Number for EXE, DLL or OCX files
'**************************************
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)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Public Type FILEINFO
CompanyName As String
FileDescription As String
FileVersion As String
InternalNameAs String
LegalCopyright As String
OriginalFileName As String
ProductName As String
ProductVersion As String
End Type
Public Enum VerisonReturnValue
eOK = 1
eNoVersion = 2
End Enum
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Get Version Number for EXE, DLL or OCX files
' Description:This function will retrieve the version number, product name, original program name (like if you right click on the EXE file and select properties, then select Version tab, it shows you all that information) etc
' By: Serge (from psc cd)
'
' Returns:FileInfo structure
'
' Assumes:Label (named Label1 and make it wide enough, also increase the height of the label to have size of the form), Common Dilaog Box (CommonDialog1) and a Command Button (Command1)
'**************************************

Public Function GetFileVersionInformation(ByRef pstrFieName As String, ByRef tFileInfo As FILEINFO) As VerisonReturnValue
Dim lBufferLen As Long, lDummy As Long
Dim sBuffer() As Byte
Dim lVerPointer As Long
Dim lRet As Long
Dim Lang_Charset_String As String
Dim HexNumber As Long
Dim i As Integer
Dim strTemp As String
'Clear the Buffer tFileInfo
tFileInfo.CompanyName = ""
tFileInfo.FileDescription = ""
tFileInfo.FileVersion = ""
tFileInfo.InternalName = ""
tFileInfo.LegalCopyright = ""
tFileInfo.OriginalFileName = ""
tFileInfo.ProductName = ""
tFileInfo.ProductVersion = ""
lBufferLen = GetFileVersionInfoSize(pstrFieName, lDummy)
If lBufferLen < 1 Then
GetFileVersionInformation = eNoVersion
Exit Function
End If
ReDim sBuffer(lBufferLen)
lRet = GetFileVersionInfo(pstrFieName, 0&, lBufferLen, sBuffer(0))
If lRet = 0 Then
GetFileVersionInformation = eNoVersion
Exit Function
End If
lRet = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lVerPointer, lBufferLen)
If lRet = 0 Then
GetFileVersionInformation = eNoVersion
Exit Function
End If
Dim bytebuffer(255) As Byte
MoveMemory bytebuffer(0), lVerPointer, lBufferLen
HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
Lang_Charset_String = Hex(HexNumber)
'Pull it all apart:
'04------= SUBLANG_ENGLISH_USA
'--09----= LANG_ENGLISH
' ----04E4 = 1252 = Codepage for Windows:Multilingual
Do While Len(Lang_Charset_String) < 8
Lang_Charset_String = "0" & Lang_Charset_String
Loop
Dim strVersionInfo(7) As String
strVersionInfo(0) = "CompanyName"
strVersionInfo(1) = "FileDescription"
strVersionInfo(2) = "FileVersion"
strVersionInfo(3) = "InternalName"
strVersionInfo(4) = "LegalCopyright"
strVersionInfo(5) = "OriginalFileName"
strVersionInfo(6) = "ProductName"
strVersionInfo(7) = "ProductVersion"
Dim buffer As String
For i = 0 To 7
buffer = String(255, 0)
strTemp = "\StringFileInfo\" & Lang_Charset_String _
& "\" & strVersionInfo(i)
lRet = VerQueryValue(sBuffer(0), strTemp, _
lVerPointer, lBufferLen)
If lRet = 0 Then
GetFileVersionInformation = eNoVersion
Exit Function
End If
lstrcpy buffer, lVerPointer
buffer = Mid$(buffer, 1, InStr(buffer, vbNullChar) - 1)
Select Case i
Case 0
tFileInfo.CompanyName = buffer
Case 1
tFileInfo.FileDescription = buffer
Case 2
tFileInfo.FileVersion = buffer
Case 3
tFileInfo.InternalName = buffer
Case 4
tFileInfo.LegalCopyright = buffer
Case 5
tFileInfo.OriginalFileName = buffer
Case 6
tFileInfo.ProductName = buffer
Case 7
tFileInfo.ProductVersion = buffer
End Select
Next i
GetFileVersionInformation = eOK
End Function
'-----------
Private Sub Command1_Click()
Dim strFile As String
Dim udtFileInfo As FILEINFO
On Error Resume Next
With CommonDialog1
.Filter = "All Files (*.*)|*.*"
.ShowOpen
strFile = .FileName
If Err.Number = cdlCancel Or strFile = "" Then Exit Sub
End With
If GetFileVersionInformation(strFile, udtFileInfo) = eNoVersion Then
MsgBox "No version available for this file", vbInformation
Exit Sub
End If
Label1 = "Company Name: " & udtFileInfo.CompanyName & vbCrLf
Label1 = Label1 & "File Description:" & udtFileInfo.FileDescription & vbCrLf
Label1 = Label1 & "File Version:" & udtFileInfo.FileVersion & vbCrLf
Label1 = Label1 & "Internal Name: " & udtFileInfo.InternalName & vbCrLf
Label1 = Label1 & "Legal Copyright: " & udtFileInfo.LegalCopyright & vbCrLf
Label1 = Label1 & "Original FileName:" & udtFileInfo.OriginalFileName & vbCrLf
Label1 = Label1 & "Product Name:" & udtFileInfo.ProductName & vbCrLf
Label1 = Label1 & "Product Version: " & udtFileInfo.ProductVersion & vbCrLf
End Sub


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Advanced category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.