Soyez le premier à donner votre avis sur cette source.
Vue 11 940 fois - Téléchargée 1 074 fois
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
10 janv. 2003 à 19:23
10 janv. 2003 à 19:20
10 janv. 2003 à 18:01
7 mars 2002 à 12:59
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
6 juil. 2001 à 20:05
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.