Attribute VB_Name = "modFileVersion"
' -------------------------------------------------------------------------------
'
'   AVStoDVD - by MrC
'   File: modFileVersion.bas
'   Purpose: version.dll API related fuctions and utils
'
' -------------------------------------------------------------------------------


Option Explicit
Option Compare Binary
Option Base 0


Private Const gstrDECIMAL$ = "."
Private Const gstrNULL$ = ""                             'Stringa vuota
Private Const gstrEXT_DEP$ = "DEP"
Private Const gintNOVERINFO% = 32767                     'Flag che indica l'assenza di informazioni sulla versione
Private Const gstrSEP_EXT$ = "."                         ' Carattere di separazione delle estensioni dei nomi di file.
Private Const gstrSEP_DIR$ = "\"                         ' Carattere di separazione delle directory.
Private Const gstrSEP_DIRALT$ = "/"                      ' Carattere di separazione alternativo delle directory.

Type VERINFO                                            'Versione FIXEDFILEINFO
    strPad1 As Long                                     'Versione
    strPad2 As Long                                     'Firma
    nMSLo As Integer                                    'Parola bassa della DWord contenente il numero di versione MS
    nMSHi As Integer                                    'Parola alta della DWord contenente il numero di versione MS
    nLSLo As Integer                                    'Parola bassa della DWord contenente il numero di versione LS
    nLSHi As Integer                                    'Parola alta della DWord contenente il numero di versione LS
    strPad3(1 To 16) As Byte                            'Ignora una parte della struttura VERINFO (16 byte)
    FileOS As Long                                      'Informazioni sul sistema operativo a cui questo file è destinato.
    strPad4(1 To 16) As Byte                            'Resto della struttura VERINFO (16 byte)
End Type

Private Declare Function GetFileVersionInfoSize Lib "VERSION.DLL" Alias "GetFileVersionInfoSizeA" (ByVal strFilename As String, lVerHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "VERSION.DLL" Alias "GetFileVersionInfoA" (ByVal strFilename As String, ByVal lVerHandle As Long, ByVal lcbSize As Long, lpvData As Byte) As Long
Private Declare Function VerQueryValue Lib "VERSION.DLL" Alias "VerQueryValueA" (lpvVerData As Byte, ByVal lpszSubBlock As String, lplpBuf As Long, lpcb As Long) As Long
Private Declare Sub lmemcpy Lib "kernel32" Alias "RtlMoveMemory" (strDest As Any, ByVal strSrc As Any, ByVal nBytes As Long)


Public Function GetFileVersion(ByVal strFilename As String, Optional ByVal fIsRemoteServerSupportFile As Boolean, Optional ShortSummary As Boolean) As String
    
    Dim sVerInfo As VERINFO
    Dim strVer As String
    Dim MouseP As Integer

    On Error GoTo GFVError

    MouseP = Screen.MousePointer
    Screen.MousePointer = vbHourglass
    
    'Legge la versione del file da una struttura VERINFO e quindi crea una
    'stringa di versione utilizzando gli elementi appropriati.
    If GetFileVerStruct(strFilename, sVerInfo, fIsRemoteServerSupportFile) = True Then
        strVer = Format$(sVerInfo.nMSHi) & gstrDECIMAL & Format$(sVerInfo.nMSLo) & gstrDECIMAL & Format$(sVerInfo.nLSHi)
        If ShortSummary = False Then
            strVer = strVer & gstrDECIMAL & Format$(sVerInfo.nLSLo)
        End If
        GetFileVersion = strVer
    Else
        GetFileVersion = gstrNULL
    End If
    
    Screen.MousePointer = MouseP
    
    Exit Function
    
GFVError:
    GetFileVersion = gstrNULL
    Err = 0
    Screen.MousePointer = MouseP
    
End Function

Private Function GetFileVerStruct(ByVal strFilename As String, sVerInfo As VERINFO, Optional ByVal fIsRemoteServerSupportFile) As Boolean
    
    Const strFIXEDFILEINFO$ = "\"

    Dim lVerSize As Long
    Dim lVerHandle As Long
    Dim lpBufPtr As Long
    Dim byteVerData() As Byte
    Dim fFoundVer As Boolean

    GetFileVerStruct = False
    fFoundVer = False

    If IsMissing(fIsRemoteServerSupportFile) Then
        fIsRemoteServerSupportFile = False
    End If
    
    If fIsRemoteServerSupportFile Then
        GetFileVerStruct = GetRemoteSupportFileVerStruct(strFilename, sVerInfo)
        fFoundVer = True
    Else
        'Recupera le dimensioni delle informazioni sulla versione del file, assegna
        'un buffer per tali informazioni e le recupera. Viene quindi eseguita una
        'ricerca sulla parte relativa alle informazioni fisse sul file in cui
        'è disponibile la versione interna del file utilizzata dalla funzione
        'VerInstallFile dell'API di Windows. Le informazioni fisse sul file vengono
        'quindi copiate in una struttura VERINFO.
        lVerSize = GetFileVersionInfoSize(strFilename, lVerHandle)
        If lVerSize > 0 Then
            ReDim byteVerData(lVerSize)
            If GetFileVersionInfo(strFilename, lVerHandle, lVerSize, byteVerData(0)) <> 0 Then ' (Pass byteVerData array via reference to first element)
                If VerQueryValue(byteVerData(0), strFIXEDFILEINFO & "", lpBufPtr, lVerSize) <> 0 Then
                    lmemcpy sVerInfo, lpBufPtr, lVerSize
                    fFoundVer = True
                    GetFileVerStruct = True
                End If
            End If
        End If
    End If
    
    If Not fFoundVer Then
        ' La ricerca delle informazioni sulla versione nel file ha avuto
        ' esito negativo. Uno dei motivi potrebbe essere che il file in
        ' questione è un file delle dipendenze.
        If UCase(Extension(strFilename)) = gstrEXT_DEP Then
            GetFileVerStruct = GetDepFileVerStruct(strFilename, sVerInfo)
        End If
    End If
End Function


Private Function GetRemoteSupportFileVerStruct(ByVal strFilename As String, sVerInfo As VERINFO) As Boolean
    
    Const strVersionKey = "Version="
    
    Dim cchVersionKey As Integer
    Dim iFile As Integer

    cchVersionKey = Len(strVersionKey)
    sVerInfo.nMSHi = gintNOVERINFO
    
    On Error GoTo Failed
    
    iFile = FreeFile

    Open strFilename For Input Access Read Lock Read Write As #iFile
    
    ' Esegue un ciclo su tutte le righe per individuare la chiave.
    While (Not EOF(iFile))
        Dim strLine As String

        Line Input #iFile, strLine
        If Left$(strLine, cchVersionKey) = strVersionKey Then
            ' La chiave della versione è stata trovata. Copia tutte le informazioni
            ' disponibili dopo il segno di uguale
            Dim strVersion As String
            
            strVersion = Mid$(strLine, cchVersionKey + 1)
            
            'Analizza e memorizza le informazioni sulla versione.
            PackVerInfo strVersion, sVerInfo

            'Converte il formato 1.2.3 del file .vbr in 1.2.0.3, che rappresenta il formato cercato.
            sVerInfo.nLSLo = sVerInfo.nLSHi
            sVerInfo.nLSHi = 0
            
            GetRemoteSupportFileVerStruct = True
            Close iFile
            Exit Function
        End If
    Wend
    
    Close iFile
    Exit Function

Failed:
    GetRemoteSupportFileVerStruct = False
    
End Function


Public Function Extension(ByVal strFilename As String) As String
    
    Dim intPos As Integer

    Extension = gstrNULL
    intPos = Len(strFilename)

    Do While intPos > 0
        Select Case Mid$(strFilename, intPos, 1)
            Case gstrSEP_EXT
                Extension = Mid$(strFilename, intPos + 1)
                Exit Do
            Case gstrSEP_DIR, gstrSEP_DIRALT
                Exit Do
        End Select

        intPos = intPos - 1
    Loop
    
End Function


Private Function GetDepFileVerStruct(ByVal strFilename As String, sVerInfo As VERINFO) As Boolean
    
    Const strVersionKey = "Version="
    
    Dim cchVersionKey As Integer
    Dim iFile As Integer

    GetDepFileVerStruct = False
    cchVersionKey = Len(strVersionKey)
    sVerInfo.nMSHi = gintNOVERINFO
    
    On Error GoTo Failed
    
    iFile = FreeFile
    Open strFilename For Input Access Read Lock Read Write As #iFile
    
    ' Esegue un ciclo su tutte le righe per individuare la chiave.
    While (Not EOF(iFile))
        Dim strLine As String

        Line Input #iFile, strLine
        If Left$(strLine, cchVersionKey) = strVersionKey Then
            ' La chiave della versione è stata trovata. Copia tutte le informazioni
            ' disponibili dopo il segno di uguale.
            Dim strVersion As String
            
            strVersion = Mid$(strLine, cchVersionKey + 1)
            
            'Analizza e memorizza le informazioni sulla versione.
            PackVerInfo strVersion, sVerInfo

            GetDepFileVerStruct = True
            Close iFile
            Exit Function
        End If
    Wend
    
    Close iFile
    Exit Function

Failed:
    GetDepFileVerStruct = False
    
End Function


Private Sub PackVerInfo(ByVal strVersion As String, sVerInfo As VERINFO)

    Dim intOffset As Integer
    Dim intAnchor As Integer

    On Error GoTo PVIError

    intOffset = InStr(strVersion, gstrDECIMAL)
    If intOffset = 0 Then
        sVerInfo.nMSHi = Val(strVersion)
        GoTo PVIMSLo
    Else
        sVerInfo.nMSHi = Val(Left$(strVersion, intOffset - 1))
        intAnchor = intOffset + 1
    End If

    intOffset = InStr(intAnchor, strVersion, gstrDECIMAL)
    If intOffset = 0 Then
        sVerInfo.nMSLo = Val(Mid$(strVersion, intAnchor))
        GoTo PVILSHi
    Else
        sVerInfo.nMSLo = Val(Mid$(strVersion, intAnchor, intOffset - intAnchor))
        intAnchor = intOffset + 1
    End If

    intOffset = InStr(intAnchor, strVersion, gstrDECIMAL)
    If intOffset = 0 Then
        sVerInfo.nLSHi = Val(Mid$(strVersion, intAnchor))
        GoTo PVILSLo
    Else
        sVerInfo.nLSHi = Val(Mid$(strVersion, intAnchor, intOffset - intAnchor))
        intAnchor = intOffset + 1
    End If

    intOffset = InStr(intAnchor, strVersion, gstrDECIMAL)
    If intOffset = 0 Then
        sVerInfo.nLSLo = Val(Mid$(strVersion, intAnchor))
    Else
        sVerInfo.nLSLo = Val(Mid$(strVersion, intAnchor, intOffset - intAnchor))
    End If

    Exit Sub

PVIError:
    sVerInfo.nMSHi = 0
PVIMSLo:
    sVerInfo.nMSLo = 0
PVILSHi:
    sVerInfo.nLSHi = 0
PVILSLo:
    sVerInfo.nLSLo = 0
End Sub
