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/SlipknotFormatM4A.cls
'
' /////////////////////////////////////////////////////////////
' // 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
Ejemplo de uso:
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!¡.
