CLASSES POUR RECUPERER DES INFOS SUR LES FICHIERS BMP,GIF,PNG,JPG,AVI,MP3

Signaler
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
-
Messages postés
181
Date d'inscription
jeudi 30 mai 2002
Statut
Membre
Dernière intervention
19 août 2012
-
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/41104-classes-pour-recuperer-des-infos-sur-les-fichiers-bmp-gif-png-jpg-avi-mp3

Messages postés
181
Date d'inscription
jeudi 30 mai 2002
Statut
Membre
Dernière intervention
19 août 2012

Dommage qu'il n'y ait pas plus de commentaires sur cette source pourtant utile, même si l'on est pas obligé de tout prendre.

Toujours concernant la dimension d'un JPEG, j'ai été confronté à une autre erreur, encore due à une image 'incorrecte'.
Dans la procédure GetImageInfos(), il y a la ligne suivante:
If lPos >= lngSize - 10 Then Exit Sub
Le 'exit sub' est mal employé car le fichier image a déjà été ouvert (Open sFile...) et n'est pas refermé.
Il faut remplacer cette ligne par:
If lPos >= lngSize - 10 Then GoTo ErrGestion 'Faut refermer ce fichier déjà ouvert
car l'étiquette ErrGestion referme ce fichier image (Close #lFile).

Mais pour les curieux, faut préciser que la procédure fonctionne trés bien pour des images 'correctes'.
Messages postés
181
Date d'inscription
jeudi 30 mai 2002
Statut
Membre
Dernière intervention
19 août 2012

Merci à toi. En ce qui me concerne, c'est la dimension d'un JPEG qui m'intéresse... Même si j'ai du mal à comprendre le code.
Par contre, j'ai une image JPG qui a fait planter ton code au niveau de GetImageInfos() lié à BEWord(position). J'ai donc très légèrement modifié le code comme suit:
(le résultat donne simplement une dimension nulle et évite le plantage dans ce cas particulier)

'---------------------------------------------
GetImageInfos():
'---------------------------------------------
Public Sub GetImageInfos()
Dim i As Long
Dim lFile As Long
Dim lngWidth As Long
Dim lngHeight As Long
Dim tType As IMAGE_EXTENSION_TYPE
Dim lngSize As Long
Dim bDimNotFound As Boolean 'titicar

On Local Error GoTo ErrGestion

'par défaut
lngWidth = 0
lngHeight = 0
tType = lUNKNOWN

'ouverture du fichier en lecture binaire
lFile = FreeFile
Open sFile For Binary Access Read As #lFile

lngSize = LOF(lFile)
ReDim bytBuffer(lngSize) 'dimensionne à la taille du fichier

'récupère le buffer
Get #lFile, 1, bytBuffer()

'vérifie le header ==> PNG
If bytBuffer(0) 137 And bytBuffer(1) 80 And bytBuffer(2) = 78 Then
tType = lPNG
lngWidth = BEWord(18)
lngHeight = BEWord(22)
End If
'vérifie le header ==> GIF
If bytBuffer(0) 71 And bytBuffer(1) 73 And bytBuffer(2) = 70 Then
tType = lGIF
lngWidth = LEWord(6)
lngHeight = LEWord(8)
End If
'vérifie le header ==> BMP
If bytBuffer(0) 66 And bytBuffer(1) 77 Then
tType = lBMP
lngWidth = LEWord(18)
lngHeight = LEWord(22)
End If
'vérifie le header ==> JPG
If tType = lUNKNOWN Then
'rien de particulier à dire, on tritouille les bytes à la recherche des infos
'bloc de fonctions trouvé sur le net, mais je ne sais plus où -__-'
Dim lPos As Long
Do
If (bytBuffer(lPos) &HFF And bytBuffer(lPos + 1) &HD8 And bytBuffer(lPos + 2) = &HFF) _
Or (lPos >= lngSize - 10) Then Exit Do
lPos = lPos + 1
Loop
lPos = lPos + 2
If lPos >= lngSize - 10 Then Exit Sub
Do
Do
If bytBuffer(lPos) = &HFF And bytBuffer(lPos + 1) <> &HFF Then Exit Do
lPos = lPos + 1
If lPos >= lngSize - 10 Then Exit Sub
Loop
lPos = lPos + 1
If (bytBuffer(lPos) >= &HC0) And (bytBuffer(lPos) <= &HC3) Then Exit Do
lPos = lPos + BEWord(lPos + 1)
If lPos >= lngSize - 10 Then Exit Sub
If lPos < 0 Then 'titicar
bDimNotFound = True 'titicar
Exit Do 'titicar
End If 'titicar
Loop
tType = lJPG
If bDimNotFound = False Then 'titicar
lngHeight = BEWord(lPos + 4)
lngWidth = BEWord(lPos + 6)
End If 'titicar
End If

'affectation des valeurs aux variables publiques de la classe
Me.lHeight = lngHeight
Me.lWidth = lngWidth
Me.sType = ImageType2String(tType)

ErrGestion:

'vide le tableau (buffer)
ReDim bytBuffer(0)
'referme le fichier
Close #lFile
End Sub

'---------------------------------------------
BEWord(position):
'---------------------------------------------
Private Function BEWord(position As Long) As Long
Dim x1 As WordBytes
Dim x2 As WordWrapper
x1.byte1 = bytBuffer(position + 1)
x1.byte2 = bytBuffer(position)
LSet x2 = x1
BEWord = x2.Value
'titicar: _
S'il y a un défaut dans le fichier image, il peut arriver que x2.value soit INFERIEUR à Zéro, _
ce qui est théoriquement impossible (j'ai un JPG avec ce problème). _
On fait donc ce test, sinon le programme passe dans une boucle sans fin, et donc plantage. _
Après quoi, dans la procédure appelante, il faut tester si la valeur final BEWord (dans notre cas, _
associé à position) est <0, et réagir en conséquence, ce qui est fait dans GetImageInfos(). _
Libre à chacun d'ajouter une nouvelle propriété du genre ImageNonValide dans cette classe.
If BEWord < 0 Then BEWord = -position - 1 'Pour être sûr que le résultat soit négatif dans GetImageInfos()'titicar
End Function
Messages postés
1812
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
1
Salut, merci pour le commentaire.

Moi personnellement je n'ai rien codé pour changer les tags, mais je te conseille cette source :
http://www.vbfrance.com/codes/YOMMMP3TAG-V2-EDITEUR-TAGV1-V2-V2-POUR-MP3_24252.aspx

@+
Messages postés
29
Date d'inscription
vendredi 31 mars 2006
Statut
Membre
Dernière intervention
4 décembre 2007

bonjour

bravo pour cette source.
- est-ce-que tu n'a pas un code pour retager les mp3
a+
Afficher les 9 commentaires