[Source] Tag M4A Format Reader... QuickTime - itunes

[BlackZeroX]

Es un Modulod e Clase que sirve para leer el Tag de los archivos de Musica, y extraer toda la informacion posible del mismo...

Saca los bytes del Cover del M4A incluyendo su formato... JPEG / PNG.
Saca el texto "liryc" del M4A (Si existe...)

y toda la informacion posible y de forma existencial!¡.

* Esta la es la primera version, asi que si tiene errores favor de comunicarlos en este mismo hilo.
* Deshacer este formato para obtener la información me a costa asi que disfrutenlo!¡.

NOTA: No saca informacion comprimida... para ello usar la Zlib...


Aqui hay varios archivos M4A... xP  --->  http://infrangelux.sytes.net/FileX/index.php?dir=/Musica/Slipknot

FormatM4A.cls

Código (Vb) [Seleccionar] Expandir




'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo es requerido    //
'   // el agradacimiento al autor.                             //
'   /////////////////////////////////////////////////////////////
'   //////////////////////Lector Formato M4A/////////////////////
'   /////////////////////////////////////////////////////////////
'   //  1ra Version...                                         //
'   //      --> Verificación de Formato.                       //
'   //      --> Solo Lectura de Datos (Tag).                   //
'   /////////////////////////////////////////////////////////////

Option Explicit
Option Base 0
Option Compare Text

Private Str_Album                       As String
Private Str_Artist                      As String
Private Str_AlbumArtist                 As String
Private Str_Comment                     As String
Private Str_Year                        As String
Private Str_Title                       As String
Private Str_Genre                       As String
Private Str_TrackNumber                 As String
Private Str_DiskNumber                  As String
Private Str_Composer                    As String
Private Str_Encoder                     As String
Private Str_BPM                         As String
Private Str_Copyright                   As String
Private Str_Compilation                 As String
Private Arr_Artwork()                   As Byte
Private Str_ArtworkFormat               As String
Private Str_RatingAdvisory              As String
Private Str_Grouping                    As String
Private Str_qq_stik                     As String
Private Str_Podcast                     As String
Private Str_Category                    As String
Private Str_Keyword                     As String
Private Str_PodcastURL                  As String
Private Str_EpisodeGlobalUniqueID       As String
Private Str_Description                 As String
Private Str_Lyrics                      As String
Private Str_TVNetworkName               As String
Private Str_TVShowName                  As String
Private Str_TVEpisodeNumber             As String
Private Str_TVSeason                    As String
Private Str_TVEpisode                   As String
Private Str_PurchaseDate                As String
Private Str_GaplessPlayback             As String

Private Const lng_lAtom                 As Long = &H4
Private Const Str_Format                As String = "ftyp"
Private Const cContData                 As String = "udta"
Private Const cMetaData                 As String = "meta"
Private Const ChdlrData                 As String = "hdlr"

Private Const cAlbum                    As String = "©alb"
Private Const cArtist                   As String = "©art"
Private Const cAlbumArtist              As String = "aART"
Private Const cComment                  As String = "©cmt"
Private Const cYear                     As String = "©day"
Private Const cTitle                    As String = "©nam"
Private Const cGenre                    As String = "©gen|gnre"
Private Const cTrackNumber              As String = "trkn"
Private Const cDiskNumber               As String = "disk"
Private Const cComposer                 As String = "©wrt"
Private Const cEncoder                  As String = "©too"
Private Const cBPM                      As String = "tmpo"
Private Const cCopyright                As String = "cprt"
Private Const cCompilation              As String = "cpil"
Private Const cArtwork                  As String = "covr"
Private Const cRatingAdvisory           As String = "rtng"
Private Const cGrouping                 As String = "©grp"
Private Const cqq_stik                  As String = "stik"
Private Const cPodcast                  As String = "pcst"
Private Const cCategory                 As String = "catg"
Private Const cKeyword                  As String = "keyw"
Private Const cPodcastURL               As String = "purl"
Private Const cEpisodeGlobalUniqueID    As String = "egid"
Private Const cDescription              As String = "desc"
Private Const cStr_Lyrics               As String = "©lyr"
Private Const cTVNetworkName            As String = "tvnn"
Private Const cTVShowName               As String = "tvsh"
Private Const cTVEpisodeNumber          As String = "tven"
Private Const cTVSeason                 As String = "tvsn"
Private Const cTVEpisode                As String = "tves"
Private Const cPurchaseDate             As String = "purd"
Private Const cGaplessPlayback          As String = "pgap"

Private Str_File                        As String
Private Priv_ItsOkFormat                As Boolean

Private Function StringToLong(ByVal Str_Data As String) As Long
Dim TMP$, i&
Dim Byte_Str()      As Byte
   TMP$ = String$(Len(Str_Data) * 2 + 2, "0")
   Mid$(TMP$, 1, 2) = "&H"
   Byte_Str = StrConv(Str_Data$, vbFromUnicode)
   For i = LBound(Byte_Str) To UBound(Byte_Str)
       If Byte_Str(i) > 15 Then
           Mid$(TMP$, 3 + i * 2, 2) = Hex(Byte_Str(i))
       Else
           Mid$(TMP$, 3 + i * 2, 2) = "0" & Hex(Byte_Str(i))
       End If
   Next i
   StringToLong& = CLng(TMP$)
End Function

Private Function GetStrFromNumFile(ByVal IDFile As Integer, ByVal LngPos As Long, ByRef StrOut As String) As Long
   Get IDFile%, LngPos, StrOut$
   GetStrFromNumFile = LngPos + Len(StrOut$)
End Function

Public Property Let This_File(ByVal StrFilePath As String)
Dim Str_PointerStr      As String * lng_lAtom
Dim Str_CatNow          As String * lng_lAtom
Dim Str_DataPos         As String * lng_lAtom
Dim Str_CatData         As String
Dim lng_Pos             As Long
Dim int_FF              As Integer


   Str_Album$ = ""
   Str_Artist$ = ""
   Str_AlbumArtist$ = ""
   Str_Comment$ = ""
   Str_Year$ = ""
   Str_Title$ = ""
   Str_Genre$ = ""
   Str_TrackNumber$ = ""
   Str_DiskNumber$ = ""
   Str_Composer$ = ""
   Str_Encoder$ = ""
   Str_BPM$ = ""
   Str_Copyright$ = ""
   Str_Compilation$ = ""
   Erase Arr_Artwork
   Str_RatingAdvisory$ = ""
   Str_Grouping$ = ""
   Str_qq_stik$ = ""
   Str_Podcast$ = ""
   Str_Category$ = ""
   Str_Keyword$ = ""
   Str_PodcastURL$ = ""
   Str_EpisodeGlobalUniqueID$ = ""
   Str_Description$ = ""
   Str_Lyrics$ = ""
   Str_TVNetworkName$ = ""
   Str_TVShowName$ = ""
   Str_TVEpisodeNumber$ = ""
   Str_TVSeason$ = ""
   Str_TVEpisode$ = ""
   Str_PurchaseDate$ = ""
   Str_GaplessPlayback$ = ""
                                       
                                       
   Str_CatData$ = Space$(lng_lAtom&)
   Priv_ItsOkFormat = False
   Str_File$ = StrFilePath$
   int_FF% = FreeFile%
   
   Open Str_File$ For Binary As int_FF%
   
   If LOF(int_FF%) > 8 Then
   
       Get int_FF%, 5, Str_CatNow$
       
       If StrComp(Str_CatNow$, Str_Format$, vbBinaryCompare) = 0 Then
           'lng_Pos& = 148 '   //  Se puede Obviar, pero mejor comprovamos el formato...
           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + 1, Str_DataPos$) - (lng_lAtom& - 1)
           lng_Pos& = GetStrFromNumFile&(int_FF%, StringToLong&(Str_DataPos$) + ((lng_lAtom& * 2) + 1), Str_DataPos$) + StringToLong&(Str_DataPos$) - lng_lAtom& - 1
           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + 1, Str_DataPos$) + StringToLong&(Str_DataPos$)
           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos&, Str_CatNow$)
           
           If StrComp(Str_CatNow$, cContData$, vbTextCompare) = 0 Then
               lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_DataPos$)
               If StrComp(Str_DataPos$, cMetaData$, vbTextCompare) = 0 Then
                   lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_CatData$)
                   lng_Pos& = lng_Pos& + StringToLong&(Str_CatData$) + lng_lAtom&
                   Do
                       lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_CatNow$)
                       If StrComp(Str_CatNow$, "free", vbTextCompare) = 0 Or StrComp(Str_CatNow$, "name", vbTextCompare) = 0 Then Exit Do
                       Call GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_DataPos$)
                       If StrComp(Str_DataPos$, "data", vbTextCompare) = 0 Then '   //  Atom Legible? (Sin Compresion o espesificaciones del Formato...)
                           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos&, Str_PointerStr$)
                           Str_CatData$ = Space$(StringToLong&(Str_PointerStr$) - (lng_lAtom& * 4))
                           If StrComp(Str_CatNow$, cArtwork$, vbTextCompare) = 0 Then
                               GetStrFromNumFile& int_FF%, lng_Pos& + lng_lAtom&, Str_PointerStr$
                               Select Case StringToLong&(Str_PointerStr$)
                                   Case 13
                                       Str_ArtworkFormat$ = "jpeg"
                                   Case 14
                                       Str_ArtworkFormat$ = "png"
                               End Select
                           End If
                           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + (lng_lAtom * 3), Str_CatData)
                           If Not StrComp(Str_CatNow$, "", vbTextCompare) = 0 Then
                               Select Case Str_CatNow$
                                   Case cAlbum$
                                       Str_Album$ = Str_CatData$
                                   Case cArtist$
                                       Str_Artist$ = Str_CatData$
                                   Case cAlbumArtist$
                                       Str_AlbumArtist$ = Str_CatData$
                                   Case cComment$
                                       Str_Comment$ = Str_CatData$
                                   Case cYear$
                                       Str_Year$ = Str_CatData$
                                   Case cTitle$
                                       Str_Title$ = Str_CatData$
                                   Case Split(cGenre$, "|")(0), Split(cGenre$, "|")(1)                 '  //  "©gen|gnre"
                                       Str_Genre$ = Str_CatData$
                                   Case cTrackNumber$
                                       Str_TrackNumber$ = Str_CatData$
                                   Case cDiskNumber$
                                       Str_DiskNumber$ = Str_CatData$
                                   Case cComposer$
                                       Str_Composer$ = Str_CatData$
                                   Case cEncoder$
                                       Str_Encoder$ = Str_CatData$
                                   Case cBPM$
                                       Str_BPM$ = Str_CatData$
                                   Case cCopyright$
                                       Str_Copyright$ = Str_CatData$
                                   Case cCompilation$
                                       Str_Compilation$ = Str_CatData$
                                   Case cArtwork$
                                       Arr_Artwork = StrConv(Str_CatData$, vbFromUnicode)
                                   Case cRatingAdvisory$
                                       Str_RatingAdvisory$ = Str_CatData$
                                   Case cGrouping$
                                       Str_Grouping$ = Str_CatData$
                                   Case cqq_stik$
                                       Str_qq_stik$ = Str_CatData$
                                   Case cPodcast$
                                       Str_Podcast$ = Str_CatData$
                                   Case cCategory$
                                       Str_Category$ = Str_CatData$
                                   Case cKeyword$
                                       Str_Keyword$ = Str_CatData$
                                   Case cPodcastURL$
                                       Str_PodcastURL$ = Str_CatData$
                                   Case cEpisodeGlobalUniqueID$
                                       Str_EpisodeGlobalUniqueID$ = Str_CatData$
                                   Case cDescription$
                                       Str_Description$ = Str_CatData$
                                   Case cStr_Lyrics$
                                       Str_Lyrics$ = Str_CatData$
                                   Case cTVNetworkName$
                                       Str_TVNetworkName$ = Str_CatData$
                                   Case cTVShowName$
                                       Str_TVShowName$ = Str_CatData$
                                   Case cTVEpisodeNumber$
                                       Str_TVEpisodeNumber$ = Str_CatData$
                                   Case cTVSeason$
                                       Str_TVSeason$ = Str_CatData$
                                   Case cTVEpisode$
                                       Str_TVEpisode$ = Str_CatData$
                                   Case cPurchaseDate$
                                       Str_PurchaseDate$ = Str_CatData$
                                   Case cGaplessPlayback$
                                       Str_GaplessPlayback$ = Str_CatData$
                               End Select
                           End If
                       ElseIf Str_CatNow$ = "----" Then
                           lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& - 8, Str_DataPos$)
                           lng_Pos& = lng_Pos& + StringToLong&(Str_DataPos$) - lng_lAtom&
                       End If
                   Loop
                   Priv_ItsOkFormat = True
               End If
           End If
       End If
   End If
    Close int_FF%
End Property

Public Property Get ItsOkFormat() As Boolean
   ItsOkFormat = Priv_ItsOkFormat
End Property

Public Property Get This_File() As String
   This_File = Str_File$
End Property

Public Property Get Album() As String
   Album = Str_Album
End Property
Public Property Get Artist() As String
   Artist = Str_Artist
End Property
Public Property Get AlbumArtist() As String
   AlbumArtist = Str_AlbumArtist
End Property
Public Property Get Comment() As String
   Comment = Str_Comment
End Property
Public Property Get Year() As String
   Year = Str_Year
End Property
Public Property Get Title() As String
   Title = Str_Title
End Property
Public Property Get Genre() As String
   Genre = Str_Genre
End Property
Public Property Get TrackNumber() As String
   TrackNumber = Str_TrackNumber
End Property
Public Property Get DiskNumber() As String
   DiskNumber = Str_DiskNumber
End Property
Public Property Get Composer() As String
   Composer = Str_Composer
End Property
Public Property Get Encoder() As String
   Encoder = Str_Encoder
End Property
Public Property Get BPM() As String
   BPM = Str_BPM
End Property
Public Property Get Copyright() As String
   Copyright = Str_Copyright
End Property
Public Property Get Compilation() As String
   Compilation = Str_Compilation
End Property
Public Property Get Artwork() As Byte()
   Artwork = Arr_Artwork
End Property
Public Property Get ArtworkFormat() As String
   ArtworkFormat = Str_ArtworkFormat
End Property
Public Property Get RatingAdvisory() As String
   RatingAdvisory = Str_RatingAdvisory
End Property
Public Property Get Grouping() As String
   Grouping = Str_Grouping
End Property
Public Property Get qq_stik() As String
   qq_stik = Str_qq_stik
End Property
Public Property Get Podcast() As String
   Podcast = Str_Podcast
End Property
Public Property Get Category() As String
   Category = Str_Category
End Property
Public Property Get Keyword() As String
   Keyword = Str_Keyword
End Property
Public Property Get PodcastURL() As String
   PodcastURL = Str_PodcastURL
End Property
Public Property Get EpisodeGlobalUniqueID() As String
   EpisodeGlobalUniqueID = Str_EpisodeGlobalUniqueID
End Property
Public Property Get Description() As String
   Description = Str_Description
End Property
Public Property Get Lyrics() As String
   Lyrics = Str_Lyrics
End Property
Public Property Get TVNetworkName() As String
   TVNetworkName = Str_TVNetworkName
End Property
Public Property Get TVShowName() As String
   TVShowName = Str_TVShowName
End Property
Public Property Get TVEpisodeNumber() As String
   TVEpisodeNumber = Str_TVEpisodeNumber
End Property
Public Property Get TVSeason() As String
   TVSeason = Str_TVSeason
End Property
Public Property Get TVEpisode() As String
   TVEpisode = Str_TVEpisode
End Property
Public Property Get PurchaseDate() As String
   PurchaseDate = Str_PurchaseDate
End Property
Public Property Get GaplessPlayback() As String
   GaplessPlayback = Str_GaplessPlayback
End Property


'Public Property Let Album(ByVal vData As String)
'Public Property Let Artist(ByVal vData As String)
'Public Property Let AlbumArtist(ByVal vData As String)
'Public Property Let Comment(ByVal vData As String)
'Public Property Let Year(ByVal vData As String)
'Public Property Let Title(ByVal vData As String)
'Public Property Let Genre(ByVal vData As Integer)
'Public Property Let TrackNumber(ByVal vData As Integer)
'Public Property Let DiskNumber(ByVal vData As Integer)
'Public Property Let Composer(ByVal vData As String)
'Public Property Let Encoder(ByVal vData As String)
'Public Property Let BPM(ByVal vData As Integer)
'Public Property Let Copyright(ByVal vData As String)
'Public Property Let Compilation(ByVal vData As Integer)
'Public Property Let Artwork(ByRef vData() As Byte)
'   //  Public Property Let ArtworkFormat(ByRef vData As String)
'Public Property Let RatingAdvisory(ByVal vData As Integer)
'Public Property Let Grouping(ByVal vData As String)
'Public Property Let qq_stik(ByVal vData As Integer)
'Public Property Let Podcast(ByVal vData As Integer)
'Public Property Let Category(ByVal vData As String)
'Public Property Let Keyword(ByVal vData As String)
'Public Property Let PodcastURL(ByVal vData As Integer)
'Public Property Let EpisodeGlobalUniqueID(ByVal vData As Integer)
'Public Property Let Description(ByVal vData As String)
'Public Property Let Lyrics(ByVal vData As String)
'Public Property Let TVNetworkName(ByVal vData As String)
'Public Property Let TVShowName(ByVal vData As String)
'Public Property Let TVEpisodeNumber(ByVal vData As String)
'Public Property Let TVSeason(ByVal vData As Integer)
'Public Property Let TVEpisode(ByVal vData As Integer)
'Public Property Let PurchaseDate(ByVal vData As String)
'Public Property Let GaplessPlayback(ByVal vData As Integer)



Ejemplo de uso:

Código (Vb) [Seleccionar] Expandir




Option Explicit
Option Base 0

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Sub main()
Dim clsFM4A         As Cls_FormatM4A
Dim StrDir          As String
Dim int_FF          As Integer

   Set clsFM4A = New Cls_FormatM4A
   With clsFM4A
   
       .This_File = App.Path & "\SCGJ.m4a"
       
       If .ItsOkFormat Then
       
           StrDir$ = Replace$("c:\Musica\" & .Artist & "\" & .Year & "-" & .Album & "\", "\\", "\")
           Call MakeSureDirectoryPathExists(StrDir$)
           
           '   //  extraemos la Imagen Cover
           int_FF% = FileSystem.FreeFile%
           Open StrDir & .Artist & " - " & .Title & "." & .ArtworkFormat For Binary As int_FF%
               Put int_FF%, , .Artwork
           Close int_FF%
           
           '   //  Extraemos la lirica del archivo
           int_FF% = FileSystem.FreeFile%
           Open StrDir & .Artist & " - " & .Title & ".txt" For Binary As int_FF%
               Put int_FF%, , .Lyrics
           Close int_FF%
           
       End If
   End With
   Set clsFM4A = Nothing
   
End Sub



Dulce Infierno Lunar!¡.