Mp3 id3 tag v1 et v2 reader
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.
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
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
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.