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

Commentaire de zavier666 le 15/01/2007 16:58:47

Très bonne source et pratique en +, je mets 10/10

slts!!!!!
____________________________________________________
Toujours + d'API   =>  API @ la loupe
http://xav.prog.power.free.fr

Commentaire de Renfield le 16/01/2007 09:52:05 administrateur CS

tiens, violent_ken, j'ai mis a dispo une source que j'avais depuis un moment...

http://www.vbfrance.com/codes/INFOS-SUR-VIDEOS-CODECS_41133.aspx

un peu le même genre, sauf que je regarde surtout les codecs...

Commentaire de dead33 le 14/02/2007 17:44:26

bonjour

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

Commentaire de titicar le 12/07/2007 19:58:14

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