RÉCUPÉRER LA DESCRIPTION D'UN EXECUTABLE + AUTRES INFORMATIONS (DATE, VERSION, COMPANY, COPYRIGHT, ETC...)

' ------------------------------------------------------------------
' Exemple a mettre dans une form
Private Sub Form_Load()
    Me.AutoRedraw = True
    Me.Print GetDescription("C:\WINDOWS\Explorer.exe", FileDescription)
End Sub



' ------------------------------------------------------------------
' ça dans un module
' Les api
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

' Un argument de type Enum permet l'apparition d'une liste de
' choix lors de la saisie de l'appel de fonction.
Public Enum TypeInfo
  CompanyName = 0
  FileDescription
  FileVersion
  InternalName
  LegalCopyright
  OriginalFileName
  ProductName
  ProductVersion
End Enum

' Renvoie des informations sur les fichiers
Public Function GetDescription(ByVal FullFileName As String, ByVal TypeInfo As TypeInfo) As String
    ' Les variables
    Dim Buffer As String
    Dim rc As Long
    Dim strVersionInfo As String, strTemp As String
    Dim BufferLen As Long, Dummy As Long
    Dim sBuffer() As Byte
    Dim ByteBuffer(255) As Byte
    Dim Lang_Charset_String As String
    Dim HexNumber As Long
    Dim VerPointer As Long, Err As Long

    ' Sélectionne le type de données que l'on veut récupérer
    Select Case TypeInfo
    Case CompanyName
        strVersionInfo = "CompanyName"
    Case FileDescription
        strVersionInfo = "FileDescription"
    Case FileVersion
        strVersionInfo = "FileVersion"
    Case InternalName
        strVersionInfo = "InternalName"
    Case LegalCopyright
        strVersionInfo = "LegalCopyright"
    Case OriginalFileName
        strVersionInfo = "OriginalFileName"
    Case ProductName
        strVersionInfo = "ProductName"
    Case ProductVersion
        strVersionInfo = "ProductVersion"
    End Select

    ' Récupère la taille
    BufferLen = GetFileVersionInfoSize(FullFileName, Dummy)
    If BufferLen < 1 Then Exit Function

    ReDim sBuffer(BufferLen)
    rc = GetFileVersionInfo(FullFileName, 0&, BufferLen, _
        sBuffer(0))
    If rc = 0 Then
        GetDescription = False
        Exit Function
    End If

    rc = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", _
                                        VerPointer, BufferLen)
    If rc = 0 Then Exit Function
    ' VerPointer est un pointeur de 4 octets de nombres hexadécimaux,
    ' Les 2 premiers octets sont les identificateurs de la langue,
    ' et les 2 derniers octets sont des pages de code
    ' Quoiqu'il en soit, Lang_Charset_String nécessite une chaine de
    ' 4 chiffres héxadécimaux,les 2 premiers caractères correspondent aux
    ' identificateur du language et les 2 derniers caractères correspondent
    ' aux identificateurs des pages de code

    MoveMemory ByteBuffer(0), VerPointer, BufferLen

    HexNumber = ByteBuffer(2) + ByteBuffer(3) * &H100 + ByteBuffer(0) * &H10000 + ByteBuffer(1) * &H1000000
    Lang_Charset_String = Hex(HexNumber)
    ' Maintenant on change l'ordre de l'identificateur du language et des pages de codes
    ' et on le converti en chaine de caractères.
    ' Par exemple on prend 040904E4
    ' En y séparant on obtient :
    ' 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
    Loop

    ' On formate la variable Buffer
    Buffer = String(255, 0)
    strTemp = "\StringFileInfo\" & Lang_Charset_String & "\" & strVersionInfo
    ' On récupère les infos qui nous interessent
    rc = VerQueryValue(sBuffer(0), strTemp, VerPointer, BufferLen)
    If rc = 0 Then Exit Function
    lstrcpy Buffer, VerPointer
    ' On se débarasse des chr(0) contenus dans Buffer
    Buffer = Mid$(Buffer, 1, InStr(Buffer, Chr(0)) - 1)
    ' On renvoie la valeur
    GetDescription = Buffer
End Function

22 novembre 2005 18:31:27 :

Ajout des mots clés

22 avril 2006 14:50:14 :

mise à jour des mots clés