Récupérer la description d'un executable + autres informations (date, version, company, copyright, etc...)

Contenu du snippet

Voilà j'ai cherché une nuit entière pour trouver ça, et encore c'était pas commenté sauf quelques passages en anglais. Alors comme il n'y a pas de source qui ne fait que ça et qui est bien claire pour tout le monde, je la met donc, en espérant que ça vous serve comme à moi.

Source / Exemple :


' ------------------------------------------------------------------
' 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

Conclusion :


Par contre j'ai traduit les passages en anglais comme j'ai pu, je ne suis qu'un modeste lycéen qu'a des devoirs en plus grrrr, donc désolé si j'ai écorché quelque chose
Et puis je précise aussi que ce code n'est pas de moi à l'origine, j'ai fait le maximum pour qu'il soit plus clair et plus lisible, et facilement exploitable par tous, sans passer par des classes et tout... donc ne venez pas m'embeter avec ça je suis au courant que je n'en suis pas l'auteur ;)

allé que cela vous serve
@ +
MadMatt

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.