Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Advanced
Jan 15, 2000

GetFileVersionData - Retrieve file versioning information

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

Francesco Balena
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date