Get Version Number for EXE, DLL or OCX files

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