Native (80% anyway) Cross Platform mp3/wma tag reader

Share your advanced PureBasic knowledge/code with the community.
lexvictory
Addict
Addict
Posts: 1027
Joined: Sun May 15, 2005 5:15 am
Location: Australia
Contact:

Native (80% anyway) Cross Platform mp3/wma tag reader

Post by lexvictory »

Just some code I've been sitting on for a while 8) so it might be a bit smelly...
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 :evil:) - compiled by me in Visual Studio
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 :lol:

Enjoy :wink:

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)
Demonio Ardente

Currently managing Linux & OS X Tailbite
OS X TailBite now up to date with Windows!
localmotion34
Enthusiast
Enthusiast
Posts: 665
Joined: Fri Sep 12, 2003 10:40 pm
Location: Tallahassee, Florida

Post by localmotion34 »

That is some good stuff!


2 Questions though:


1) did you fix the issue Trond raised with my update to the code where trash was added to the end of strings as well as the unicode issue?


2) Why do you use tag_c.lib and not tag.lib? What is the difference between Tag.dll and Tag_c.dll? They dont seem to depend on each other and neither do the import libs. What DLLs do you actually need to use the import lib?

Code: Select all

!.WHILE status != dwPassedOut
! Invoke AllocateDrink, dwBeerAmount
!MOV Mug, Beer
!Invoke Drink, Mug, dwBeerAmount
!.endw
lexvictory
Addict
Addict
Posts: 1027
Joined: Sun May 15, 2005 5:15 am
Location: Australia
Contact:

Post by lexvictory »

localmotion34 wrote:1) did you fix the issue Trond raised with my update to the code where trash was added to the end of strings as well as the unicode issue?
Not sure of the issue in question...
For UTF-16 encoded fields there was garbage at the end of the string, fixed that (there is a comment the source about it)
That what you mean?

And yes, it does work in unicode mode.
localmotion34 wrote:Why do you use tag_c.lib and not tag.lib? What is the difference between Tag.dll and Tag_c.dll? They dont seem to depend on each other and neither do the import libs. What DLLs do you actually need to use the import lib?
Not sure myself, just the version of the x86 windows port I have is like that...
I don't have a tag.lib import library.
I have both the tag.dll and tag_c.dll that came in the package, but I've never separated them to see if both are needed.
Demonio Ardente

Currently managing Linux & OS X Tailbite
OS X TailBite now up to date with Windows!
Karbon
PureBasic Expert
PureBasic Expert
Posts: 2010
Joined: Mon Jun 02, 2003 1:42 am
Location: Ashland, KY
Contact:

Re: Native (80% anyway) Cross Platform mp3/wma tag reader

Post by Karbon »

Has anyone tried to compile this on OSX?

I have taglib installed but the linker doesn't seem to recognize the MACH format :

I changed this line :

Code: Select all

ImportC "/usr/local/lib/libtag.dylib" 
(it was importing the .so for Linux)

I get the error "libtag.dynlib, file is not of required architecture"
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
lexvictory
Addict
Addict
Posts: 1027
Joined: Sun May 15, 2005 5:15 am
Location: Australia
Contact:

Re: Native (80% anyway) Cross Platform mp3/wma tag reader

Post by lexvictory »

Karbon wrote:"libtag.dynlib, file is not of required architecture"
sounds more like its saying its a PPC lib and you're compiling for Intel (or vice versa) to me... (all libs are mach-o on OSX)
Demonio Ardente

Currently managing Linux & OS X Tailbite
OS X TailBite now up to date with Windows!
Post Reply