FILE INFO
draluorg
Messages postés
625
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
25 novembre 2010
-
24 août 2006 à 14:11
blq Messages postés 97 Date d'inscription vendredi 22 octobre 1999 Statut Membre Dernière intervention 13 juin 2016 - 1 août 2007 à 11:51
blq Messages postés 97 Date d'inscription vendredi 22 octobre 1999 Statut Membre Dernière intervention 13 juin 2016 - 1 août 2007 à 11:51
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/39252-file-info
https://codes-sources.commentcamarche.net/source/39252-file-info
24 août 2006 à 14:11
++
24 août 2006 à 18:29
par contre en utilisant (ma source) un peu intensivement dans d'autres prog que j'ai fait, je me suis rendu compte qu'à la ligne :
HexNumber = ByteBuffer(2) + ByteBuffer(3) * &H100 + ByteBuffer(0) * &H10000 + ByteBuffer(1) * &H1000000
ça plantait : overflow
à mon avis c'est juste que le calcul dépasse les limites de vb (mais pas le résultat),donc en gros la méthode de calcul ne doit pas etre parfaite.
Voici donc la source que j'utilise à présent :
' Récupérer une information sur un fichier
Public Function mfGetFileInfo(ByVal sFileName As String, FileInfo As mfFileInfo) As String
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
' Contrôle si le fichier contient des informations récupérables
lDataLen = GetFileVersionInfoSize(sFileName, pData)
If lDataLen = 0 Then
mfGetFileInfo = ""
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
Select Case FileInfo
' ---------------------------------------
' Récupération de la 'Version' du fichier
Case FileVersion
' Display the full version number of the file.
mfGetFileInfo = Trim(Str(HIWORD(Vffi.dwFileVersionMS))) & "." & _
Trim(Str(LOWORD(Vffi.dwFileVersionMS))) & "." & _
Trim(Str(HIWORD(Vffi.dwFileVersionLS))) & "." & _
Trim(Str(LOWORD(Vffi.dwFileVersionLS)))
' ---------------------------------------
' Récupération des autres infos
Case Else
' L'info à récupérer
Select Case FileInfo
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
' Before reading any strings out of the resource, we must first determine the code page
' and language. The code to get this information follows.
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 now represents the code page and language to read strings as.
' Read the copyright information from the version info resource.
If VerQueryValue(Buffer(0), "\StringFileInfo" & cplstr & "" & strVersionInfo, pData, lDataLen) <> 0 Then
' Copy that data into a string for display.
mfGetFileInfo = Space(lDataLen)
lstrcpy mfGetFileInfo, pData
End If
End If
End Select
End If
End If
End Function
' Creation d'une chaine Hexadecimale pour représenter un nombre
Public 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
(désolé pour la longueur du commentaire)
24 août 2006 à 20:33
Merci pour l'info ;)
Perso j'ai scanner quelques fois mes 5 disk je n'ai rencontrer aucun prob...
Enfait c'est la seul partie du code que j'ai recopier tel quel par flemme de me pencher dessus...
Sais tu sur quel genre de fichier tu recontrais ces erreurs ?
Ou bien ca se produisait "aleatoirement" ?
++
24 août 2006 à 21:22
C'était vraiment aléatoire, en fait c'est apparut au bout d'un certain temps d'utilisation, après avoir re-compilé et lancé plusieurs fois le prog en plein developpement.
Et le reboot n'y changait rien
Vu qu'il sagissait d'un overflow, ça devait etre le dernier terme du calcul : "ByteBuffer(1) * &H1000000" qui devait poser problème (le bug apparaissait dès que ByteBuffer(1) dépassait environ 100)
ça devait multiplier 100 par 16777216 (conversion de la valeur hexa), donc faire un trop gros nombre pour vb. Enfin je pense.
En fait ça a toujours bien marché pendant des années, jusqu'à ce qu'un jour ça ne marche plus... Et en attendant quelques temps, ça remarche... puis ça remarche plus... puis la ton prog marche (et mon ancienne source aussi)
C'est à perdre la boule, mais je suis de plus en plus convaincu que le problème doit venir de chez moi
24 août 2006 à 22:09
ok, je vais attendre de voir si je rencontre l'erreur, et dans ce cas je verrais ce que je peux faire...
Merci pour les infos ;)
++