MP3 ID3 TAG V1 ET V2 READER

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