FileVersion

' 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

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