Récupérer une information sur un fichier executable (exe, dll...) de type : Description, Version du fichier, Nom interne, Copyright, Nom du fichier d'origine, Entreprise, Nom du produit, Version du produit


Propriétés du code


Date de création : 28/12/2006 à 21:44:00
9 Commentaire(s)
  MadMatt

 

Présentation


Voilà, comme dit cette fonction permet de récupérer les infos suivantes :
- Description
- Version du fichier
- Nom interne
- Copyright
- Nom du fichier d'origine
- Entreprise
- Nom du produit
- Version du produit
pour un fichier executable, donc de type .exe, .dll etc.....

Ce sont les meme infos que l'ont peut retrouver dans l'explorateur, en ouvrant les propriétés d'un fichier et en allant dans l'onglet "Version".

 

Code


' Pour récupérer des infos sur les fichiers
Public 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
Public Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Public Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Public 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

' Le type FileVersionInfos
Public Type FileVersionInfos
    FileVersion As String
    FileDescription As String
    CompanyName As String
    InternalName As String
    Copyright As String
    OriginalFileName As String
    ProductName As String
    ProductVersion As String
End Type




'---------------------------------------------------------------------------------------
' Procedure : GetFileVersionInfos
' DateTime  : 28/12/2006 22:13
' Author    : Vb System Library
' Purpose  : Récupérer une information sur un fichier
' Params    :  sFileName : Chemin d'accès au fichier
'              Renvoie un type FileVersionInfos
'---------------------------------------------------------------------------------------
Public Function GetFileVersionInfos(ByVal sFileName As String) As FileVersionInfos
   
    Dim Vffi As VS_FIXEDFILEINFO  ' version info structure
    Dim Buffer() As Byte          ' buffer for info ressource
    Dim pData As Long            ' pointer to info data
    Dim lDataLen As Long          ' length of info pointed at by pData
    Dim cpl(0 To 3) As Byte      ' buffer for code page & language
    Dim cplstr As String          ' 8-digit hex string of cpl
    Dim strVersionInfo As String
    ' Prépare la structure
    GetFileVersionInfos.CompanyName = ""
    GetFileVersionInfos.Copyright = ""
    GetFileVersionInfos.FileDescription = ""
    GetFileVersionInfos.FileVersion = ""
    GetFileVersionInfos.InternalName = ""
    GetFileVersionInfos.OriginalFileName = ""
    GetFileVersionInfos.ProductName = ""
    GetFileVersionInfos.ProductVersion = ""
    ' Contrôle si le fichier contient des informations récupérables
    lDataLen = GetFileVersionInfoSize(sFileName, pData)
    If lDataLen = 0 Then
        Exit Function
    End If
    ReDim Buffer(0 To lDataLen - 1) As Byte
    ' Get the version information resource.
    If GetFileVersionInfo(sFileName, 0, lDataLen, Buffer(0)) <> 0 Then
        ' Get a pointer to a structure that holds a bunch of data.
        If VerQueryValue(Buffer(0), "\", pData, lDataLen) <> 0 Then
            ' Copy that structure into the one we can access.
            MoveMemory Vffi, ByVal pData, lDataLen
            ' ---------------------------------------
            ' Récupération de la version du fichier
            GetFileVersionInfos.FileVersion = Trim(Str(HIWORD(Vffi.dwFileVersionMS))) & "." & _
                                            Trim(Str(LOWORD(Vffi.dwFileVersionMS))) & "." & _
                                            Trim(Str(HIWORD(Vffi.dwFileVersionLS))) & "." & _
                                            Trim(Str(LOWORD(Vffi.dwFileVersionLS)))
            ' Récupération du code page et du langage
            If VerQueryValue(Buffer(0), "\VarFileInfo\Translation", pData, lDataLen) <> 0 Then
                ' Copy that information into the byte array.
                MoveMemory cpl(0), ByVal pData, 4
                ' Convert those four bytes into a 8-digit hexadecimal string.
                cplstr = FixedHex(cpl(1), 2) & FixedHex(cpl(0), 2) & FixedHex(cpl(3), 2) & FixedHex(cpl(2), 2)
                ' cplstr contient maintenant le code page et le langage
                ' ---------------------------------------
                ' Récupération des autres infos
                strVersionInfo = "CompanyName"
                If VerQueryValue(Buffer(0), "\StringFileInfo\" & cplstr & "\" & strVersionInfo, pData, lDataLen) <> 0 Then
                        If lDataLen > 0 Then lDataLen = lDataLen - 1
                        GetFileVersionInfos.CompanyName = Space(lDataLen)
                        lstrcpy GetFileVersionInfos.CompanyName, pData
                End If
                strVersionInfo = "FileDescription"
                If VerQueryValue(Buffer(0), "\StringFileInfo\" & cplstr & "\" & strVersionInfo, pData, lDataLen) <> 0 Then
                        If lDataLen > 0 Then lDataLen = lDataLen - 1
                        GetFileVersionInfos.FileDescription = Space(lDataLen)
                        lstrcpy GetFileVersionInfos.FileDescription, pData
                End If
                strVersionInfo = "FileVersion"
                If VerQueryValue(Buffer(0), "\StringFileInfo\" & cplstr & "\" & strVersionInfo, pData, lDataLen) <> 0 Then
                        If lDataLen > 0 Then lDataLen = lDataLen - 1
                        GetFileVersionInfos.FileVersion = Space(lDataLen)
                        lstrcpy GetFileVersionInfos.FileVersion, pData
                End If
                strVersionInfo = "InternalName"
                If VerQueryValue(Buffer(0), "\StringFileInfo\" & cplstr & "\" & strVersionInfo, pData, lDataLen) <> 0 Then
                        If lDataLen > 0 Then lDataLen = lDataLen - 1
                        GetFileVersionInfos.InternalName = Space(lDataLen)
                        lstrcpy GetFileVersionInfos.InternalName, pData
                End If
                strVersionInfo = "LegalCopyright"
                If VerQueryValue(Buffer(0), "\StringFileInfo\" & cplstr & "\" & strVersionInfo, pData, lDataLen) <> 0 Then
                        If lDataLen > 0 Then lDataLen = lDataLen - 1
                        GetFileVersionInfos.Copyright = Space(lDataLen)
                        lstrcpy GetFileVersionInfos.Copyright, pData
                End If
                strVersionInfo = "OriginalFileName"
                If VerQueryValue(Buffer(0), "\StringFileInfo\" & cplstr & "\" & strVersionInfo, pData, lDataLen) <> 0 Then
                        If lDataLen > 0 Then lDataLen = lDataLen - 1
                        GetFileVersionInfos.OriginalFileName = Space(lDataLen)
                        lstrcpy GetFileVersionInfos.OriginalFileName, pData
                End If
                strVersionInfo = "ProductName"
                If VerQueryValue(Buffer(0), "\StringFileInfo\" & cplstr & "\" & strVersionInfo, pData, lDataLen) <> 0 Then
                        If lDataLen > 0 Then lDataLen = lDataLen - 1
                        GetFileVersionInfos.ProductName = Space$(lDataLen)
                        lstrcpy GetFileVersionInfos.ProductName, pData
                End If
                strVersionInfo = "ProductVersion"
                If VerQueryValue(Buffer(0), "\StringFileInfo\" & cplstr & "\" & strVersionInfo, pData, lDataLen) <> 0 Then
                        If lDataLen > 0 Then lDataLen = lDataLen - 1
                        GetFileVersionInfos.ProductVersion = Space(lDataLen)
                        lstrcpy GetFileVersionInfos.ProductVersion, pData
                End If
            End If
        End If
    End If
End Function
' Creation d'une chaine Hexadecimale pour représenter un nombre
Private Function FixedHex(ByVal hexval As Long, ByVal nDigits As Long) As String
        FixedHex = Right("00000000" & Hex(hexval), nDigits)
End Function
Private Function HIWORD(ByVal dwValue As Long) As Long
        Dim hexstr As String
        hexstr = Right("00000000" & Hex(dwValue), 8)
        HIWORD = CLng("&H" & Left(hexstr, 4))
End Function
Private Function LOWORD(ByVal dwValue As Long) As Long
        Dim hexstr As String
        hexstr = Right("00000000" & Hex(dwValue), 8)
        LOWORD = CLng("&H" & Right(hexstr, 4))
End Function


 

Historique


Voici l'historique des modifications de ce code :
28/12/2006 : Changement de la fonction
Le 30/12/2006 par MadMatt : Optimisation
Le 11/04/2007 par MadMatt : Résolution dun bug
Le 21/04/2007 par MadMatt : Le code était coupé

 
 

Modifier le code

Seul les admins et l'auteur du code lui même peuvent modifier ce code.

 

Commentaires


De MadMatt le 28/12/2006 à 21:45


Je modifierai bientot le nom de la fonction "mfGetFileInfo", je pense la renommer en "GetFileVersionInfo"

qu'en pensez vous ?
a+

 

De MadMatt le 28/12/2006 à 21:49


arf chu bete, c'est le nom de l'api.
"GetFileVersionInfos" alors ?

 

De MadMatt le 28/12/2006 à 22:15


voilà c'est fait, maintenant on peut récupérer toutes les infos sur le fichier d'un coup.

 

De sebdraluorg le 29/12/2006 à 13:22


Yep interessant, ce serait bien d'en faire une classe aussi et d'ajouter des proprietes genre "Exist", "Path", "icon", "CreateTime" etc...

Un peu comme la classe FileInfo en .Net

++

 

De MadMatt le 29/12/2006 à 15:09


Exactement, je comptais la commencer ces vacances. C'est pour ça que je commençais à ajouter des fonctions sur les fichiers, parce que la classe ne fait que regrouper des fonctions après tout, donc si toi aussi tu en as n'hésite pas à les poster

 

De violent_ken le 20/04/2007 à 19:18


Arf, j'arrive après la bataille, mais :

"arf chu bete, c'est le nom de l'api." ==> on peut envisager de changer le nom de l'API et d'utiliser un Alias qui aura le nom réel de la fonction de l'API.

@+

 

De violent_ken le 20/04/2007 à 19:20


Euh, ERF ! Il manque un bout du code à la fin !

 

De MadMatt le 21/04/2007 à 00:20


Pour le nom de la fonction effectivement j'aurais pu faire ça, j'y avais pas pensé et pourtant j'ai fait ça sur une autre source. Mais le "s" à la fin je trouve ça plus cohérent au final, car on renvoie une structure qui contient plusieurs infos, et non pas une seule. Mais à voir

Sinon pour le code dont il manque un bout, effectivement lol, et ça me fait peur car j'ai du mal à voir d'où ça vient... Je regarde ça au plus vite, merci d'y avoir remarqué ;)

 

De MadMatt le 21/04/2007 à 00:48


Bon pour le code coupé, j'ai rien trouvé de semblable, dans les sauvegardes que j'avais fait en local, y'a pas ce problème, et j'ai essayé de modifier le code, optimiser la table et tout en local, mais j'ai pas réussi à reproduire le bug. Je pense que j'avais du me gouré en faisant le copier coller de VB6 à firefox, car il y'a des codes plus long sur le sites et pas de problèmes avec eux.
@+

 

Ajouter un commentaire


Vous devez être connecté pour pouvoir poster un commentaire.

 
 

Valid HTML 4.01 Transitional Valid CSS

Site web de Vb System Library version 1.3
Developpement et design réalisé par : Matthieu Napoli (MadMatt)
© 2007 Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
Temps d'execution de la page : 0.013 s
www.mnapoli.fr