Mp3 id3 tag v1 et v2 reader

Soyez le premier à donner votre avis sur cette source.

Vue 10 661 fois - Téléchargée 921 fois

Description

Voici un module unique (à la date du post) permettant de lire les tags des fichiers MP3 v1 ET v2!!!! Pour ceux qui connaissent pas, la version 2 de l'ID3 permet de mettre des titres/artistes plus long et d'avoir plus d'information sur un MP3 (auteur du fichier, logiciel utilisé pour la compression, etc).Dans le zip, il y a un p'tit programme pour tester le module. Enfin, vous pouvez aller sur mon site www.multimania.com/grdbest si vous voulez un programme complet (SeekMP3) l'utilisant. Le code n'est pas commenté et ne prend en charge que l'artiste, l'album, le titre, le genre, la date et le commentaire (tout comme id3v1, c vrai). Il y a encore du travail à faire sur le module, mais il est déjà opérationnel.

Source / Exemple :


Option Explicit
Option Base 1
Private Type CLASS_ID3_Tag
    Titre As String * 30
    Artiste As String * 30
    Album As String * 30
    Année As String * 4
    Commentaire As String * 30
    Genre As Byte
End Type

Public Type CLASS_CORRECTED_ID3_Tag
    Titre As String
    Artiste As String
    Album As String
    Année As String
    Commentaire As String
    Genre As Byte
    ID3Version As String
End Type

Function GetMP3Tag(Fichier As String) As CLASS_CORRECTED_ID3_Tag
    Dim FreeSlot As Integer
    Dim Lect As String * 3
    Dim ID3TagReaded As CLASS_ID3_Tag
    Dim Id3Header(7) As Byte
    Dim Id3TagSize As Long
    Dim BitMapTemp() As Byte
    Dim BitMap() As Byte
    Dim Compteur As Integer
    Dim Compteur2 As Integer
    Dim Index As Byte
    Dim ExtendedHeader As Boolean
    
    Dim CurIndex As Long
    Dim strTemp As String
    'frame header
    Dim FrameID As String * 4
    Dim FrameSize As Long
    Dim FrameFlags As Integer
    
    FreeSlot = FreeFile
    Open Fichier For Binary As FreeSlot
    Get FreeSlot, 1, Lect
    If Lect = "ID3" Then
        'juste la premiere version, qui englobe
        'à peut pret tout
        GetMP3Tag.ID3Version = "v2.1"
        Get FreeSlot, 4, Id3Header
        If Id3Header(1) = 3 Then
            If Id3Header(3) And 128 Then
                ' Unsynchronisation
            End If
            If Id3Header(3) And 64 Then
                'Extended header
                ExtendedHeader = True
            End If
            If Id3Header(3) And 32 Then
                'Experimental indicator
            End If
            If Id3Header(3) And 31 Then
                'doivent être 0!!!
            End If
'            '***** TEST
'            Id3Header(4) = 0
'            Id3Header(5) = 0
'            Id3Header(6) = 2
'            Id3Header(7) = 1
'            '***** TEST
            For Compteur = 7 To 4 Step -1
                DecToBin Id3Header(Compteur), BitMapTemp()
                Debug.Assert Not (BitMapTemp(7))
                ReDim Preserve BitMapTemp(0 To UBound(BitMapTemp()) - 1)
                For Compteur2 = 0 To UBound(BitMapTemp())
                    ReDim Preserve BitMap(0 To Index + UBound(BitMapTemp()))
                    BitMap(Index + Compteur2) = BitMapTemp(Compteur2)
                Next Compteur2
                Index = Index + UBound(BitMapTemp()) + 1
            Next Compteur
            BinToDec BitMap, Id3TagSize
            If ExtendedHeader Then
                'TODO: Passer le tag extensed
            End If
            CurIndex = 11
            Do While CurIndex < Id3TagSize
                Get FreeSlot, CurIndex, FrameID
                'si je suis HexWorkShop, les 4 octets sont codé "à l'envers, big endian(motorola),ché pas koi"!!
                'donc, c'est galère, il faut que j'inverse les octets entre eux
                
                Get FreeSlot, CurIndex + 4, FrameSize
                DecToBin FrameSize, BitMapTemp()
                ReDim BitMap(0 To UBound(BitMapTemp))
                For Compteur = 0 To 31 Step 8
                    'BitMap(Compteur) = BitMapTemp(23 - Compteur)
                    For Compteur2 = 0 To 7
                        BitMap(Compteur + Compteur2) = BitMapTemp(24 - Compteur + Compteur2)
                    Next Compteur2
                Next
                BinToDec BitMap(), FrameSize
                Get FreeSlot, CurIndex + 8, FrameFlags
                CurIndex = CurIndex + 4 + 4 + 2
                If FrameID <> String(4, Chr(0)) Then
                    strTemp = String(FrameSize - 1, " ")
                    Get FreeSlot, CurIndex + 1, strTemp
                    Debug.Print FrameID
                    Debug.Print strTemp
                End If
                
                Select Case FrameID
                    Case "TALB"
                        strTemp = String(FrameSize - 1, " ")
                        Get FreeSlot, CurIndex + 1, strTemp
                        GetMP3Tag.Album = Trim(strTemp)
                    Case "TIT2"
                        strTemp = String(FrameSize - 1, " ")
                        Get FreeSlot, CurIndex + 1, strTemp
                        GetMP3Tag.Titre = Trim(strTemp)
                    Case "TPE1"
                        strTemp = String(FrameSize - 1, " ")
                        Get FreeSlot, CurIndex + 1, strTemp
                        GetMP3Tag.Artiste = Trim(strTemp)
                    Case "TPE4"
                        strTemp = String(FrameSize - 1, " ")
                        Get FreeSlot, CurIndex + 1, strTemp
                        GetMP3Tag.Artiste = Trim(strTemp)
                    Case "COMM"
                        strTemp = String(FrameSize - 1, " ")
                        Get FreeSlot, CurIndex + 1, strTemp
                        GetMP3Tag.Commentaire = Trim(Replace(strTemp, Chr(0), Chr(32)))
                    Case "TCON"
                        strTemp = String(FrameSize - 1, " ")
                        Get FreeSlot, CurIndex + 1, strTemp
                        'GetMP3Tag.Genre = Trim(strTemp) type incompatible
                    Case "TYER"
                        strTemp = String(FrameSize - 1, " ")
                        Get FreeSlot, CurIndex + 1, strTemp
                        GetMP3Tag.Année = Trim(strTemp)
                        
                    Case Else
                        'MsgBox FrameID
                End Select
                CurIndex = CurIndex + FrameSize
            Loop
        End If
    Else
    'la version "banale" du tag
    GetMP3Tag.ID3Version = "v1"
    Get FreeSlot, (LOF(FreeSlot) - 127), Lect
    If UCase(Lect) = "TAG" Then
        Get FreeSlot, (LOF(FreeSlot) - 124), ID3TagReaded
        GetMP3Tag.Titre = RectifieTexte(ID3TagReaded.Titre)
        GetMP3Tag.Artiste = RectifieTexte(ID3TagReaded.Artiste)
        GetMP3Tag.Album = RectifieTexte(ID3TagReaded.Album)
        GetMP3Tag.Année = RectifieTexte(ID3TagReaded.Année)
        GetMP3Tag.Commentaire = RectifieTexte(ID3TagReaded.Commentaire)
        GetMP3Tag.Genre = ID3TagReaded.Genre
    End If
    End If
    Close FreeSlot
End Function

Public Sub ExtractID3TagFromFileName(ByVal FileName As String, ByRef Titre As String, ByRef Artiste As String, ByRef Album As String)
    
    Dim intIndexTiret As Integer
    Dim intLastFound As Integer
    Dim intNbFound As Integer
    Dim strFound() As String
    
    
    intIndexTiret = InStr(1, FileName, ".")
    Do While intIndexTiret <> 0
        intLastFound = intIndexTiret
        intIndexTiret = InStr(intIndexTiret + 1, FileName, ".")
    Loop
    
    FileName = Left(FileName, intLastFound - 1) & "-"
    
    'Dim intIndexLBracket As Integer
    'Dim intIndexRBracket As Integer
    
    
    'intIndexLBracket = InStr(1, FileName, "[")
    'If intIndexLBracket <> 0 Then
    '    intIndexRBracket = InStr(intIndexLBracket + 2, FileName, "]")
    '    If intIndexRBracket <> 0 Then
    
    intLastFound = 1
    intIndexTiret = InStr(intLastFound, FileName, "-")
    Do While intIndexTiret <> 0
        intNbFound = intNbFound + 1
        ReDim Preserve strFound(1 To intNbFound)
        strFound(intNbFound) = Mid(FileName, intLastFound, intIndexTiret - intLastFound)
        intLastFound = intIndexTiret + 1
        intIndexTiret = InStr(intLastFound + 1, FileName, "-")
    Loop
    For intIndexTiret = 1 To intNbFound
        If intIndexTiret = intNbFound Then
            If Titre = "" Then Titre = Trim(strFound(intIndexTiret))
        Else
            Select Case intIndexTiret
                Case 1
                    If Artiste = "" Then Artiste = Trim(strFound(intIndexTiret))
                Case 2
                    If Album = "" Then Album = Trim(strFound(intIndexTiret))
                Case Else
'                ExtractID3TagFromFileName = ExtractID3TagFromFileName & strFound(intIndexTiret)
        End Select
        End If
    Next intIndexTiret
End Sub
Public Sub DecToBin(Dec, ByRef Bin() As Byte)
    Dim Compteur As Integer
    Dim Index As Integer
    Dim Max As Integer
    Dim Temp As Integer
    Select Case TypeName(Dec)
        Case "Byte": Max = 7
        Case "Integer": Max = 15
        Case "Long": Max = 31
        Case Else
            Do While 2 ^ Index <= Dec
                Index = Index + 1
            Loop
            Max = Int(((Index - 1) / 8) + 1) * 8 - 1
    End Select
    
    ReDim Bin(0 To Max)
    
    If Dec <> 0 Then
        For Index = Max To 0 Step -1
            If 2 ^ Index <= Dec Then
                Bin(Index) = 1
                Dec = Dec - 2 ^ Index
            End If
        Next Index
    End If
End Sub

Public Sub BinToDec(Bin() As Byte, Dec)
    Dim Compteur As Integer
    For Compteur = 0 To UBound(Bin())
        Dec = Dec + Bin(Compteur) * (2 ^ Compteur)
    Next Compteur
End Sub

Function RectifieTexte(Texte As String) As String
    Dim intIndex As Integer
    intIndex = InStr(1, Texte, Chr(0))
    If intIndex <> 0 Then
        Texte = Left(Texte, intIndex - 1)
    Else
        Texte = Texte
    End If
    RectifieTexte = Trim(Texte)
End Function

Conclusion :


le module fait des calculs sur des offsets, des inversement d'octets etc, et c'est plutôt baleze à faire en VB, donc c'est fort probable qu'il plante sur certains fichiers.

Mon site: www.multimania.com/grdbest

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

LallThis
Messages postés
13
Date d'inscription
lundi 16 avril 2001
Statut
Membre
Dernière intervention
9 août 2007
-
Salut, deja le site n'existe pas.
y'a pas le source sur VBFrance.com

Et moi je voudrais bien le voir, car il m'interesse beaucoup et à l'air pas mal du tout.

Merci Bye LallThis
niiizzzz
Messages postés
5
Date d'inscription
mercredi 11 décembre 2002
Statut
Membre
Dernière intervention
24 janvier 2003
-
Ya pas moyen d'ecrire??Je sais je suis exigeant comme garcon....
TotoBest
Messages postés
13
Date d'inscription
mercredi 13 septembre 2000
Statut
Membre
Dernière intervention
1 décembre 2003
-
pour écrire en v2, c'est bcp plus baleze.
TotoBest
Messages postés
13
Date d'inscription
mercredi 13 septembre 2000
Statut
Membre
Dernière intervention
1 décembre 2003
-
au fait, pour répondre aux commentaires précédents, j'ai mis à jour la source: reuploader la source qui déconnait (le dd du serveur avait crash). J'en ai profité pour ajouter des captures d'écrans.
Commenter la réponse de TotoBest

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.