PureBoard

Code: Alles auswählen

; ID3 Example for PB 4.xx
; Coder: 'a14xerus' (http://www.alexander-n.de)
; with friendly support of 'Padde'
; 06.06.2007
; Reference for ID3v2: http://www.id3.org/id3v2.3.0
EnableExplicit


UseJPEGImageDecoder()
UsePNGImageDecoder()


Structure Tags ; Only a few Tags, a list of all tags on http://www.id3.org
  Title.s     ; "TIT2"
  Artist.s    ; "TPE1"
  Album.s     ; "TALB"
  Year.s      ; ...
  Genre.s
  URL.s
  Copyright.s
  track.s
  image.l
EndStructure

Global Tags.Tags
Global file.s = OpenFileRequester("","","MP3|*.mp3",0)


Procedure GetID3v1Tag(Filename.s,*infos.Tags)
  Protected *mem, header$, Result.l
  If ReadFile(0,Filename)
    *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)
      If header$ = "TAG"                              ;  3 chars
        With *infos
          \Title     = Trim(PeekS(*mem  +   3, 30))   ; 30 chars
          \Artist    = Trim(PeekS(*mem  +  33, 30))   ; 30 chars
          \Album     = Trim(PeekS(*mem  +  63, 30))   ; 30 chars
          \Year      = Trim(PeekS(*mem  +  93,  4))   ;  4 chars
          ; \Comment   = Trim(PeekS(*mem  +  97, 29))   ; 30 chars
          \track     = Trim(PeekS(*mem  + 126,  1))   ;  1 chars
          \Genre     = Trim(PeekS(*mem  + 127,  1))   ;  1 chars
        EndWith
        Result = #True
      EndIf
      FreeMemory(*mem)
    EndIf
    CloseFile(0)
  EndIf
  ProcedureReturn Result
EndProcedure


Procedure frameTXXX(id.s, FrameSize.l, *infos.Tags)
  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)
  ElseIf TextEncoding = 1
    Contents = PeekS(*mem+2,FrameSize-2,#PB_UTF16)
  EndIf
  FreeMemory(*mem)
  
  With *infos
    Select id
      Case "TIT2"
        \Title = Contents
      Case "TPE1"
        \Artist = Contents
      Case "TALB"
        \Album = Contents
      Case "TYER"
        \Year = Contents
      Case "TCON"
        \Genre = Contents
      Case "TCOP"
        \Copyright = Contents
      Case "TRCK"
        \track = Contents
    EndSelect
  EndWith
  ProcedureReturn #True
EndProcedure
Procedure frameWXXX(id.s, FrameSize.l, *infos.Tags)
  Protected Contents.s
  ReadByte(0) ; WXXX Textencoding for Description (URLs are allways ASCII)
  FrameSize - 1
  If FrameSize <= 0
    ProcedureReturn #False
  EndIf
  Contents = Space(FrameSize)
  ReadData(0,@Contents, FrameSize)
  *infos\URL = Contents
  ProcedureReturn #True
EndProcedure
Procedure frameAPIC(id.s, FrameSize.l, *infos.Tags)
  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 GetID3v2Tag(Filename.s,*infos.Tags)
  Protected ID3.s, ID3Size, Byte.l, Size.l, FrameID.s, FrameSize.l, location.l
  If ReadFile(0,Filename)
    ID3.s = Space(3)
    ReadData(0,@ID3, 3)
    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
    
    Size.l = 0
    Repeat
      ; examine All frames
      
      ; / Frameheader starts
      FrameID.s = Space(4) 
      ReadData(0,@FrameID, 4)   ; Read FrameID (allways 4 chars)
      
      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)
      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"
          frameTXXX(FrameID, FrameSize, *infos)
        Case "WXXX"
          frameWXXX(FrameID, FrameSize, *infos)
        Case "APIC"
          frameAPIC(FrameID, FrameSize, *infos)
      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)
  EndIf
EndProcedure
 

Procedure GetID3Tag(Filename.s,*infos.Tags)
  With *infos ; delete the old settings
    \Album = ""
    \Artist = ""
    \Copyright = ""
    \Genre = ""
    \Title = ""
    \track = ""
    \URL = ""
    \Year = ""
    If \image
      FreeImage(\image)
    EndIf
    \image = 0
  EndWith
  
  If Not Filename
    ProcedureReturn #False
  EndIf
  
  GetID3v1Tag(Filename,*infos) ; if there are old ID3v1 Tags, read them out
  GetID3v2Tag(Filename,*infos) ; read the new Version (ID3v2)
EndProcedure
 


GetID3Tag(file,@Tags)

;- DEMO:

With Tags
  Debug "Album: "+\Album
  Debug "Artist: "+\Artist
  Debug "Copyright: "+\Copyright
  Debug "Genre: "+\Genre
  Debug "Title: "+\Title
  Debug "Track: "+\track
  Debug "URL: "+\URL
  Debug "Year: "+\Year
EndWith
If Tags\image
  If OpenWindow(0,0,0,200,200,"")
    If CreateGadgetList(WindowID(0))
      ImageGadget(0,0,0,200,200,ImageID(Tags\image))
      While WaitWindowEvent() <> 16 : Wend
    EndIf
  EndIf
EndIf