Source code for Issue Number 98

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Create a new module and paste this source code into it. You should name this class basVersionNumber. If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    basVersionNumber
'   Written By:     C&D Programming Corp.
'   Create Date:    7/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

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

' Note: the API viewer has this declaration all wrong!
Private Declare Function VerQueryValue Lib "Version.dll" Alias _
   "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
   lplpBuffer As Any, puLen As Long) As Long

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
    (vTo As Any, vFrom As Any, ByVal lSize As Long)

Private Type VS_FIXEDFILEINFO
        dwSignature As Long
        dwStrucVersion As Long         '  e.g. 0x00000042 = "0.42"
        dwFileVersionMS As Long        '  e.g. 0x00030075 = "3.75"
        dwFileVersionLS As Long        '  e.g. 0x00000031 = "0.31"
        dwProductVersionMS As Long     '  e.g. 0x00030010 = "3.10"
        dwProductVersionLS As Long     '  e.g. 0x00000031 = "0.31"
        dwFileFlagsMask As Long        '  = 0x3F for version "0.42"
        dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
        dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
        dwFileType As Long             '  e.g. VFT_DRIVER
        dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
        dwFileDateMS As Long           '  e.g. 0
        dwFileDateLS As Long           '  e.g. 0
End Type

Public Function GetVersionNumber(ByVal sFileName As String) As String
    Dim typFileInfo As VS_FIXEDFILEINFO
    Dim baVersionBuffer() As Byte
    Dim lFVInfoSize As Long
    Dim lHandle As Long
    Dim lRet As Long
    Dim lFileAddress As Long
    Dim lLength As Long

    ' determine the size of the version buffer and setup the array
    lFVInfoSize = GetFileVersionInfoSize(sFileName, lHandle)
    ReDim baVersionBuffer(0 To lFVInfoSize + 1)

    ' Load the array with version information
    lRet = GetFileVersionInfo(sFileName, lHandle, _
                                 lFVInfoSize, baVersionBuffer(0))
    lRet = VerQueryValue(baVersionBuffer(0), _
                             "\", lFileAddress, lLength)

    ' if error occurs return an empty string
    If lRet <= 0 Then
        GetVersionNumber = ""
        Exit Function
    End If

    ' if we have a good version number, let's return it to the caller.
    If lFileAddress <> 0 Then
       CopyMem typFileInfo, ByVal lFileAddress, Len(typFileInfo)
       GetVersionNumber = VersionNumberString(typFileInfo.dwFileVersionMS) & "." & _
                          VersionNumberString(typFileInfo.dwFileVersionLS)
    End If
End Function

Private Function VersionNumberString(lVersionNumber As Long) As String
    Dim lMajorVersion As Long
    Dim lMinorVersion As Long

    lMajorVersion = CLng(lVersionNumber / &H10000)
    lMinorVersion = CLng(lVersionNumber And &HFFFF&)

    ' only show the major version if it is not zero.  This matches how Windows 95
    ' shows the version number in the property pages.
    If lMajorVersion = 0 Then
        VersionNumberString = CStr(lMinorVersion)
    Else
        VersionNumberString = CStr(lMajorVersion) & "." & CStr(lMinorVersion)
    End If
End Function