Vb6: récupérer simplement les informations d'un fichier

Soyez le premier à donner votre avis sur cette source.

Vue 7 624 fois - Téléchargée 845 fois

Description

Salut à tous.

J'ai reprise un code existant déja très bien structuré.
J'en ai besoin et j'ai trouvé que c'etait un peu le fouillie !
Alors, je l'ai refait a ma manière.

Simple et Pratique, il ne faut pas se poser de question :)
Vous avez besoin d'informations sur un fichier, voila la solution en 5 opérations:

1) Inclure la classe a son projet
2) Créer un nouveau module
3) Couper/Coller le bout de code en haut du header de la classe dans le module
4) Faire un jolie bouton [TEST] avec un control picturebox
5) Cliquetez et c'est gagné ^^

Conclusion :


Tout est expliqué dans la Class.
Ca reste quand même de la re-pompe, alors soyez indulegent !
C'est pour le débutant qui veux des informations, c'est tout.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
12
Effectivement, parfait comme explication.
A+
Exploreur
Messages postés
550
Date d'inscription
jeudi 12 octobre 2006
Statut
Membre
Dernière intervention
6 juin 2015
3
Excellent !
Messages postés
168
Date d'inscription
vendredi 9 janvier 2004
Statut
Membre
Dernière intervention
28 juillet 2009
1
Pour info, j'utilise le code ci-dessous (glané sur Internet). Peut-être te donnera-t'il des idées...


' -------------------------------------------------
'
' Used by the GetFileInfo function
'
' -------------------------------------------------

Private Function GetWFD(ByVal PathFile As String) As WIN32_FIND_DATA
FindClose FindFirstFile(PathFile, GetWFD)
End Function

' -------------------------------------------------
'
' Used by the GetFileInfo 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

' -------------------------------------------------
'
' Used by the GetFileInfo 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

' -------------------------------------------------
'
' Used by the GetFileInfo function
'
' -------------------------------------------------

Private Function SplitInfo(ByVal 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

' -------------------------------------------------
'
' GetFileInfo ask a valid filename and will return his version number, his extension, ...
'
' -------------------------------------------------

Public Function ZGetFileInfo(ByVal sFileName As String) As FileInfo

'http://www.vbfrance.com/codes/FILE-INFO_39252.aspx

Dim Dummy As Long
Dim ByteBuffer(255) As Byte
Dim I As Byte
Dim arrVersion As Variant
Dim HexNumber As Long
Dim pos As Integer
Dim mem As String
Dim lenmem As Long
Dim WFD As WIN32_FIND_DATA
Dim sTemp As String

On Error GoTo ErrHandler

ZGetFileInfo.FullPathName = sFileName
pos = InStrRev(sFileName, "")

If pos > 0 Then ZGetFileInfo.FileName = Right(sFileName, Len(sFileName) - pos)
pos = InStrRev(sFileName, ".")

If pos > 0 Then ZGetFileInfo.Extension = Right(sFileName, Len(sFileName) - pos)

ZGetFileInfo.ExistFile = ZFileExists(sFileName)

If ZGetFileInfo.ExistFile = False Then Exit Function

WFD = GetWFD(sFileName)

ZGetFileInfo.FileAttribute = GetStrAtt(WFD.dwFileAttributes)
ZGetFileInfo.FileSize = Format$(WFD.nFileSizeHigh + WFD.nFileSizeLow, "#,###,###")
ZGetFileInfo.CreationTime = StrFileTime(WFD.ftCreationTime)
ZGetFileInfo.LastAccessTime = StrFileTime(WFD.ftLastAccessTime)
ZGetFileInfo.LastWriteTime = StrFileTime(WFD.ftLastWriteTime)

bufferlen = GetFileVersionInfoSize(sFileName, Dummy)
If bufferlen < 1 Then Exit Function

ReDim sbuffer(bufferlen)

If GetFileVersionInfo(sFileName, 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

ZGetFileInfo.CompanyName = SplitInfo("CompanyName")
ZGetFileInfo.FileDescription = SplitInfo("FileDescription")
ZGetFileInfo.InternalName = SplitInfo("InternalName")
ZGetFileInfo.LegalCopyright = SplitInfo("LegalCopyright")
ZGetFileInfo.OriginalFileName = SplitInfo("OriginalFileName")
ZGetFileInfo.ProductName = SplitInfo("ProductName")

' Get the file version. Sometimes, the file version can be 2.00.002. The code below will remove preceding
' zeros so 2.00.002 will be transform into 2.0.2

sTemp = SplitInfo("FileVersion")

If (sTemp <> "") And Not (sTemp = vbNullString) Then

arrVersion = Split(sTemp, ".")

sTemp = vbNullString

For I = 0 To UBound(arrVersion)
sTemp = sTemp & CLng(arrVersion(I)) & "."
Next

If Not sTemp = vbNullString Then
ZGetFileInfo.FileVersion = Left(sTemp, Len(sTemp) - 1)
Else
ZGetFileInfo.FileVersion = vbNullString
End If

sTemp = SplitInfo("ProductVersion")

If (sTemp <> "") And Not (sTemp = vbNullString) Then

arrVersion = Split(sTemp, ".")
sTemp = vbNullString

For I = 0 To UBound(arrVersion)
sTemp = sTemp & CLng(arrVersion(I)) & "."
Next

If Not sTemp = vbNullString Then
ZGetFileInfo.ProductVersion = Left(sTemp, Len(sTemp) - 1)
Else
ZGetFileInfo.ProductVersion = vbNullString
End If

Else

ZGetFileInfo.ProductVersion = vbNullString

End If

Else

ZGetFileInfo.FileVersion = vbNullString
ZGetFileInfo.ProductVersion = vbNullString

End If

On Error GoTo 0

Exit Function

ErrHandler:

Msgbox Err.Number & ": " & Err.Description,
On Error GoTo 0

End Function

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.