File info

Soyez le premier à donner votre avis sur cette source.

Vue 10 381 fois - Téléchargée 772 fois

Description

Voici une ptit module qui recupere presque toutes les infos d'un fichier.

Utilisation:

Dim F as FileInfo

F = GetFileInfo(Chemin_Fichier)

les info renvoyees sont:

FullPathName
FileName
Extension
ExistFile
FileSize
CompanyName
FileDescription
FileVersion
InternalName
LegalCopyright
OriginalFileName
ProductName
ProductVersion
CreationTime
LastAccessTime
LastWriteTime
FileAttribute

Source / Exemple :


Option Explicit

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long

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 Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) 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

Private Const MAX_PATH = 260

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Public Type FileInfo
    CompanyName As String
    FileDescription As String
    FileVersion As String
    ExistFile As Boolean
    InternalName As String
    LegalCopyright As String
    OriginalFileName As String
    ProductName As String
    ProductVersion As String
    FileName As String
    FullPathName As String
    Extension As String
    FileSize As String
    CreationTime As String
    LastAccessTime As String
    LastWriteTime As String
    FileAttribute As String
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private sbuffer() As Byte
Private bufferlen As Long
Private buffer As String
Private Lang_Charset As String
Private rc As Long
Private VerPointer As Long

Public Function GetFileInfo(ByVal PathFileName As String) As FileInfo
    
    Dim Dummy As Long
    Dim ByteBuffer(255) As Byte
    Dim HexNumber As Long
    Dim pos As Integer
    Dim mem As String
    Dim lenmem As Long
    Dim WFD As WIN32_FIND_DATA

    GetFileInfo.FullPathName = PathFileName
    pos = InStrRev(PathFileName, "\")
    If pos > 0 Then GetFileInfo.FileName = Right(PathFileName, Len(PathFileName) - pos)
    pos = InStrRev(PathFileName, ".")
    If pos > 0 Then GetFileInfo.Extension = Right(PathFileName, Len(PathFileName) - pos)
    GetFileInfo.ExistFile = FileExist(PathFileName)
    
    If GetFileInfo.ExistFile = False Then Exit Function
    WFD = GetWFD(PathFileName)
    
    GetFileInfo.FileAttribute = GetStrAtt(WFD.dwFileAttributes)
    GetFileInfo.FileSize = Format$(WFD.nFileSizeHigh + WFD.nFileSizeLow, "#,###,###")
    GetFileInfo.CreationTime = StrFileTime(WFD.ftCreationTime)
    GetFileInfo.LastAccessTime = StrFileTime(WFD.ftLastAccessTime)
    GetFileInfo.LastWriteTime = StrFileTime(WFD.ftLastWriteTime)

    bufferlen = GetFileVersionInfoSize(PathFileName, Dummy)
    If bufferlen < 1 Then Exit Function
    
    ReDim sbuffer(bufferlen)
    
    If GetFileVersionInfo(PathFileName, 0&, bufferlen, sbuffer(0)) = 0 Then Exit Function
    If VerQueryValue(sbuffer(0), "\VarFileInfo\Translation", VerPointer, bufferlen) = 0 Then Exit Function
  
    MoveMemory ByteBuffer(0), VerPointer, bufferlen
    HexNumber = ByteBuffer(2) + ByteBuffer(3) * &H100 + ByteBuffer(0) * &H10000 + ByteBuffer(1) * &H1000000
    Lang_Charset = Hex(HexNumber)
    
    If Len(Lang_Charset) < 8 Then Lang_Charset = String(8 - (Len(Lang_Charset)), "0") & Lang_Charset

    GetFileInfo.CompanyName = SplitInfo("CompanyName")
    GetFileInfo.FileDescription = SplitInfo("FileDescription")
    GetFileInfo.FileVersion = SplitInfo("FileVersion")
    GetFileInfo.InternalName = SplitInfo("InternalName")
    GetFileInfo.LegalCopyright = SplitInfo("LegalCopyright")
    GetFileInfo.OriginalFileName = SplitInfo("OriginalFileName")
    GetFileInfo.ProductName = SplitInfo("ProductName")
    GetFileInfo.ProductVersion = SplitInfo("ProductVersion")
    
End Function

Public Function FileExist(ByVal File As String) As Boolean
    
    FileExist = CBool(PathFileExists(File))
    
End Function

Private Function GetWFD(ByVal PathFile As String) As WIN32_FIND_DATA

    FindClose FindFirstFile(PathFile, GetWFD)

End Function

Private Function SplitInfo(StrFilter As String) As String
    
    Dim strtemp As String
    
    buffer = String(255, 0)
    strtemp = "\StringFileInfo\" & Lang_Charset & "\" & StrFilter
    If VerQueryValue(sbuffer(0), strtemp, VerPointer, bufferlen) = 0 Then Exit Function
    lstrcpy buffer, VerPointer
    SplitInfo = Left$(buffer, InStr(buffer, Chr(0)) - 1)
    
End Function

Private Function StrFileTime(Htime As FILETIME) As String

    Dim SysTime As SYSTEMTIME
    Dim LTime As FILETIME
    
    FileTimeToLocalFileTime Htime, LTime
    FileTimeToSystemTime LTime, SysTime
    StrFileTime = DateSerial(SysTime.wYear, SysTime.wMonth, SysTime.wDay) + TimeSerial(SysTime.wHour, SysTime.wMinute, SysTime.wSecond)

End Function
Private Function GetStrAtt(ByVal att As Long) As String

    Dim s As String

    If att = 128 Then GetStrAtt = "N": Exit Function
    If att = 0 Then GetStrAtt = "None": Exit Function
    If att >= 32768 Then att = att - 32768: s = "L"
    If att >= 16384 Then att = att - 16384: s = s & "E"
    If att >= 8192 Then att = att - 8192 ' Not For Index
    If att >= 4096 Then att = att - 4096: s = s & "O"
    If att >= 2048 Then att = att - 2048: s = s & "C"
    If att >= 1024 Then att = att - 1024: s = s & "R-P"
    If att >= 512 Then att = att - 512: s = s & "S-F"
    If att >= 256 Then att = att - 256: s = s & "T"
    If att >= 32 Then att = att - 32: s = s & "A"
    If att >= 16 Then att = att - 16: s = s & "D"
    If att >= 4 Then att = att - 4: s = s & "S"
    If att >= 2 Then att = att - 2: s = s & "H"
    If att >= 1 Then att = att - 1: s = s & "R"
    If att = 0 Then GetStrAtt = s Else GetStrAtt = "Erreur d'attribut"

End Function

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

blq
Messages postés
97
Date d'inscription
vendredi 22 octobre 1999
Statut
Membre
Dernière intervention
13 juin 2016
1
Bonjour,

Je viens de lire le code et les différents commentaires. A priori vous savez de quoi vous parlez. Alors j'ai essayé les 2 versions de code.

Le premier semble ne pas récupérer les infos sur les fichiers .exe, mais j'avoue ne pas avoir rechercher pourquoi.

Sur le second, il y a la déclartion VS_FIXEDFILEINFO. Quézako ?

Merci d'avance de vos réponses.
draluorg
Messages postés
625
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
25 novembre 2010

Salut Mad,

Eh bin en fait j'ai juste fais prog de listage des modules en cours pour tester mon module FileInfo dans les meme conditions que vous pour voir si ca marchait ou pas et je n'ai rencontre aucune erreur... donc apparement c'est bon...

++
MadM@tt
Messages postés
2215
Date d'inscription
mardi 11 novembre 2003
Statut
Membre
Dernière intervention
16 juillet 2009

Hey hey, je rentre de vacances alors j'ai pas pu suivre le feuilleton ^^
Alors finalement, vous l'avez encore ce bug ? Moi perso je l'ai plus (avec le code que j'ai mis en commentaire, et je peux vous l'envoyer en complet si vous voulez)
Et apparement on est tous les 3 autour des meme genres de prog lol
violent_ken
Messages postés
1822
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010

D'accord, tu créé d'abord la liste, et ENSUITE tu remplis la ListView.... Ok, j'ai compris ^_-
Parceque moi je remplis la moitié des infos sur le tas, donc on voit la ListView se remplir au fur et à mesure (d'où l'utilisation de ValidateRect pour éviter çà).

Concernant les sources, c'est vraiment sympa de me le proposer, mais je sais ce que c'est que de "nettoyer" une source pas très propre ^^ Ne te donne pas cette peine !

En tout cas, merci beaucoup, @+
draluorg
Messages postés
625
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
25 novembre 2010

<toutes les lignes de texte apparaissent en même temps (composant vierge, puis plein d'un coup) et non à la suite ? Comment as tu fait ?>

Eh en fait j'ai cree une fonction qui me renvoi un tableau avec tous les fileInfo de chaque modules (exe ou dll) et puis j'ajoute tout a la lsite d'un coup...(enfin en une boucle)

Je te filerais bien les sources, mais la elles sont a l'etat de brouillons, donc c'est le bordel, si tu veux je nettoie un peu ca et je te file les sources ?

++

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.