VB6 and version numbers

If you compile a VB6 exe, there is an option to increment the version number. If you look at the app in Wondows Explorer, there is a properties tab, which will display the version number without having to run the program and interrogate the app.major, app.minor, app.revision properties.

Is there an API call that can be used in VB6 that will work with Win95, Win98, and WinNT that can interrogate the app and bring back the version numbers?

Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Create a standard executable, add a module.  Add a command button, label and common dialog control.

Paste this code in the module:
Option Explicit

' API Declarations:
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
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
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 MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

' Type Declartions:
Public Type FILEINFO
    CompanyName As String
    FileDescription As String
    FileVersion As String
    InternalName As String
    LegalCopyright As String
    OriginalFileName As String
    ProductName As String
    ProductVersion As String
End Type

Public Enum VerisonReturnValue
    eOK = 1
    eNoVersion = 2
End Enum

Public Function GetFileVersionInformation(ByRef pstrFieName As String, ByRef tFileInfo As FILEINFO) As VerisonReturnValue
    Dim lBufferLen As Long, lDummy As Long
    Dim sBuffer() As Byte
    Dim lVerPointer As Long
    Dim lRet As Long
    Dim Lang_Charset_String As String
    Dim HexNumber As Long
    Dim i As Integer
    Dim strTemp As String
    'Clear the Buffer tFileInfo
    tFileInfo.CompanyName = ""
    tFileInfo.FileDescription = ""
    tFileInfo.FileVersion = ""
    tFileInfo.InternalName = ""
    tFileInfo.LegalCopyright = ""
    tFileInfo.OriginalFileName = ""
    tFileInfo.ProductName = ""
    tFileInfo.ProductVersion = ""
    lBufferLen = GetFileVersionInfoSize(pstrFieName, lDummy)

    If lBufferLen < 1 Then
        GetFileVersionInformation = eNoVersion
        Exit Function
    End If
    ReDim sBuffer(lBufferLen)
    lRet = GetFileVersionInfo(pstrFieName, 0&, lBufferLen, sBuffer(0))

    If lRet = 0 Then
        GetFileVersionInformation = eNoVersion
        Exit Function
    End If
    lRet = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lVerPointer, lBufferLen)

    If lRet = 0 Then
        GetFileVersionInformation = eNoVersion
        Exit Function
    End If
    Dim bytebuffer(255) As Byte
    MoveMemory bytebuffer(0), lVerPointer, lBufferLen
    HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
    Lang_Charset_String = Hex(HexNumber)
    'Pull it all apart:
    '04------= SUBLANG_ENGLISH_USA
    '--09----= LANG_ENGLISH
    ' ----04E4 = 1252 = Codepage for Windows
    '     :Multilingual

    Do While Len(Lang_Charset_String) < 8
        Lang_Charset_String = "0" & Lang_Charset_String
    Dim strVersionInfo(7) As String
    strVersionInfo(0) = "CompanyName"
    strVersionInfo(1) = "FileDescription"
    strVersionInfo(2) = "FileVersion"
    strVersionInfo(3) = "InternalName"
    strVersionInfo(4) = "LegalCopyright"
    strVersionInfo(5) = "OriginalFileName"
    strVersionInfo(6) = "ProductName"
    strVersionInfo(7) = "ProductVersion"
    Dim buffer As String

    For i = 0 To 7
        buffer = String(255, 0)
        strTemp = "\StringFileInfo\" & Lang_Charset_String _
        & "\" & strVersionInfo(i)
        lRet = VerQueryValue(sBuffer(0), strTemp, _
        lVerPointer, lBufferLen)

        If lRet = 0 Then
            GetFileVersionInformation = eNoVersion
            Exit Function
        End If
        lstrcpy buffer, lVerPointer
        buffer = Mid$(buffer, 1, InStr(buffer, vbNullChar) - 1)

        Select Case i
            Case 0
            tFileInfo.CompanyName = buffer
            Case 1
            tFileInfo.FileDescription = buffer
            Case 2
            tFileInfo.FileVersion = buffer
            Case 3
            tFileInfo.InternalName = buffer
            Case 4
            tFileInfo.LegalCopyright = buffer
            Case 5
            tFileInfo.OriginalFileName = buffer
            Case 6
            tFileInfo.ProductName = buffer
            Case 7
            tFileInfo.ProductVersion = buffer
        End Select
Next i
GetFileVersionInformation = eOK
End Function

Then paste this code in the form:
Option Explicit

Private Sub Command1_Click()
    Dim strFile As String
    Dim udtFileInfo As FILEINFO
    On Error Resume Next

    With CommonDialog1
        .Filter = "All Files (*.*)|*.*"
        strFile = .FileName
        If Err.Number = cdlCancel Or strFile = "" Then Exit Sub
    End With

    If GetFileVersionInformation(strFile, udtFileInfo) = eNoVersion Then
        MsgBox "No version available For this file", vbInformation
        Exit Sub
    End If
    Label1 = "Company Name: " & udtFileInfo.CompanyName & vbCrLf
    Label1 = Label1 & "File Description:" & udtFileInfo.FileDescription & vbCrLf
    Label1 = Label1 & "File Version:" & udtFileInfo.FileVersion & vbCrLf
    Label1 = Label1 & "Internal Name: " & udtFileInfo.InternalName & vbCrLf
    Label1 = Label1 & "Legal Copyright: " & udtFileInfo.LegalCopyright & vbCrLf
    Label1 = Label1 & "Original FileName:" & udtFileInfo.OriginalFileName & vbCrLf
    Label1 = Label1 & "Product Name:" & udtFileInfo.ProductName & vbCrLf
    Label1 = Label1 & "Product Version: " & udtFileInfo.ProductVersion & vbCrLf
End Sub

This will retreive information on .exe, .dll and .ocx files:>)


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
finsterAuthor Commented:
Hi there,

This works brilliantly!

The only change I would make is in the GetFileVersionInformation function, I would change:
For i = 0 To 7
   buffer = String(255, 0)
   strTemp = "\StringFileInfo\" & Lang_Charset_String & "\" & strVersionInfo(i)
   lRet = VerQueryValue(sBuffer(0), strTemp, lVerPointer, lBufferLen)

   If lRet = 0 Then
      GetFileVersionInformation = eNoVersion
      Exit Function
   End If
   ... [rest of code]
next i


For i = 0 To 7
   buffer = String(255, 0)
   strTemp = "\StringFileInfo\" & Lang_Charset_String & "\" & strVersionInfo(i)
   lRet = VerQueryValue(sBuffer(0), strTemp, lVerPointer, lBufferLen)

   If lRet > 0 Then

      ... [rest of code]
   end if
next i

this way the whole UDT can be filled, and the function does not end if there is no tFileInfo.FileDescription returned.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.