Binaryworld - GetFileVersionData - Retrieve file versioning information ... [ VB -> Files & Folder ]

Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias _
  "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, _
  lpdwHandle As Long) As Long
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

' Get versioning information about a file
' it only works with Win32 files, and under Windows 95/98 the short path
' form of the specified file name must be less than 126 characters.
'
' If unsuccessful returns Empty
' If successful returns an array of strings in the format
'    "resourcename: resourcevalue"
' if a resource value hasn't been found, the string contains
' just the resource name, and you can filter out these items
' using the following statement
'   resources() = Filter(GetFileVersionData(FileName), ":")
'
' Usage:
'   Dim res As Variant, i As Long
'   res = GetFileVersionData(FileName)
'   If IsArray(res) Then
'     For i = LBound(res) To UBound(res)
'       Debug.Print res(i)
'     Next
'   End If

Function GetFileVersionData(ByVal FileName As String) As Variant
  Dim length As Long
  Dim handle As Long
  Dim buffer As String
  Dim index As Long
  Dim pos As Long

  ' get the size of the version info block
  ' (handle is always set to zero by the function
  length = GetFileVersionInfoSize(FileName, handle)
  If length = 0 Then Exit Function

  ' create the buffer (these are Unicode chars)
  buffer = Space$(length)

  ' get version information (2nd argument is ignored)
  If GetFileVersionInfo(FileName, handle, length, ByVal StrPtr(buffer)) = 0 _
    Then
    ' a zero return value means error
    Exit Function
  End If

  ' extract version information out of the buffer
  ' IMPORTANT: it doesn't use the official APIs, instead
  ' it uses euristics to extract the strings, and might
  ' fail under some circumstances

  ' create an array with the names of all the standard resources
  Dim res() As String
  res() = Split("CompanyName;FileDescription;FileVersion;InternalName;" & _
    "LegalCopyright;OriginalFilename;ProductName;ProductVersion;" & _
    "Comments;LegalTrademarks;PrivateBuild;SpecialBuild", ";")

  ' repeat for all the standard resources
  For index = 0 To UBound(res)
    pos = InStr(buffer, res(index))
    If pos Then
      ' skip over the resource name
      pos = pos + Len(res(index)) + 1
      ' if this is a null char, skip over it
      If Mid$(buffer, pos, 1) = vbNullChar Then pos = pos + 1

      ' extract the null terminated string and
      ' append it to the resource name
      res(index) = res(index) & ": " & Mid$(buffer, pos, InStr(pos, _
        buffer, vbNullChar) - pos)
    End If
  Next

  GetFileVersionData = res()

End Function