Binaryworld - Determines the file version number of an executable file ... [ VB -> Files & Folder ]

API Declarations

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

Module

'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
    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

Usage

Option Explicit

Private Sub Command1_Click()
  MsgBox GetFileDescription("c:\windows\system\shell32.dll")
End Sub