Attribute VB_Name = "mod_FileVersionEx"
' Modul for Visual Basic 6
' Copyright (C) 2003-2007 Jan Vorel
'
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

'#FileVersionEx_FlagA
' 0/1 (always but reserved as 1): FileVersionEx
' 0/2 Build Str...
'10 = FileVersionCompare (bool)
'20 = FileVersionCompare (long)

Option Explicit
Option Base 0

Private Type VS_FIXEDFILEINFO
  dwSignature As Long
  dwStrucVersion As Long
  dwFileVersionMS As Long
  dwFileVersionLS As Long
  dwProductVersionMS As Long
  dwProductVersionLS As Long
  dwFileFlagsMask As Long
  dwFileFlags As Long
  dwFileOS As Long
  dwFileType As Long
  dwFileSubtype As Long
  dwFileDateMS As Long
  dwFileDateLS As Long
  End Type
Private Declare Function GetFileVersionInfoA Lib "version.dll" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSizeA Lib "version.dll" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValueA Lib "version.dll" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long

'Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long

Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)

'#If (FileVersionEx_FlagA And &H1&) = 1& Or FileVersionEx_FlagA = 0& Then
  Public Function GetFileVersionEx(ByVal Filename As String, Optional ByRef Revision As Long) As Long
    Dim xType1 As VS_FIXEDFILEINFO
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xChar1 As String
  
    xLong1 = GetFileVersionInfoSizeA(Filename, xLong2)
    If Not xLong1 = 0& Then
      xChar1 = String(xLong1, vbNullChar)
      If Not GetFileVersionInfoA(Filename, xLong2, xLong1, ByVal xChar1) = 0& Then
        If Not VerQueryValueA(ByVal xChar1, "\" & vbNullChar, xLong1, xLong2) = 0& Then
          If xLong2 = Len(xType1) Then
            Call RtlMoveMemory(xType1, ByVal xLong1, xLong2)
            GetFileVersionEx = xType1.dwFileVersionMS
            Revision = xType1.dwFileVersionLS
            End If
          End If
        End If
      End If
    End Function
'  #End If
#If (FileVersionEx_FlagA And &H2&) = 2& Or FileVersionEx_FlagA = 0& Then
  Public Function GetMyBuildNumber(Optional ByVal ResIDDefault As Long = -1&, Optional ByVal WantFileDescInstead As Boolean = False, Optional ByVal WantFileVerInstead As Boolean) As String
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xChar1 As String
    Dim xChar2 As String

'#If (AppBase_FlagA And &H10&) = &H10 Then
'    xChar1 = AppBase
'#Else
    xChar1 = AppBase(vbNullChar)
'#End If
    xLong1 = GetFileVersionInfoSizeA(xChar1, xLong2)
    If Not xLong1 = 0& Then
      xChar2 = String(xLong1, vbNullChar)
      If Not GetFileVersionInfoA(xChar1, xLong2, xLong1, ByVal xChar2) = 0& Then
        '040904E4
        'If Not Len(xChar1) = 0& Then
          If WantFileDescInstead Then
            If Not VerQueryValueA(ByVal xChar2, "\StringFileInfo\040904B0\FileDescription" & vbNullChar, xLong1, xLong2) = 0& Then
              xChar1 = GetApiCharA(xLong1)
              End If
            Else
            If Not VerQueryValueA(ByVal xChar2, "\StringFileInfo\040904B0\ProductName" & vbNullChar, xLong1, xLong2) = 0& Then
              xChar1 = GetApiCharA(xLong1)
              End If
            End If
          If WantFileVerInstead Then
            If Not VerQueryValueA(ByVal xChar2, "\StringFileInfo\040904B0\FileVersion" & vbNullChar, xLong1, xLong2) = 0& Then
              GetMyBuildNumber = GetApiCharA(xLong1)
              End If
            Else
            If Not VerQueryValueA(ByVal xChar2, "\StringFileInfo\040904B0\ProductVersion" & vbNullChar, xLong1, xLong2) = 0& Then
              GetMyBuildNumber = GetApiCharA(xLong1)
              End If
            End If
          'frmMain.Visible = False
          'frmMain.Visible = True
          If Len(GetMyBuildNumber) = 0& Then GetMyBuildNumber = "???"
          If Len(xChar1) = 0& Then xChar1 = "???"
          If ResIDDefault = -1& Then
            GetMyBuildNumber = xChar1 & " " & GetMyBuildNumber
            ElseIf Not ResIDDefault = -2& Then
            '#If (LoadResEx_FlagA And 1&) = 1& Then
              GetMyBuildNumber = Replace(Replace(LoadResEx_String(ResIDDefault), "$V", GetMyBuildNumber, , , vbTextCompare), "$P", xChar1, , , vbTextCompare)
            '  #Else
            '  On Error Resume Next
            '  'xchar2=
            '  GetMyBuildNumber = Replace(Replace(LoadResString(ResIDDefault), "$V", GetMyBuildNumber, , , vbTextCompare), "$P", xChar1, , , vbTextCompare)
            '  On Error GoTo 0
            '  #End If
            End If
          'End If
        End If
      End If
    End Function
  #End If

#If Not (FileVersionEx_FlagA And &H30&) = 0& Then
  #If (FileVersionEx_FlagA And &H20&) = &H20& Then
    Public Function GetFileVersionEx_CompareA(ByVal Filename As String, ByVal DesiredVersionChar As String) As Long
    #Else
    Public Function GetFileVersionEx_CompareA(ByVal Filename As String, ByVal DesiredVersionChar As String) As Boolean
    #End If
    
    '#If (FileVersionEx_FlagA And &H1&) = 1& Then
      Dim xType1_dwFileVersionMS As Long
      Dim xType1_dwFileVersionLS As Long
    '  #Else
    '  Dim xType1 As VS_FIXEDFILEINFO
    '  #End If
    Dim xLong1 As Long
    Dim xLong2 As Long
    #If (FileVersionEx_FlagA And &H20&) = &H20& Then
      #Else
      Dim xLong3 As Long
      #End If
    Dim xChar1 As String
    
  'GetFileVersionEx_CompareA = 4&
'#If (FileVersionEx_FlagA And &H1&) = &H1& Then
    xType1_dwFileVersionMS = GetFileVersionEx(Filename, xType1_dwFileVersionLS)
    If Not (xType1_dwFileVersionMS + xType1_dwFileVersionLS) = 0& Then
'#Else
'    xLong1 = GetFileVersionInfoSizeA(FileName, xLong2)
'    If Not xLong1 = 0& Then
'      xChar1 = String(xLong1, vbNullChar)
'      If Not GetFileVersionInfoA(FileName, xLong2, xLong1, ByVal xChar1) = 0& Then
'        If Not VerQueryValueA(ByVal xChar1, "\" & vbNullChar, xLong1, xLong2) = 0& Then
'          If xLong2 = Len(xType1) Then
'            Call RtlMoveMemory(xType1, ByVal xLong1, xLong2)
'#End If
              
              
              
      DesiredVersionChar = DesiredVersionChar & ".0.0.0."
      xLong1 = InStr(DesiredVersionChar, ".")
      xLong2 = Val(Left(DesiredVersionChar, xLong1 - 1&))
'#If (FileVersionEx_FlagA And &H1&) = &H1& Then
      Select Case (xType1_dwFileVersionMS \ &H10000)
'#Else
'      Select Case (xType1.dwFileVersionMS \ &H10000)
'#End If
        Case xLong2
          xLong2 = InStr(xLong1 + 1&, DesiredVersionChar, ".")
          xLong1 = Val(Mid(DesiredVersionChar, xLong1 + 1&, xLong2 - xLong1 - 1&))
'#If (FileVersionEx_FlagA And &H1&) = &H1& Then
          Select Case (xType1_dwFileVersionMS And &HFFFF&)
'#Else
'          Select Case (xType1.dwFileVersionMS And &HFFFF&)
'#End If
            Case xLong1
              xLong1 = InStr(xLong2 + 1&, DesiredVersionChar, ".")
              xLong2 = Val(Mid(DesiredVersionChar, xLong2 + 1&, xLong1 - xLong2 - 1&))
'#If (FileVersionEx_FlagA And &H1&) = &H1& Then
              Select Case (xType1_dwFileVersionLS \ &H10000)
'#Else
'              Select Case (xType1.dwFileVersionLS \ &H10000)
'#End If
                Case xLong2
                  xLong2 = InStr(xLong1 + 1&, DesiredVersionChar, ".")
                  xLong1 = Val(Mid(DesiredVersionChar, xLong1 + 1&, xLong2 - xLong1 - 1&))
'#If (FileVersionEx_FlagA And &H1&) = &H1& Then
                  Select Case (xType1_dwFileVersionLS And &HFFFF&)
'#Else
'                  Select Case (xType1.dwFileVersionLS And &HFFFF&)
'#End If
#If (FileVersionEx_FlagA And &H20&) = &H20& Then
                    Case Is < xLong1
                      GetFileVersionEx_CompareA = -1&
                    Case Is > xLong1
                      GetFileVersionEx_CompareA = 1&
#Else
                    Case Is >= xLong1
                      GetFileVersionEx_CompareA = True
#End If
                    End Select
#If (FileVersionEx_FlagA And &H20&) = &H20& Then
                Case Is < xLong2
                  GetFileVersionEx_CompareA = -2&
                Case Else
                  GetFileVersionEx_CompareA = 2&
#Else
                Case Is > xLong2
                  GetFileVersionEx_CompareA = True
#End If
                End Select
#If (FileVersionEx_FlagA And &H20&) = &H20& Then
            Case Is < xLong1
              GetFileVersionEx_CompareA = -3&
            Case Else
              GetFileVersionEx_CompareA = 3&
#Else
            Case Is > xLong1
              GetFileVersionEx_CompareA = True
#End If
            End Select
#If (FileVersionEx_FlagA And &H20&) = &H20& Then
        Case Is < xLong2
          GetFileVersionEx_CompareA = -4&
        Case Else
          GetFileVersionEx_CompareA = 4&
#Else
        Case Is > xLong2
          GetFileVersionEx_CompareA = True
#End If
        End Select
              
              
            
'#If (FileVersionEx_FlagA And &H1&) = 0& Then
'            End If
'          End If
'        End If
'#End If
      End If
    End Function
  #End If
