
Not 100% mine, see the header. Usage instructions at the bottom.
If you want the x64 dll/lib, let me know, and I'll try to regenerate the lib (I managed to delete it

Tested on Linux and Windows - should work on Mac, but would need fink or similar I presume
For mp3s, if it has a ID3v2.3.x or V1 tag, it will natively read it, otherwise will pass it on to taglib
Wma reading is fully native. I might have reinvented the wheel slightly with the guid stuff, but I like to see them in strings

Taglib Import is not complete (reading functions defined only). Search the forum for the other functions if needed.
Warning: The native mp3 reading uses file number 0, I haven't bothered changing it from the original

Enjoy

Code: Select all
; ID3 native PB code Based on Code by: 'a14xerus' (http://www.alexander-n.de) with friendly support of 'Padde' 06.06.2007 http://purebasic.fr/english/viewtopic.php?t=31280
;ID3 genre matching coded by lexvictory
;Taglib code by lexvictory
;WMA Tags written by lexvictory, converted from VB http://www.codeproject.com/KB/files/tagreader.aspx
;{ genres
Global Dim genres.s(125)
genres(0) = "Blues"
genres(1) = "Classic Rock"
genres(2) = "Country"
genres(3) = "Dance"
genres(4) = "Disco"
genres(5) = "Funk"
genres(6) = "Grunge"
genres(7) = "Hip-Hop"
genres(8) = "Jazz"
genres(9) = "Metal"
genres(10) = "New Age"
genres(11) = "Oldies"
genres(12) = "Other"
genres(13) = "Pop"
genres(14) = "R&B"
genres(15) = "Rap"
genres(16) = "Reggae"
genres(17) = "Rock"
genres(18) = "Techno"
genres(19) = "Industrial"
genres(20) = "Alternative"
genres(21) = "Ska"
genres(22) = "Death Metal"
genres(23) = "Pranks"
genres(24) = "Soundtrack"
genres(25) = "Euro-Techno"
genres(26) = "Ambient"
genres(27) = "Trip-Hop"
genres(28) = "Vocal"
genres(29) = "Jazz+Funk"
genres(30) = "Fusion"
genres(31) = "Trance"
genres(32) = "Classical"
genres(33) = "Instrumental"
genres(34) = "Acid"
genres(35) = "House"
genres(36) = "Game"
genres(37) = "Sound Clip"
genres(38) = "Gospel"
genres(39) = "Noise"
genres(40) = "AlternRock"
genres(41) = "Bass"
genres(42) = "Soul"
genres(43) = "Punk"
genres(44) = "Space"
genres(45) = "Meditative"
genres(46) = "Instrumental Pop"
genres(47) = "Instrumental Rock"
genres(48) = "Ethnic"
genres(49) = "Gothic"
genres(50) = "Darkwave"
genres(51) = "Techno-Industrial"
genres(52) = "Electronic"
genres(53) = "Pop-Folk"
genres(54) = "Eurodance"
genres(55) = "Dream"
genres(56) = "Southern Rock"
genres(57) = "Comedy"
genres(58) = "Cult"
genres(59) = "Gangsta"
genres(60) = "Top 40"
genres(61) = "Christian Rap"
genres(62) = "Pop/Funk"
genres(63) = "Jungle"
genres(64) = "Native American"
genres(65) = "Cabaret"
genres(66) = "New Wave"
genres(67) = "Psychadelic"
genres(68) = "Rave"
genres(69) = "Showtunes"
genres(70) = "Trailer"
genres(71) = "Lo-Fi"
genres(72) = "Tribal"
genres(73) = "Acid Punk"
genres(74) = "Acid Jazz"
genres(75) = "Polka"
genres(76) = "Retro"
genres(77) = "Musical"
genres(78) = "Rock & Roll"
genres(79) = "Hard Rock"
genres(80) = "Folk"
genres(81) = "Folk-Rock"
genres(82) = "National Folk"
genres(83) = "Swing"
genres(84) = "Fast Fusion"
genres(85) = "Bebob"
genres(86) = "Latin"
genres(87) = "Revival"
genres(88) = "Celtic"
genres(89) = "Bluegrass"
genres(90) = "Avantgarde"
genres(91) = "Gothic Rock"
genres(92) = "Progressive Rock"
genres(93) = "Psychedelic Rock"
genres(94) = "Symphonic Rock"
genres(95) = "Slow Rock"
genres(96) = "Big Band"
genres(97) = "Chorus"
genres(98) = "Easy Listening"
genres(99) = "Acoustic"
genres(100) = "Humour"
genres(101) = "Speech"
genres(102) = "Chanson"
genres(103) = "Opera"
genres(104) = "Chamber Music"
genres(105) = "Sonata"
genres(106) = "Symphony"
genres(107) = "Booty Bass"
genres(108) = "Primus"
genres(109) = "Porn Groove"
genres(110) = "Satire"
genres(111) = "Slow Jam"
genres(112) = "Club"
genres(113) = "Tango"
genres(114) = "Samba"
genres(115) = "Folklore"
genres(116) = "Ballad"
genres(117) = "Power Ballad"
genres(118) = "Rhythmic Soul"
genres(119) = "Freestyle"
genres(120) = "Duet"
genres(121) = "Punk Rock"
genres(122) = "Drum Solo"
genres(123) = "A capella"
genres(124) = "Euro-House"
genres(125) = "Dance Hall"
;}
Procedure.s GenreMatch(zeegenre.s)
If CreateRegularExpression(0, "\([0-9]\)|\([0-9][0-9]\)|\(1[0-2][0-9]\)")
Dim containedgenres.s(0)
NbFound = ExtractRegularExpression(0, zeegenre, containedgenres())
For k = 0 To NbFound-1
num = Val(RemoveString(RemoveString(containedgenres(k), "("), ")"))
;Debug num
;Debug containedgenres(k)
zeegenre = ReplaceString(zeegenre, containedgenres(k), genres(num))
Next
FreeRegularExpression(0)
zeegenre = ReplaceString(zeegenre, "((", "(")
ProcedureReturn zeegenre
EndIf
EndProcedure
UseJPEGImageDecoder()
UsePNGImageDecoder()
;- Constants
#ID3_BinaryReturn=0
#ID3_ImageReturn=1
;- Structures
Structure TagV1 ; Only a few Tags, a list of all tags on http://www.id3.org
tag.s
title.s ; "TIT2"
artist.s ; "TPE1"
album.s ; "TALB"
year.s ; ...
genre.s
URL.s
Copyright.s
track.s
EndStructure
Structure TagV2 ; Only a few Tags, a list of all tags on http://www.id3.org
filename.s
title.s ; "TIT2"
artist.s ; "TPE1"
album.s ; "TALB"
year.s ; ...
genre.s
URL.s
Copyright.s
track.s
lyrics.s
image.i
EndStructure
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
ImportC "/usr/lib/libtag_c.so"
CompilerElse
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
ImportC "taglibx64.lib"
CompilerElse
ImportC "tag_c.lib"
CompilerEndIf
CompilerEndIf
taglib_file_new(filename.p-utf8); As "_taglib_file_new"
taglib_file_free(file); As "_taglib_free_file"
taglib_file_tag(file); As "_taglib_file_tag"
taglib_tag_free_strings(); As "_taglib_tag_free_strings";must be called
taglib_tag_title(*tag); As "_taglib_tag_title";returns pointer to utf8 string
taglib_tag_artist(*tag); As "_taglib_tag_artist"
taglib_tag_album(*tag); As "_taglib_tag_album"
taglib_tag_comment(*tag); As "_taglib_tag_comment"
taglib_tag_genre(*tag); As "_taglib_tag_genre"
taglib_tag_year(*tag); As "_taglib_tag_year";returns int
taglib_tag_track(*tag);As "_taglib_tag_track";ret int
EndImport
Procedure TaglibGetTags(*entry.TagV2)
Define file.l, *tag
file = taglib_file_new(*entry\filename)
;Debug file
If file
*tag = taglib_file_tag(file)
;Debug *tag
If *tag
title = taglib_tag_title(*tag)
If title : *entry\title = PeekS(title, -1, #PB_UTF8) : EndIf
Debug *entry\title
artist = taglib_tag_artist(*tag)
If artist : *entry\artist = PeekS(artist, -1, #PB_UTF8) : EndIf
Debug *entry\artist
album = taglib_tag_album(*tag)
If album : *entry\album = PeekS(album, -1, #PB_UTF8) : EndIf
genre = taglib_tag_genre(*tag)
If genre : *entry\genre = PeekS(genre, -1, #PB_UTF8) : EndIf
track = taglib_tag_track(*tag)
If track : *entry\track = Str(track) : EndIf
fileyear = taglib_tag_year(*tag)
If fileyear : *entry\year = Str(fileyear) : EndIf
If *entry\title = ""
*entry\title = GetFilePart(*entry\filename)
EndIf
;Debug "calling free strings"
taglib_tag_free_strings()
EndIf
taglib_file_free(file)
EndIf
EndProcedure
;- ID3 Tag Version 1 Read
Procedure GetID3v1Tag(filename.s,*infos.TagV1)
Protected *mem, header$, Result.l
If ReadFile(0,filename)
If Lof(0) = 0 : ProcedureReturn 0 : EndIf
*mem = AllocateMemory(128) ; allocate 128 byte
If *mem
FileSeek(0,Lof(0)-128)
ReadData(0,*mem , 128) ; read the last 128 byte
header$ = PeekS(*mem , 3, #PB_Ascii)
If header$ = "TAG" ; 3 chars
With *infos
\title = Trim(PeekS(*mem + 3, 30, #PB_Ascii)) ; 30 chars
\artist = Trim(PeekS(*mem + 33, 30, #PB_Ascii)) ; 30 chars
\album = Trim(PeekS(*mem + 63, 30, #PB_Ascii)) ; 30 chars
\year = Trim(PeekS(*mem + 93, 4, #PB_Ascii)) ; 4 chars
; \Comment = Trim(PeekS(*mem + 97, 29)) ; 30 chars
\track = Trim(PeekS(*mem + 126, 1, #PB_Ascii)) ; 1 chars
\genre = Trim(PeekS(*mem + 127, 1, #PB_Ascii)) ; 1 chars
EndWith
Result = #True
EndIf
FreeMemory(*mem)
EndIf
CloseFile(0)
EndIf
ProcedureReturn Result
EndProcedure
;- ID3 Tag Version 2 Procedures
Procedure frameTXXX(id.s, FrameSize.l, *infos.TagV2)
Protected TextEncoding.b, *mem, Contents.s
TextEncoding = ReadByte(0)&$FF ; TXXX Textencoding
FrameSize - 1 ; subtract TextEncoding-Byte from size
If FrameSize <= 0
ProcedureReturn #False
EndIf
*mem = AllocateMemory(FrameSize)
ReadData(0,*mem, FrameSize)
If TextEncoding = 0
Contents = PeekS(*mem,FrameSize,#PB_Ascii)
;Debug "ascii"
ElseIf TextEncoding = 1
Contents = PeekS(*mem+2,(FrameSize-2)/2,#PB_UTF16);lexvictory: framsize is char count in this case? without /2 caused garbage characters on one of my files...
;Debug "utf16: "+id
EndIf
FreeMemory(*mem)
With *infos
Select id
Case "TIT2"
\title = Contents
Case "TPE1", "TPE1"
\artist = Contents
Case "TALB"
\album = Contents
Case "TYER"
\year = Contents
Case "TCON"
\genre = GenreMatch(Contents)
;Debug Contents
Case "TCOP"
\Copyright = Contents
Case "TRCK"
\track = Contents
EndSelect
EndWith
ProcedureReturn #True
EndProcedure
Procedure frameWXXX(id.s, FrameSize.l, *infos.TagV2)
Protected Contents.s
ReadByte(0) ; WXXX Textencoding for Description (URLs are allways ASCII)
FrameSize - 1
If FrameSize <= 0
ProcedureReturn #False
EndIf
*contents = AllocateMemory(FrameSize+1)
ReadData(0,*Contents, FrameSize)
Contents = PeekS(*contents, -1, #PB_Ascii)
FreeMemory(*contents)
*infos\URL = Contents
ProcedureReturn #True
EndProcedure
Procedure frameAPIC(id.s, FrameSize.l, *infos.TagV2)
Protected TextEncoding.b, tmp.l, *mem
tmp = Loc(0)
TextEncoding = ReadByte(0) ; APIC Textencoding
If TextEncoding = 0
ReadString(0,#PB_Ascii) ; APIC MIME (ASCII)
ElseIf TextEncoding = 1
ReadString(0,#PB_UTF16) ; APIC MIME (UTF16 / Unicode)
EndIf
If ReadByte(0)&$FF = $03 ; APIC Picture Typ ($03 = Cover front) (for overview look at http://www.id3.org)
If TextEncoding = 0
ReadString(0,#PB_Ascii) ; APIC Description (ASCII)
ElseIf TextEncoding = 1
ReadString(0,#PB_UTF16) ; APIC Description (UTF16)
EndIf
FrameSize - (Loc(0)-tmp) ; subtract the desciptions from the framesize to get the picturesize
*mem = AllocateMemory(FrameSize)
ReadData(0,*mem, FrameSize)
*infos\image = CatchImage(-1,*mem,FrameSize,#PB_Image_DisplayFormat)
FreeMemory(*mem)
EndIf
EndProcedure
Procedure FrameUSLT(id.s, FrameSize.l, *infos.TagV2) ; Hacked together by Localmotion34 - Props to a14xerus for finding Framseize code that WORKS
Protected TextEncoding.b, tmp.l, *mem
tmp = Loc(0)
TextEncoding = ReadByte(0) ; USLT Textencoding
If TextEncoding = 0
ReadString(0,#PB_Ascii) ; APIC MIME (ASCII)
ElseIf TextEncoding = 1
ReadString(0,#PB_UTF16) ; APIC MIME (UTF16 / Unicode)
EndIf
FrameSize -(Loc(0)-tmp) ; subtract the desciptions from the framesize to get the picturesize
If FrameSize>0
*mem = AllocateMemory(FrameSize)
ReadData(0,*mem, FrameSize)
*infos\lyrics = PeekS(*mem,FrameSize)
FreeMemory(*mem)
Else
*infos\lyrics =""
EndIf
EndProcedure
Procedure GetID3v2Tag(filename.s,*infos.TagV2)
Protected ID3.s, ID3Size, byte.l, Size.l, FrameID.s, FrameSize.l, Location.l
If ReadFile(0,filename)
*ID3 = AllocateMemory(4)
ReadData(0,*ID3, 3)
If PeekS(*ID3, 3, #PB_Ascii) = "ID3" And ReadByte(0) = $03 ; must be ID3v2.3.x !
;Debug "getting id3v2.3 natively: "+GetFilePart(filename)
ReadByte(0) ; Revision (not needed)
ReadByte(0) ; Flags (not needed)
ID3Size = 0 ; get hole Size of ID3Tag
ID3Size = ReadLong(0)
ID3Size = ((ID3Size&$FF)<<24)+((ID3Size&$FF00)<<8)+((ID3Size&$FF0000)>>8)+((ID3Size>>24)&$FF)
ElseIf PeekS(*ID3, 3, #PB_Ascii) = "ID3";lets use taglib
Debug "using taglib"
CloseFile(0)
TaglibGetTags(*infos)
ProcedureReturn #True
Else
; no ID3v2.3.x tag present
CloseFile(0)
ProcedureReturn #False
EndIf
Size.l = 0
Repeat
; examine All frames
; / Frameheader starts
*frameid = AllocateMemory(5)
ReadData(0,*FrameID, 4) ; Read FrameID (allways 4 chars)
FrameID.s = PeekS(*frameid, -1, #PB_Ascii)
FreeMemory(*frameid)
If Asc(Left(FrameID, 1)) = 0
CloseFile(0)
ProcedureReturn #True
EndIf
;;; F*ck you Id3lib.org. your Sh*t documentation makes it IMPOSSIBLE to get correct frame sizes
FrameSize = 0
FrameSize = ReadLong(0) ; get framesize ( the framesize is the size of the values excluding the frameheader)
FrameSize = ((FrameSize&$FF)<<24)+((FrameSize&$FF00)<<8)+((FrameSize&$FF0000)>>8)+((FrameSize>>24)&$FF) ; props to a14xerus
Size + FrameSize
ReadByte(0): ReadByte(0) ; Frame Flags (not needed)
If FrameSize < 1 : ProcedureReturn #False : EndIf
; \ Frameheader ends (Frameheader allways 10 Bytes)
Location = Loc(0) + FrameSize ; set 'location'value to end of the actual frame
; / Framebody starts
Select FrameID ; Read teh FrameID (Overview on http://www.id3.org)
Case "TIT2", "TPE1", "TALB", "TYER", "TCON", "TCOP", "TRCK", "TPE2"
frameTXXX(FrameID, FrameSize, *infos)
Case "WXXX"
frameWXXX(FrameID, FrameSize, *infos)
Case "APIC"
frameAPIC(FrameID, FrameSize, *infos)
Case "USLT"
FrameUSLT(FrameID, FrameSize, *infos)
; Debug "found lyrics"
; Debug FrameSize
EndSelect
; \ Framebody ends
If location < ID3Size
FileSeek(0,Location) ; Jump to the end of the frame.
; (if something went wrong nevertheless you are at the right location in the file)
EndIf
Until Size >= ID3Size ; stop if tag size reached/exceeded
CloseFile(0)
Else
Debug "could not read "+filename
EndIf
EndProcedure
;- Lower Level Procedures for ID3 Tag Version 2 Reading
Procedure frameAPICReturn(id.s, FrameSize.l, *infos.TagV2, BinaryOrImage)
Protected TextEncoding.b, tmp.l, *mem
tmp = Loc(0)
TextEncoding = ReadByte(0) ; APIC Textencoding
If TextEncoding = 0
ReadString(0,#PB_Ascii) ; APIC MIME (ASCII)
ElseIf TextEncoding = 1
ReadString(0,#PB_UTF16) ; APIC MIME (UTF16 / Unicode)
EndIf
If ReadByte(0)&$FF = $03 ; APIC Picture Typ ($03 = Cover front) (for overview look at http://www.id3.org)
If TextEncoding = 0
ReadString(0,#PB_Ascii) ; APIC Description (ASCII)
ElseIf TextEncoding = 1
ReadString(0,#PB_UTF16) ; APIC Description (UTF16)
EndIf
FrameSize - (Loc(0)-tmp) ; subtract the desciptions from the framesize to get the picturesize
*mem = AllocateMemory(FrameSize)
ReadData(0,*mem, FrameSize)
Select BinaryOrImage
Case 0
ProcedureReturn *mem
Case 1
*infos\image = CatchImage(-1,*mem,FrameSize,#PB_Image_DisplayFormat)
FreeMemory(*mem)
ProcedureReturn *infos\image
EndSelect
EndIf
EndProcedure
Procedure ID3GetImage(filename.s) ; Returns a HBITMAP
Protected ID3.s, ID3Size, byte.l, Size.l, FrameID.s, FrameSize.l, Location.l, *infos.TagV2
If ReadFile(0,filename)
*id3 = AllocateMemory(4)
ReadData(0,*ID3, 3)
ID3.s = PeekS(*id3, 3, #PB_Ascii)
FreeMemory(*id3)
If ID3 = "ID3" And ReadByte(0) = $03 ; must be ID3v2.3.x !
ReadByte(0) ; Revision (not needed)
ReadByte(0) ; Flags (not needed)
ID3Size = 0 ; get hole Size of ID3Tag
ID3Size = ReadLong(0)
ID3Size = ((ID3Size&$FF)<<24)+((ID3Size&$FF00)<<8)+((ID3Size&$FF0000)>>8)+((ID3Size>>24)&$FF)
Else
; no ID3v2.3.x tag present
CloseFile(0)
ProcedureReturn #False
EndIf
*infos.TagV2=AllocateMemory(SizeOf(TagV2))
Size.l = 0
Repeat
; examine All frames
; / Frameheader starts
*frameid = AllocateMemory(5)
ReadData(0,*FrameID, 4) ; Read FrameID (allways 4 chars)
FrameID.s = PeekS(*frameid)
FreeMemory(*frameid)
If Asc(Left(FrameID, 1)) = 0
CloseFile(0)
ProcedureReturn #True
EndIf
FrameSize = 0
FrameSize = ReadLong(0) ; get framesize ( the framesize is the size of the values excluding the frameheader)
FrameSize = ((FrameSize&$FF)<<24)+((FrameSize&$FF00)<<8)+((FrameSize&$FF0000)>>8)+((FrameSize>>24)&$FF) ; props to a14xerus
Size + FrameSize
ReadByte(0): ReadByte(0) ; Frame Flags (not needed)
If FrameSize < 1 : ProcedureReturn #False : EndIf
; \ Frameheader ends (Frameheader allways 10 Bytes)
Location = Loc(0) + FrameSize ; set 'location'value to end of the actual frame
; / Framebody starts
Select FrameID
Case "APIC"
returnimage.l=frameAPICReturn(FrameID, FrameSize, *infos, #ID3_ImageReturn)
Break
EndSelect
; \ Framebody ends
FileSeek(0,Location) ; Jump to the end of the frame.
; (if something went wrong nevertheless you are at the right location in the file)
Until Size >= ID3Size ; stop if tag size reached/exceeded
CloseFile(0)
FreeMemory(*infos)
ProcedureReturn returnimage
EndIf
EndProcedure
Procedure ID3GetImageBinaryData(filename.s);Returns compressed image data--YOU have to decode it and/or write it to a file!!!!!!
Protected ID3.s, ID3Size, byte.l, Size.l, FrameID.s, FrameSize.l, Location.l
If ReadFile(0,filename)
*id3 = AllocateMemory(4)
ReadData(0,*ID3, 3)
ID3.s = PeekS(*id3, 3, #PB_Ascii)
FreeMemory(*id3)
If ID3 = "ID3" And ReadByte(0) = $03 ; must be ID3v2.3.x !
ReadByte(0) ; Revision (not needed)
ReadByte(0) ; Flags (not needed)
ID3Size = 0 ; get hole Size of ID3Tag
ID3Size = ReadLong(0)
ID3Size = ((ID3Size&$FF)<<24)+((ID3Size&$FF00)<<8)+((ID3Size&$FF0000)>>8)+((ID3Size>>24)&$FF)
Else
; no ID3v2.3.x tag present
CloseFile(0)
ProcedureReturn #False
EndIf
*infos.TagV2=AllocateMemory(SizeOf(TagV2))
Size.l = 0
Repeat
; examine All frames
; / Frameheader starts
*frameid = AllocateMemory(5)
ReadData(0,*FrameID, 4) ; Read FrameID (allways 4 chars)
FrameID.s = PeekS(*frameid)
FreeMemory(*frameid)
If Asc(Left(FrameID, 1)) = 0
CloseFile(0)
ProcedureReturn #True
EndIf
FrameSize = 0
FrameSize = ReadLong(0) ; get framesize ( the framesize is the size of the values excluding the frameheader)
FrameSize = ((FrameSize&$FF)<<24)+((FrameSize&$FF00)<<8)+((FrameSize&$FF0000)>>8)+((FrameSize>>24)&$FF) ; props to a14xerus
Size + FrameSize
ReadByte(0): ReadByte(0) ; Frame Flags (not needed)
If FrameSize < 1 : ProcedureReturn #False : EndIf
; \ Frameheader ends (Frameheader allways 10 Bytes)
Location = Loc(0) + FrameSize ; set 'location'value to end of the actual frame
; / Framebody starts
Select FrameID
Case "APIC"
imagemem.l=frameAPICReturn(FrameID, FrameSize, *infos, #ID3_BinaryReturn)
Break
EndSelect
; \ Framebody ends
FileSeek(0,Location) ; Jump to the end of the frame.
; (if something went wrong nevertheless you are at the right location in the file)
Until Size >= ID3Size ; stop if tag size reached/exceeded
CloseFile(0)
FreeMemory(*infos)
ProcedureReturn imagemem
EndIf
EndProcedure
Procedure.s FrameUSLTreturn(id.s, FrameSize.l, *infos.TagV2) ; Hacked together by Localmotion34 - Props to a14xerus for finding Framseize code that WORKS
Protected TextEncoding.b, tmp.l, *mem
tmp = Loc(0)
TextEncoding = ReadByte(0) ; USLT Textencoding
If TextEncoding = 0
ReadString(0,#PB_Ascii) ; APIC MIME (ASCII)
ElseIf TextEncoding = 1
ReadString(0,#PB_UTF16) ; APIC MIME (UTF16 / Unicode)
EndIf
FrameSize -(Loc(0)-tmp) ; subtract the desciptions from the framesize to get the picturesize
If FrameSize>0
*mem = AllocateMemory(FrameSize)
ReadData(0,*mem, FrameSize)
*infos\lyrics = PeekS(*mem,FrameSize)
FreeMemory(*mem)
ProcedureReturn *infos\lyrics
Else
*infos\lyrics =""
ProcedureReturn ""
EndIf
EndProcedure
Procedure.s ID3GetSongLyrics(filename.s)
Protected ID3.s, ID3Size, byte.l, Size.l, FrameID.s, FrameSize.l, Location.l, *infos.TagV2
If ReadFile(0,filename)
*id3 = AllocateMemory(4)
ReadData(0,*ID3, 3)
ID3.s = PeekS(*id3, 3, #PB_Ascii)
FreeMemory(*id3)
If ID3 = "ID3" And ReadByte(0) = $03 ; must be ID3v2.3.x !
ReadByte(0) ; Revision (not needed)
ReadByte(0) ; Flags (not needed)
ID3Size = 0 ; get hole Size of ID3Tag
ID3Size = ReadLong(0)
ID3Size = ((ID3Size&$FF)<<24)+((ID3Size&$FF00)<<8)+((ID3Size&$FF0000)>>8)+((ID3Size>>24)&$FF)
Else
; no ID3v2.3.x tag present
CloseFile(0)
ProcedureReturn ""
EndIf
*infos.TagV2=AllocateMemory(SizeOf(TagV2))
Size.l = 0
Repeat
; examine All frames
; / Frameheader starts
*frameid = AllocateMemory(5)
ReadData(0,*FrameID, 4) ; Read FrameID (allways 4 chars)
FrameID.s = PeekS(*frameid)
FreeMemory(*frameid)
If Asc(Left(FrameID, 1)) = 0
CloseFile(0)
;ProcedureReturn #True
EndIf
FrameSize = 0
FrameSize = ReadLong(0) ; get framesize ( the framesize is the size of the values excluding the frameheader)
FrameSize = ((FrameSize&$FF)<<24)+((FrameSize&$FF00)<<8)+((FrameSize&$FF0000)>>8)+((FrameSize>>24)&$FF) ; props to a14xerus
Size + FrameSize
ReadByte(0): ReadByte(0) ; Frame Flags (not needed)
If FrameSize < 1 : ProcedureReturn "" : EndIf
; \ Frameheader ends (Frameheader allways 10 Bytes)
Location = Loc(0) + FrameSize ; set 'location'value to end of the actual frame
; / Framebody starts
Select FrameID
Case "USLT"
returntext.s=FrameUSLTreturn(FrameID, FrameSize, *infos)
Break
EndSelect
; \ Framebody ends
FileSeek(0,Location) ; Jump to the end of the frame.
; (if something went wrong nevertheless you are at the right location in the file)
Until Size >= ID3Size ; stop if tag size reached/exceeded
CloseFile(0)
FreeMemory(*infos)
If Len(returntext)>0
ProcedureReturn returntext
Else
ProcedureReturn ""
EndIf
EndIf
EndProcedure
;- WMA start
Structure OneByte
a.b
EndStructure
Procedure.l ConvHex2Dec(HexNumber.s)
*buf = AllocateMemory(StringByteLength(hexnumber, #PB_UTF8)+2);we need to make the string utf8 for when compiled as unicode
PokeS(*buf, HexNumber, -1, #PB_UTF8)
*t.OneByte = *buf;@HexNumber
Result.l = 0
While *t\a <> 0
If *t\a >= '0' And *t\a <= '9'
Result = (Result << 4) + (*t\a - 48)
ElseIf *t\a >= 'A' And *t\a <= 'F'
Result = (Result << 4) + (*t\a - 55)
ElseIf *t\a >= 'a' And *t\a <= 'f'
Result = (Result << 4) + (*t\a - 87)
Else
Result = (Result << 4) + (*t\a - 55)
EndIf
*t + 1
Wend
FreeMemory(*buf)
ProcedureReturn Result
EndProcedure
; Procedure GetLoWord(Long.l)
; ProcedureReturn Long & $FFFF
; EndProcedure
CompilerIf Defined(GUID, #PB_Structure) = 0
Structure GUID
Data1.l
Data2.w
Data3.w
Data4.b[8]
EndStructure
CompilerEndIf
Procedure GUIDStringToStruct(guid.s, *target.GUID)
theguid.s = RemoveString(guid, "-")
*target\Data1 = ConvHex2Dec(Left(theguid, 8))
*target\Data2 = ConvHex2Dec(Mid(theguid, 9, 4))
*target\Data3 = ConvHex2Dec(Mid(theguid, 13, 4))
*target\Data4[0] = ConvHex2Dec(Mid(theguid, 17, 2))
*target\Data4[1] = ConvHex2Dec(Mid(theguid, 19, 2))
*target\Data4[2] = ConvHex2Dec(Mid(theguid, 21, 2))
*target\Data4[3] = ConvHex2Dec(Mid(theguid, 23, 2))
*target\Data4[4] = ConvHex2Dec(Mid(theguid, 25, 2))
*target\Data4[5] = ConvHex2Dec(Mid(theguid, 27, 2))
*target\Data4[6] = ConvHex2Dec(Mid(theguid, 29, 2))
*target\Data4[7] = ConvHex2Dec(Mid(theguid, 31, 2))
EndProcedure
Procedure.s GUIDStructToString(*target.GUID)
outstring.s = "{"
outstring+RSet(Hex(*target\Data1), 8, "0")+"-"
data2.w = *target\Data2
outstring+RSet(Hex(PeekB((@data2)+1)&255), 2, "0")
outstring+RSet(Hex(PeekB(@data2)&255), 2, "0")+"-"
data3.w = *target\Data3
outstring+RSet(Hex(PeekB((@data3)+1)&255), 2, "0")
outstring+RSet(Hex(PeekB(@data3)&255), 2, "0")+"-"
outstring+RSet(Hex(*target\Data4[0]&255), 2, "0")
outstring+RSet(Hex(*target\Data4[1]&255), 2, "0")+"-"
outstring+RSet(Hex(*target\Data4[2]&255), 2, "0")
outstring+RSet(Hex(*target\Data4[3]&255), 2, "0")
outstring+RSet(Hex(*target\Data4[4]&255), 2, "0")
outstring+RSet(Hex(*target\Data4[5]&255), 2, "0")
outstring+RSet(Hex(*target\Data4[6]&255), 2, "0")
outstring+RSet(Hex(*target\Data4[7]&255), 2, "0")
ProcedureReturn outstring+"}"
EndProcedure
Procedure CompareGUIDs(*guid1.guid, *guid2.guid)
If *guid1\Data1 <> *guid2\Data1
ProcedureReturn 0
ElseIf *guid1\Data2 <> *guid2\Data2
ProcedureReturn 0
ElseIf *guid1\Data3 <> *guid2\Data3
ProcedureReturn 0
ElseIf *guid1\Data4[0] <> *guid2\Data4[0]
ProcedureReturn 0
ElseIf *guid1\Data4[1] <> *guid2\Data4[1]
ProcedureReturn 0
ElseIf *guid1\Data4[2] <> *guid2\Data4[2]
ProcedureReturn 0
ElseIf *guid1\Data4[3] <> *guid2\Data4[3]
ProcedureReturn 0
ElseIf *guid1\Data4[4] <> *guid2\Data4[4]
ProcedureReturn 0
ElseIf *guid1\Data4[5] <> *guid2\Data4[5]
ProcedureReturn 0
ElseIf *guid1\Data4[6] <> *guid2\Data4[6]
ProcedureReturn 0
ElseIf *guid1\Data4[7] <> *guid2\Data4[7]
ProcedureReturn 0
EndIf
;all must be ok if we're here
ProcedureReturn 1
EndProcedure
Procedure ReadGUID(file, *target.GUID)
*target\Data1 = ReadLong(file)
*target\Data2 = ReadWord(file)
*target\Data3 = ReadWord(file)
*target\Data4[0] = ReadByte(file)
*target\Data4[1] = ReadByte(file)
*target\Data4[2] = ReadByte(file)
*target\Data4[3] = ReadByte(file)
*target\Data4[4] = ReadByte(file)
*target\Data4[5] = ReadByte(file)
*target\Data4[6] = ReadByte(file)
*target\Data4[7] = ReadByte(file)
EndProcedure
Procedure.s readUnicodeString(fileno, length)
unicodestr.s
If length And (length > 0)
*buf = AllocateMemory(length)
ReadData(fileno, *buf, length)
unicodestr.s = PeekS(*buf, length, #PB_Unicode)
FreeMemory(*buf)
EndIf
ProcedureReturn unicodestr
EndProcedure
Procedure processContentBlock(fileno, *dest.TagV2)
lTitle.w = ReadWord(fileno)
lAuthor.w = ReadWord(fileno)
lCopyright.w = ReadWord(fileno)
lDescription.w = ReadWord(fileno)
lRating.w = ReadWord(fileno)
If lTitle > 0
*dest\title.s = readUnicodeString(fileno, lTitle)
;Debug title
EndIf
If lAuthor > 0
*dest\artist.s = readUnicodeString(fileno, lAuthor)
;Debug artist
EndIf
If lCopyright > 0
copyright.s = readUnicodeString(fileno, lCopyright)
;Debug copyright
EndIf
If lDescription > 0
description.s = readUnicodeString(fileno, lDescription)
;Debug description
EndIf
If lRating > 0
rating.s = readUnicodeString(fileno, lRating)
;Debug rating
EndIf
EndProcedure
Procedure processExtendedContentBlock(fileno, *dest.TagV2)
Dim bValue.b(1);will be redimmed
numAttrs.w = ReadWord(fileno)
For i = 0 To numAttrs - 1
attrName.s = readUnicodeString(fileno, ReadWord(fileno))
dataType.w = ReadWord(fileno)
Select dataType
Case 0;string
strValue.s = readUnicodeString(fileno, ReadWord(fileno))
;Debug attrName+": "+strValue
Select attrName
Case "WM/AlbumTitle"
*dest\album = strValue
Case "WM/Genre"
*dest\genre = strValue
Case "WM/Year"
*dest\year = strValue
Case "WM/TrackNumber", "WM/Track"
If (*dest\track = "0") Or (*dest\track = "") ;we need to look for the track attributes
*dest\track = StringField(strValue, 1, "/");could be n/<total>
EndIf
EndSelect
Case 1;binary(?)
dataLen.w = ReadWord(fileno)
*bindatabuff = AllocateMemory(dataLen)
ReadData(fileno, *bindatabuff, dataLen)
;Debug "binary value captured called "+attrName
;Debug "length: "+Str(dataLen)
;Debug PeekS(*bindatabuff, -1, #PB_Unicode)
FreeMemory(*bindatabuff)
Case 2;bool (?)
dataLen = ReadWord(fileno)
iValue.l = ReadLong(fileno)
If iValue = 0
boolValue = #False
Else
boolValue = #True
EndIf
;Debug attrName+": "+Str(boolValue)
Case 3;long/integer
dataLen = ReadWord(fileno)
iValue.l = ReadLong(fileno)
;Debug attrName+": "+Str(iValue)
If (*dest\track = "0") Or (*dest\track = "") ;we need to look for the track attributes
If attrName = "WM/TrackNumber"
*dest\track = Str(iValue)
ElseIf attrName = "WM/Track"
*dest\track = Str(iValue)
EndIf
EndIf
Case 4;quad
dataLen = ReadWord(fileno)
lValue = ReadQuad(fileno)
;Debug attrName+": "+StrQ(lValue)
Case 5;word
dataLen = ReadWord(fileno)
sValue.w = ReadWord(fileno)
;Debug attrName+": "+Str(sValue)
Default
Debug "Type not known, ending file's tag get.";this has happened on a few of my files... probably malformed file - causes IMA errors if it tries to skip data
;Debug dataType
;Debug *dest\filename
;FileSeek(fileno, Loc(fileno)+ReadWord(fileno)-1)
ProcedureReturn 0;will probably create more problems if the content block comes after the extended content one.
EndSelect
Next i
EndProcedure
;- initialise our guid stuff
Global WMATAG_headerguid.GUID, WMATAG_contentGUID.Guid, WMATAG_extendedContentGUID.Guid, WMATAG_ASF_Header_Extension_Object.GUID
;yes, could be done with a data section.... I did it this way :P
GUIDStringToStruct("75B22630-668E-11CF-A6D9-00AA0062CE6C", @WMATAG_headerguid)
GUIDStringToStruct("75B22633-668E-11CF-A6D9-00AA0062CE6C", @WMATAG_contentGUID)
GUIDStringToStruct("D2D0A440-E307-11D2-97F0-00A0C95EA850", @WMATAG_extendedContentGUID)
GUIDStringToStruct("5FBF03B5-A92E-11CF-8EE3-00C00C205365", @WMATAG_ASF_Header_Extension_Object)
Procedure GetWMATags(*dest.TagV2)
fileno = ReadFile(#PB_Any, *dest\filename)
If fileno = 0
Debug "couldnt open file"
ProcedureReturn 0
EndIf
ReadGUID(fileno, @fileheader.GUID)
If CompareGUIDs(@WMATAG_headerguid, @fileheader);valid file/tag
ReadQuad(fileno);VB comment: ' the size of the entire block
ReadLong(fileno);VB comment: ' the number of entries
ReadWord(fileno); read 2 bytes. VB comment ' two reserved bytes
contentblockdone = 0 : extcontentblockdone = 0
While Eof(fileno) = 0
ReadGUID(fileno, @aGuid.GUID)
sizeBlock.q = ReadQuad(fileno)
If CompareGUIDs(aGuid, WMATAG_contentGUID);is contentblock
processContentBlock(fileno, *dest)
If extcontentblockdone
Break;got all we want, exit from while loop
EndIf
contentblockdone = 1
ElseIf CompareGUIDs(aGuid, WMATAG_extendedContentGUID);is extended contentblock
processExtendedContentBlock(fileno, *dest)
If contentblockdone
Break;got all we want, exit from while loop
EndIf
extcontentblockdone = 1
Else;not one we want, skip it
;Debug "unknown block, size: "+StrQ(sizeBlock)
;Debug GUIDStructToString(aGuid);debug the guid so you can search the ASF spec
sizeBlock - 24 ; already Read the guid header info (sizeof(GUID)+sizeof(QUAD) = 16+8)
currentlyat = Loc(fileno)
If currentlyat+sizeBlock > Lof(fileno)
Break
EndIf
FileSeek(fileno, currentlyat+sizeBlock)
EndIf
Wend
Else
Debug "no tag or invalid file"
EndIf
CloseFile(fileno)
EndProcedure
; Global mp3totaltime.d, mp3count.d;uncomment these and their associates below plus measureinterval (need droopy's lib) to do get a count and total to do averaging.
; Global wmatotaltime.d, wmacount.d
Procedure GetTag(*playlistentry.TagV2)
Protected tagsv1.TagV1
If Not *playlistentry\filename
ProcedureReturn #False
EndIf
If LCase(Right(*playlistentry\filename, 3)) = "mp3"
;mp3count + 1
; MeasureIntervalStart();droopy's lib command
GetID3v2Tag(*playlistentry\filename,*playlistentry) ; read the new Version (ID3v2)
With *playlistentry
If (\title.s = "") Or (\artist.s = "") Or (\album.s = "") Or (\track.s = "");some fields missing
GetID3v1Tag(*playlistentry\filename,@tagsv1)
If Len(tagsv1\title) > Len(\title) : Debug "v2 title: "+\title : Debug "v1 title: "+tagsv1\title : \title = tagsv1\title : EndIf
If Len(tagsv1\artist) > Len(\artist) : \artist = tagsv1\artist : EndIf
If Len(tagsv1\album) > Len(\album) : \album = tagsv1\album : EndIf
If \track = "" : \track = tagsv1\track : EndIf
EndIf
EndWith
;mp3totaltime+MeasureIntervalStop()
ElseIf LCase(Right(*playlistentry\filename, 3)) = "wma"
;wmacount + 1
;MeasureIntervalStart()
GetWMATags(*playlistentry)
;wmatotaltime+MeasureIntervalStop()
EndIf
If *playlistentry\title = "" : *playlistentry\title = GetFilePart(*playlistentry\filename) : EndIf
If *playlistentry\artist = "": *playlistentry\artist = "Unknown Artist" : EndIf
If *playlistentry\album = "": *playlistentry\album = "Unknown Album" : EndIf
EndProcedure
;-Usage
;test.TagV2\filename = "<insert FileName>"
;GetTag(@test)
;MessageRequester("tag", test\title+#CRLF$+test\artist+#CRLF$+test\album)