Type=Class
Version=2.02
@EndOfDesignText@
'Class module
'**********************************************************
' reads ID3 Metadata (strings and bitmaps) from an mp3 file
' Version 1.1
' 2012/09/10 written by J.Bergmann
'
' Version history
' V 1.1 - 2012/09/26: fixed an error with id3v2.2 tags
'
' Currently this class only reads id3v2.3 and id3v1 tags
' id3v2.4 tags are not fully supported
' id3v2.2 tags are not supported
'**********************************************************
Sub Class_Globals
'Public Properties:
Public Directory As String
Public Filename As String
Public Version As Int
Public Revision As Int
Public Flags As Int
Public TagSize As Long
'------------------
Public Title As String
Public Artist As String
Public Band As String
Public Album As String
Public Year As String
Public Track As String
Public Genre As String
Public Comment As String
Public Copyright As String
Public Bpm As String
'--------------------
Public Frames As Map
Public Pictures As Map
Public Comments As Map
Public OtherData As Map
'--------------------
Public Exists As Boolean
Public Errcode As Int
Public ErrPosition As Long
Public hasPictures As Boolean
'
Type ID3_PictureTypes( _
PIC_OTHER As Int, _
PIC_ICON_PNG32 As Int, _
PIC_ICON As Int, _
PIC_COVER As Int, _
PIC_BACKCOVER As Int, _
PIC_LEAFLET As Int, _
PIC_MEDIA As Int, _
PIC_LEADARTIST As Int, _
PIC_ARTIST As Int, _
PIC_CONDUCTOR As Int, _
PIC_BAND As Int, _
PIC_COMPOSER As Int, _
PIC_TEXTWRITER As Int, _
PIC_LOCATION As Int, _
PIC_RECORDING As Int, _
PIC_PERFORMANCE As Int, _
PIC_MOVIE As Int, _
PIC_FISH As Int, _
PIC_ILLUSTRATION As Int, _
PIC_ARTISTLOGO As Int, _
PIC_COMPANYLOGO As Int)
Public PictureTypes As ID3_PictureTypes
PictureTypes.PIC_OTHER = 0
PictureTypes.PIC_ICON_PNG32 = 1
PictureTypes.PIC_ICON = 2
PictureTypes.PIC_COVER = 3
PictureTypes.PIC_BACKCOVER = 4
PictureTypes.PIC_LEAFLET = 5
PictureTypes.PIC_MEDIA = 6
PictureTypes.PIC_LEADARTIST = 7
PictureTypes.PIC_ARTIST = 8
PictureTypes.PIC_CONDUCTOR = 9
PictureTypes.PIC_BAND = 10
PictureTypes.PIC_COMPOSER = 11
PictureTypes.PIC_TEXTWRITER = 12
PictureTypes.PIC_LOCATION = 13
PictureTypes.PIC_RECORDING = 14
PictureTypes.PIC_PERFORMANCE = 15
PictureTypes.PIC_MOVIE = 16
PictureTypes.PIC_FISH = 17
PictureTypes.PIC_ILLUSTRATION = 18
PictureTypes.PIC_ARTISTLOGO = 19
PictureTypes.PIC_COMPANYLOGO = 20
Type ID3_Encodings( _
ENC_8859_1 As Int, _
ENC_UTF_16 As Int, _
ENC_UTF_16BE As Int, _
ENC_UTF_8 As Int)
Public Encodings As ID3_Encodings
Encodings.ENC_8859_1 = 0
Encodings.ENC_UTF_16 = 1
Encodings.ENC_UTF_16BE = 2
Encodings.ENC_UTF_8 = 3
Type ID3_Frame( _
Name As String, _
Label As String, _
Start As Int, _
Size As Int, _
Flags1 As Int, _
Flags2 As Int, _
Encoding As ID3_Encodings, _
Content As String)
Type ID3_Picture( _
Label As String, _
Start As Long, _
Size As Int, _
Flags1 As Int, _
Flags2 As Int, _
Encoding As Int, _
MimeType As String, _
Picuretype As Int, _
Description As String)
Type ID3_Comment( _
Label As String, _
Encoding As Int, _
Start As Int, _
Size As Int, _
Flags1 As Int, _
Flags2 As Int, _
Language As String, _
Description As String, _
Content As String)
Type ID3_OtherData( _
Name As String, _
Label As String, _
Start As Int, _
Size As Int, _
Flags1 As Int, _
Flags2 As Int, _
Encoding As ID3_Encodings, _
Content As String)
Type ID3_V1( _
Title As String, _
Artist As String, _
Album As String, _
Year As String, _
Comment As String, _
Track As String, _
Genre As String)
Public V1 As ID3_V1
'******************************************************************************
'Private Variables
'******************************************************************************
Private mPicPos As Long
End Sub
'Initializes the ID3 object.
'Dir - mp3 file directory
'Fname - mp3 file name
Public Sub Initialize(Dir As String,fname As String)
Dim raf As RandomAccessFile
Dim pos As Long
Dim i As Int
Dim s As String
Filename = fname
Directory = Dir
mReset
pos = mOpenFile(raf)
If pos <=0 Then Return
hasPictures = False
If Version <3 Then Return
i = mGetAllFrames(raf)
i = mGetAllPictures(raf)
If i > 0 Then hasPictures = True
Title = mMakeSureDataExists(raf, "TIT2", True)
Artist = mMakeSureDataExists(raf, "TPE1", True)
Band = mMakeSureDataExists(raf, "TPE2", True)
Album = mMakeSureDataExists(raf, "TALB", True)
Genre = mMakeSureDataExists(raf, "TCON", False)
If Version = 4 Then
Year = mMakeSureDataExists(raf, "TDRC", False)
Else
Year = mMakeSureDataExists(raf, "TYER", False)
End If
Bpm = mMakeSureDataExists(raf, "TBPM", False)
Track = mMakeSureDataExists(raf, "TRCK", False)
Copyright = mMakeSureDataExists(raf, "TCOP", False)
raf.Close
End Sub
'Reads ID3V1 Information
'dir - mp3 file directory
'fname - mp3 file name
Public Sub ReadVersion1()
Dim raf As RandomAccessFile
Dim charset As String
V1.Initialize
charset="8859-1"
If File.Exists(Directory,Filename)=False Then
Log (Directory & "/" & Filename & " doesn't exist.")
Return
End If
raf.Initialize2(Directory,Filename, True,False)
If raf.Size < 128 Then
Log ("No ID3v1 tag found")
raf.close
Return
End If
Dim buffer(128) As Byte
raf.ReadBytes(buffer, 0, 3, raf.Size - 128)
If BytesToString(buffer, 0, 3, charset) <> "TAG" Then
Log("No ID3v1 tag found.")
Return
Else
Exists = True
End If
'Title
raf.ReadBytes(buffer, 0, 30, raf.CurrentPosition)
V1.Title= mBytesToString(buffer, 30, charset)
'Artist
raf.ReadBytes(buffer, 0, 30, raf.CurrentPosition)
V1.Artist= mBytesToString(buffer, 30, charset)
'Album
raf.ReadBytes(buffer, 0, 30, raf.CurrentPosition)
V1.Album= mBytesToString(buffer, 30, charset)
'Year
raf.ReadBytes(buffer, 0, 4, raf.CurrentPosition)
V1.Year = mBytesToString(buffer, 4, charset)
'Comment
raf.ReadBytes(buffer, 0, 28, raf.CurrentPosition)
V1.Comment= mBytesToString(buffer, 28, charset)
'Track
raf.ReadBytes(buffer, 0, 2, raf.CurrentPosition)
V1.Track= mBytesToString(buffer, 2, charset)
'Genre
V1.Genre = raf.ReadUnsignedByte(raf.CurrentPosition)
raf.Close
End Sub
'returns an attached bitmap
'Pictype - use one of the ID3_Picturetypes constants
'return value - Bitmap or null, if PicType does not exist
Public Sub GetBitmap (PicType As Int) As Bitmap
Dim raf As RandomAccessFile
Dim dir,fname As String
Dim Buffer() As Byte
Dim bmp As Bitmap
Dim ips As InputStream
If Pictures.ContainsKey(PicType) = False Then Return Null
Dim pic As ID3_Picture
pic = Pictures.Get(PicType)
'Read Image From File into byte buffer
Dim raf As RandomAccessFile
raf.Initialize(Directory, Filename, True)
Dim Buffer(pic.Size)As Byte
raf.ReadBytes(Buffer, 0,pic.Size,pic.start)
raf.Close
ips.InitializeFromBytesArray(Buffer,0,Buffer.Length)
bmp.Initialize2(ips)
Return bmp
End Sub
Public Sub Cover() As Bitmap
Dim pic As ID3_Picture
Dim pictype As Int
If hasPictures=False Then Return Null
pictype=PictureTypes.PIC_COVER
If Pictures.ContainsKey(pictype) Then
Return GetBitmap(pictype)
Else
pic=Pictures.Get(0)
Return GetBitmap(pic.Picuretype)
End If
End Sub
'*******************************************************************
'Private Methods:
'*******************************************************************
Private Sub mGetAllFrames(raf As RandomAccessFile) As Int
Dim pos As Long
Dim Buffer(4) As Byte
Dim l,n,x As Int
Dim counter As Int
Dim xsize As Int
Dim s,charset As String
Dim skip As Boolean
Dim isTextFrame As Boolean
pos = 10
Do Until (pos>=TagSize)
Errcode = 0
ErrPosition = 0
Dim frame As ID3_Frame
Dim Other As ID3_OtherData
Dim Buffer(4) As Byte
n = raf.ReadBytes(Buffer,0,4,pos)
Select True
Case (n < 4): Errcode = 1 'EOF
Case (Buffer(0)=0): Errcode = 2 'End of Tag, Padding
Case (Buffer(1)=0): Errcode = 3
Case (Buffer(1)=0): Errcode = 4
Case (Buffer(2)=0): Errcode = 5
End Select
If Errcode > 0 Then Exit
frame.Name=BytesToString(Buffer,0,4,"8859-1")
frame.Start = pos
'Log(frame.Name)
pos=pos+4
'Size:
x = raf.readint(pos)
xsize=x
x = mUnsynchSafe(x)
If (frame.Name <> "APIC") AND (x > 1000) Then
Errcode = 6
Exit
End If
frame.Size = x
'Log(frame.name & " Size: " & frame.size)
pos = pos + 4
'Frame Flag 1:
x = raf.ReadUnsignedByte(pos)
s = Bit.ToBinaryString(x)
'Log(frame.name & " Flags1: " & s)
frame.Flags1=x
pos=pos + 1
'Frame Flag 2:
x = raf.ReadUnsignedByte(pos)
frame.Flags2=x
s = Bit.ToBinaryString(x)
'Log(frame.name & " Flags2: " & s)
pos =pos + 1
'--------------------------------------'End of Header
skip = False
isTextFrame = False
Select True
Case frame.Name.StartsWith("T")
'Text Frame
isTextFrame = True
Case (frame.Name="COMM")
'More than 1 comment possible
Dim cm As ID3_Comment
cm.Start=frame.Start
cm.Size=frame.Size
cm.Flags1=frame.Flags1
cm.Flags2=frame.Flags2
'In the real world there is a lot of garbage in the comment frame
'Encoding byte:
x=raf.ReadUnsignedByte(pos)
'Log(frame.Name & " Encoding: " & x)
charset = mGetCharset(x)
cm.Encoding = x
pos = pos + 1
'Comment Language
Dim Buffer(3) As Byte
raf.ReadBytes(Buffer,0, 3,pos)
s=mBytesToString2(Buffer, 3,"8859-1")
cm.Language=s
pos=pos +3
'Comment Description skipped
'because of garbage
cm.Description = ""
cm.Label = mFrameLabel("COMM")
'Comment Content:
x=frame.start + 10 + frame.Size - pos
If x > 0 Then
Dim Buffer(x)As Byte
raf.ReadBytes(Buffer,0, x,pos)
'Encoding byte in Comments contains often garbage. Use "8859-1" instead
s=mBytesToString2(Buffer, x,"8859-1")
cm.Content = s
Else
cm.Content = ""
End If
If Comment = "" Then Comment = cm.Content
Comments.Put(cm.Language,cm)
pos = frame.Start + 10 + frame.Size
counter = counter +1
Case (frame.Name = "IPLS") 'Involved People List
isTextFrame = True
Case (frame.Name = "UFID") 'Unique File Identifier
'skip
Other.Content = "Unique File Identifyer (binary Data)"
skip = True
Case (frame.Name = "ETCO") 'Event Timing Codes
'skip
Other.Content = "Event Timing Codes"
skip = True
Case (frame.Name = "MLLT") 'MPEG Location Lookup Table
Other.Content = "MPEG Location Lookup Table"
skip = True
Case (frame.Name = "SYTC") 'Synchronised tempo code
Other.Content = "Synchronised tempo table"
skip = True
Case (frame.Name = "USLT") 'Unsynchronised Lyrics
'To do
Other.Content = "Unsynchronised Lyrics"
skip = True
Case (frame.Name = "SYLT") 'Synchronised lyrics
'To do
Other.Content = "Synchronised lyrics"
skip = True
Case (frame.Name= "MCDI") 'Audio CD TOC as Binary Data
Other.Content="<Audio CD TOC (binary Data)"
skip = True
Case (frame.Name = "GEOB") 'General encapsulated object
Other.Content = "General encapsulated Object (binary Data)"
skip = True
Case (frame.Name = "PCNT") 'Play Counter
'skip
Other.Content = "Playcounter"
skip = True
Case (frame.Name = "POPM")'Popularimeter
Other.Content = "Popularimeter"
skip = True
Case (frame.Name = "RBUF")'Recommended Buffer Size
Other.Content = "Recommended buffer size"
skip = True
Case (frame.Name = "AENC")
Other.Content = "Audio encryption"
skip = True
Case (frame.Name = "POSS")
Other.Content = "Position information frame"
skip = True
Case (frame.Name = "USER")
Other.Content = "Terms of use"
skip = True
Case (frame.Name = "OWNE")
Other.Content = "Ownership frame"
skip = True
Case (frame.Name = "COMR")
Other.Content = "Commercial frame"
skip = True
Case (frame.Name = "ENCR")
Other.Content = "Encryption method"
skip = True
Case (frame.Name = "GRID")
Other.Content = "Group Identification"
skip = True
Case (frame.Name = "PRIV")
Other.Content = "Private Frame"
skip = True
Case (frame.Name = "RVAD")
Other.Content = "Relative volume adjustment"
skip = True
Case (frame.Name = "RVA2")'Version 4
Other.Content = "Relative volume adjustment"
skip = True
Case (frame.Name = "EQUA")
Other.Content = "Equalisation settings"
skip = True
Case (frame.Name = "EQU2")'Version 4
Other.Content = "Equalisation settings"
skip = True
Case (frame.Name = "RVRB")
Other.Content = "Reverb settings"
skip = True
Case (frame.Name ="APIC")
'APIC Frames are handled in mGetAllPictures
If mPicPos =0 Then mPicPos = frame.start
pos = frame.Start + 10 + xsize
Case (frame.Name.StartsWith("W"))'URL
x=frame.start + 10 + frame.Size - pos
If x>0 Then
Dim Buffer(x)As Byte
raf.ReadBytes(Buffer,0, x,pos)
s=mBytesToString2(Buffer, x,"8859-1")
Else
s = ""
End If
frame.Content=s
frame.Label = mFrameLabel(frame.Name)
Frames.Put(frame.Name,frame)
''Log (frame.Name & " Content: " & frame.content)
pos = frame.Start + 10 + frame.Size
counter = counter +1
Case (frame.Name = "LINK")
Other.Content = "Linked Information"
skip = True
Case (frame.Name = "SIGN")
Other.Content = "Group Signature (binary Data)"
skip = True
Case (frame.Name = "ASPI")
Other.Content = "Audio Seek Point"
skip = True
Case (frame.Name.StartsWith("X"))
Other.Content = "Experimental Frame"
skip = True
Case (frame.Name.StartsWith("Y"))
Other.Content = "Experimental Frame"
skip = True
Case (frame.Name.StartsWith("Z"))
Other.Content = "Experimental Frame"
skip = True
Case Else
'Unknown
Other.Content = "unknown"
skip = True
End Select
If skip = True Then
Other.Name=frame.Name
Other.Label=mFrameLabel(Other.Name)
Other.Encoding=frame.Encoding
Other.Start=frame.Start
Other.Flags1=frame.Flags1
Other.Flags2=frame.Flags2
OtherData.Put(Other.Name,Other)
''Log (Other.Name & " Content: " & Other.content)
pos = frame.Start + 10 + frame.Size
End If
If isTextFrame = True Then
'Standard Text Frame
'Encoding:
x=raf.ReadUnsignedByte(pos)
charset=mGetCharset(x)
pos = pos + 1
'Content
s= mReadString(raf,pos,frame.Size-1,charset)
If frame.Name = "TCOP" Then s = "Copyright © " & s
frame.Content = s
frame.Label = mFrameLabel(frame.Name)
Frames.Put(frame.Name,frame)
''Log (frame.Name & " Content: " & frame.content)
pos = frame.Start + 10 + frame.Size
counter = counter +1
End If
Loop
If Errcode > 0 Then
If Errcode = 2 Then
Errcode = 0
Else
ErrPosition = pos
End If
End If
Return counter
End Sub
Private Sub mGetAllPictures(raf As RandomAccessFile) As Int
Dim pos, pos1, FrameStart, offset As Long
Dim psize As Int
Dim Buffer() As Byte
Dim mimetype As String
Dim x As Int
Dim enc As Int
Dim description As String
Dim isURL As Boolean
Dim url As String
Dim counter As Int
Dim charset As String
pos = mPicPos
pos = mSeekString(raf, pos, 1000, "APIC", "")
If pos<=0 Then Return 0
Do Until (pos >= TagSize)
Dim pic As ID3_Picture
pos=mSeekString(raf, pos, 1, "APIC","")
If pos<=0 Then Exit
pic.Start = pos
'Picture Size:
pos = pos + 4
psize = raf.readint(pos)
'psize=mUnSynchsafe(psize)
''Log("psize1: " & psize)
pos = pos + 4'Size
x = raf.ReadUnsignedByte(pos)
pic.Flags1 = x
pos = pos + 1
x=raf.ReadUnsignedByte(pos)
pic.Flags2 = x
pos = pos + 1'Flags
'---------------End of Header
FrameStart = pos
'Encoding
enc = raf.ReadUnsignedByte(pos)
charset = mGetCharset(enc)
pic.Encoding = enc
pos = pos + 1
'mime type: image/jpeg image/png
Dim Buffer(128)As Byte
raf.ReadBytes(Buffer,0, 128,pos)
mimetype = mBytesToString(Buffer, 128,"8859-1")
pos = pos + mimetype.Length
If mimetype ="-->" Then
isURL = True
'URL instead of picture
End If
'Terminator Byte(&0)
x = raf.ReadUnsignedByte(pos)
'should be &00
''Log(x)
'Picture Type
pos = pos + 1
x = raf.ReadUnsignedByte(pos)
pic.Picuretype=x
''Log(x)
'Log("PictureType: " & x)
'Seek terminator byte &00 after optional image description
'Description
pos =pos+1
Dim Buffer(64)As Byte
raf.ReadBytes(Buffer,0, 64,pos)
description=mBytesToString(Buffer, 64,charset)
pos=pos + description.length'Encoding of Image Description
pic.description = description
''Log ("Description: " & description)
'''Log ("MimeType: " & mimetype)
pos=mSeekByte(raf,pos,psize,0)
pos=pos+1
x=raf.ReadUnsignedByte(pos)
'Should be &FF
''Log(x)
offset=pos-FrameStart
psize=psize-offset
pic.Start = pos
pic.Size = psize
pic.Label = mPictureLabel(pic.Picuretype)
Pictures.Put(pic.Picuretype,pic)
counter = counter + 1
pos=pos+psize
Loop
Return counter
End Sub
Private Sub mFrameLabel(FrameName As String) As String
Dim l As String
Select FrameName
'most important frames first
Case "TIT2": l = "Title"
Case "TPE1": l = "Artist"
Case "TPE2": l = "Band"
Case "TALB": l = "Album"
Case "TCON": l = "Genre"
Case "TBPM": l = "Beats per minute"
Case "TRCK": l = "Track"
Case "TYER": l = "Year"
Case "COMM": l = "Comment"
Case "AENC": l = "Audio encryption"
Case "APIC": l = "Attached picture"
Case "COMR": l = "Commercial frame"
Case "ENCR": l = "Encryption method registration"
Case "EQUA": l = "Equalization"
Case "ETCO": l = "Event timing codes"
Case "GEOB": l = "General encapsulated Object"
Case "GRID": l = "Group identification registration"
Case "IPLS": l = "Involved people List"
Case "LINK": l = "Linked information"
Case "MCDI": l = "Music CD identifier"
Case "MLLT": l = "MPEG location lookup table"
Case "OWNE": l = "Ownership frame"
Case "PRIV": l = "Private frame"
Case "PCNT": l = "Play counter"
Case "POPM": l = "Popularimeter"
Case "POSS": l = "Position synchronisation frame"
Case "RBUF": l = "Recommended buffer size"
Case "RVAD": l = "Relative volume adjustment"
Case "RVRB": l = "Reverb"
Case "SYLT": l = "Synchronized lyric/text"
Case "SYTC": l = "Synchronized tempo codes"
Case "TCOM": l = "Composer"
Case "TCOP": l = "Copyright message"
Case "TDAT": l = "Date"
Case "TDLY": l = "Playlist delay"
Case "TENC": l = "Encoded by"
Case "TEXT": l = "Lyricist/Text writer"
Case "TFLT": l = "File Type"
Case "TIME": l = "Time"
Case "TIT1": l = "Content group description"
Case "TIT3": l = "Subtitle/Description refinement"
Case "TKEY": l = "Initial key"
Case "TLAN": l = "Language"
Case "TLEN": l = "Length"
Case "TMED": l = "Media Type"
Case "TOAL": l = "Original album/movie/show title"
Case "TOFN": l = "Original filename"
Case "TOLY": l = "Original lyricist(s)/text writer(s)"
Case "TOPE": l = "Original artist(s)/performer(s)"
Case "TORY": l = "Original release year"
Case "TOWN": l = "File owner/licensee"
Case "TPE2": l = "Band/orchestra/accompaniment"
Case "TPE3": l = "Conductor/performer refinement"
Case "TPE4": l = "Interpreted, remixed, OR otherwise modified by"
Case "TPOS": l = "Part of a set"
Case "TPUB": l = "Publisher"
Case "TRDA": l = "Recording dates"
Case "TRSN": l = "Internet radio station name"
Case "TRSO": l = "Internet radio station owner"
Case "TSIZ": l = "Size"
Case "TSRC": l = "ISRC (international standard recording code)"
Case "TSSE": l = "Software/Hardware/Encoding settings"
Case "TXXX": l = "User defined text information frame"
Case "UFID": l = "Unique File identifier"
Case "USER": l = "Terms of use"
Case "USLT": l = "Unsychronized lyric/text transcription"
Case "WCOM": l = "Commercial information webpage"
Case "WCOP": l = "Copyright/Legal information webpage"
Case "WOAF": l = "Official audio File webpage"
Case "WOAR": l = "Official artist/performer webpage"
Case "WOAS": l = "Official audio source webpage"
Case "WORS": l = "Official internet radio station homepage"
Case "WPAY": l = "Payment webpage"
Case "WPUB": l = "Publishers official webpage"
Case "WXXX": l = "User defined URL link frame"
'New ID3v2.4 Frames
Case "ASPI": l = "Audio seek point index"
Case "EQU2": l = "Equalisation(2)"
Case "RVA2": l = " Relative volume adjustment(2)"
Case "SEEK": l = "Seek frame"
Case "SIGN": l = "Signature frame"
Case "TDEN": l = "Encoding time"
Case "TDOR": l = "Original release time"
Case "TDRC": l = "Recording time"
Case "TDRL": l = "Release time"
Case "TDTG": l = "Tagging time"
Case "TIPL": l = "Involved people List"
Case "TMCL": l = "Musician credits List"
Case "TMOO": l = "Mood"
Case "TPRO": l = "Produced notice"
Case "TSOA": l = "Album sort order"
Case "TSOP": l = "Performer sort order"
Case "TSOT": l = "Title sort order"
Case "TSST": l = "Set subtitle"
Case Else: l = "unknown"
End Select
Return l
End Sub
Private Sub mPictureLabel(x As Int) As String
Dim l As String
Select x
Case PictureTypes.PIC_ARTIST: l = "Artist"
Case PictureTypes.PIC_ARTISTLOGO: l = "Artist Logo"
Case PictureTypes.PIC_BACKCOVER: l = "Backcover"
Case PictureTypes.PIC_BAND: l = "Band"
Case PictureTypes.PIC_COMPANYLOGO: l = "Company Logo"
Case PictureTypes.PIC_COMPOSER: l = "Composer"
Case PictureTypes.PIC_CONDUCTOR: l = "Conductor"
Case PictureTypes.PIC_COVER: l = "Cover"
Case PictureTypes.PIC_FISH: l = "Fish"
Case PictureTypes.PIC_ICON: l = "Other icon"
Case PictureTypes.PIC_ICON_PNG32: l = "Icon 32*32 png"
Case PictureTypes.PIC_ILLUSTRATION: l = "Illustration"
Case PictureTypes.PIC_LEADARTIST: l = "Leadartist"
Case PictureTypes.PIC_LEAFLET: l = "Leaflet"
Case PictureTypes.PIC_LOCATION: l = "Location"
Case PictureTypes.PIC_MEDIA: l = "Media"
Case PictureTypes.PIC_MOVIE: l = "Movie"
Case PictureTypes.PIC_OTHER: l = "Other"
Case PictureTypes.PIC_PERFORMANCE: l = "Performance"
Case PictureTypes.PIC_RECORDING: l = "Recording"
Case PictureTypes.PIC_TEXTWRITER: l = "Textwriter"
Case Else: l = "unknown"
End Select
Return l
End Sub
Private Sub mMakeSureDataExists(raf As RandomAccessFile, Framename As String, seek As Boolean)
Dim s As String
Dim f As ID3_Frame
If Frames.ContainsKey(Framename) Then
f = Frames.Get(Framename)
s = f.Content
Else
If (Errcode > 0) AND (seek = True) Then
'if ID3 Tag had Errors, try to get single Frame
s = mGetTextFrame(raf,0,Framename)
End If
End If
Return s
End Sub
Private Sub mOpenFile(raf As RandomAccessFile) As Long
Dim pos As Long
If File.Exists(Directory, Filename)=False Then
'Log (Dir & "/" & fname & " doesn't exist.")
Return -1
End If
raf.Initialize2(Directory, Filename, True,False)
If raf.Size < 3 Then
'Log ("No ID3 Tag found")
raf.close
Return 0
End If
pos=mReadHeader(raf)
If pos<=0 Then
'Log ("No ID3 Tag found")
Return 0
End If
Return pos
End Sub
Private Sub mReadHeader(raf As RandomAccessFile) As Long
Dim buffer(3) As Byte
Dim s As String
Dim x As Int
Dim pos As Long
raf.ReadBytes(buffer,0,3,0)
s = mBytesToString(buffer,3,"8859-1")
If s <> "ID3" Then
raf.close
Return -1
Else
Exists = True
End If
Version = raf.ReadUnsignedByte(3)
Revision = raf.ReadUnsignedByte(4)
Flags = raf.ReadUnsignedByte(5)
s = Bit.ToBinaryString(Flags)
'Log ("Flags:" & s)
x =raf.ReadInt(6)
'Log("TagSize before conversion: " & x)
x=mUnsynchSafe(x)
TagSize = x + 10 'plus Header Size
Log("TagSize: " & TagSize)
If mCheckTagSize(raf, TagSize)=False Then
'this will take a while
TagSize=mSeekMP3Frame(raf,TagSize-1000)
End If
Return 11
End Sub
Private Sub mReset
Version = 0
Revision = 0
Flags = 0
TagSize = 0
Album = ""
Artist = ""
Title = ""
Year = ""
Track = ""
Genre = ""
Comment = ""
Copyright = ""
Bpm = ""
Exists = False
Errcode=0
ErrPosition = 0
mPicPos = 0
Frames.Initialize
Pictures.Initialize
Comments.Initialize
OtherData.Initialize
V1.Initialize
End Sub
Private Sub mCheckTagSize(raf As RandomAccessFile, size As Long) As Boolean
Dim x As Int
x=raf.ReadUnsignedByte(size)
If x=0xFF Then ' = 1111 1111
x=raf.ReadUnsignedByte(size+1)
If x>=0xE0 Then '>= 1110 0000
'mpeg frame found
Return True
Else
Errcode = 7 'Wrong id3 tag size found
ErrPosition = size
End If
End If
End Sub
Private Sub mGetTextFrame(raf As RandomAccessFile,StartOffset As Long,FrameName As String) As String
Dim pos As Long
Dim l As Int
Dim x As Int
Dim s As String
Dim charset As String
Dim offset As Int
Dim maxbytes As Int
maxbytes = 5000
pos = mSeekString(raf, StartOffset,maxbytes,FrameName,"8859-1")
If pos <= 0 Then Return ""
'Size:
l=raf.readint(pos+4)
l=mUnsynchSafe(l)
'Frame Flags:
x=raf.ReadUnsignedByte(pos+8)
x=raf.ReadUnsignedByte(pos+9)
'Encoding:
x=raf.ReadUnsignedByte(pos+10)
s=Bit.ToBinaryString(x)
'Log(FrameName & " Encoding: " & s)
Select x
Case 0: charset="8859-1"
Case 1: charset="UTF-16"
Case 2: charset="UTF-16BE"
Case 3: charset="UTF-8"
Case Else: charset="UTF-8"
End Select
offset = 11
'String:
s = mReadString(raf,pos+offset,l-1,charset)
'Log (FrameName & " Value: " & s)
Return s
End Sub
Private Sub mFindPicture(raf As RandomAccessFile) As Boolean
Dim pos As Long
pos = mSeekString(raf, 0, TagSize, "APIC","")
If pos > 0 Then Return True
End Sub
Private Sub mGetCharset(enc As Int) As String
Select enc
Case Encodings.ENC_UTF_16
Return "UTF-16"
Case Encodings.ENC_UTF_16BE
Return "UTF-16BE"
Case Encodings.ENC_UTF_8
Return "UTF-8"
Case Else
Return "8859-1"
End Select
End Sub
Private Sub mSeekByte(raf As RandomAccessFile,pos As Long,maxsteps As Int, value As Int) As Long
Dim x As Int
Do Until (pos >= pos+maxsteps)
x = raf.ReadUnsignedByte(pos)
If x = value Then Return pos
pos = pos + 1
Loop
Return -1
End Sub
Private Sub mSeekBytePattern(raf As RandomAccessFile,pos As Long,maxsteps As Long,values() As Byte) As Long
Dim i, x, len, success As Int
len = values.Length
Dim buffer(len) As Byte
Do Until pos >= (pos + maxsteps)
x = raf.ReadBytes(buffer,0,len,pos)
If x < len Then Return 0
If buffer(0) = values(0) Then
For i = 1 To len-1
If buffer(i) = values(i) Then
success=i
End If
Next
If success=len-1 Then Return pos
End If
pos = pos +1
Loop
End Sub
Private Sub mSeekMP3Frame(raf As RandomAccessFile,pos As Long) As Long
Dim x As Int
Dim maxsteps As Long
maxsteps = raf.size
If pos < 0 Then pos = 0
Do While (pos < maxsteps)
x=raf.ReadUnsignedByte(pos)
If x = 0xFF Then ' = 1111 1111
x = raf.ReadUnsignedByte(pos + 1)
If x >= 0xE0 Then '>= 1110 0000
'mpeg frame start found
Return pos
End If
End If
pos=pos + 1
Loop
Return -1 'no success
End Sub
Private Sub mBytesToString(Buffer() As Byte, MaxLength As Int,charset As String) As String
Dim s As String
For i = 0 To MaxLength - 1
If Buffer(i) = 0 Then
s= BytesToString( Buffer, 0, i, charset)
Return s.Trim
End If
Next
s= BytesToString(Buffer, 0, MaxLength, charset)
Return s.trim
End Sub
Private Sub mBytesToString2(Buffer() As Byte,maxlength As Int,charset As String) As String
Dim s As String
For i = 0 To maxlength - 1
If Buffer(i) < 32 Then Buffer(i) = 32
If Buffer(i) > 253 Then Buffer(i) = 32
Next
s= BytesToString(Buffer, 0, maxlength, charset)
Return s.Trim
End Sub
Private Sub mSeekString(raf As RandomAccessFile, StartOffset As Long, maxbytes As Long, seeked As String, charset As String) As Long
Dim s As String
Dim l As Int
Dim pos As Long
Dim n As Int
If charset = "" Then charset="8859-1"
pos = StartOffset
l = seeked.Length
Dim b(l) As Byte
n = l
Do Until (n < l)
n = raf.ReadBytes(b,0,l,pos)
If (n < l) Then Return -1
s = BytesToString(b, 0, l, charset)
If s = seeked Then Return pos
pos = pos + 1
If pos > maxbytes Then Return -1
Loop
Return -1 'no success
End Sub
Private Sub mReadString(raf As RandomAccessFile, pos As Long, l As Int, charset As String) As String
Dim b(l) As Byte
Dim n As Int
Dim s As String
n = raf.ReadBytes(b,0, l,pos)
s = BytesToString(b,0,l,charset)
Return s
End Sub
Private Sub mSynchSafe(In As Int) As Int
Dim out, mask As Int
mask = 0x7F
Do While Bit.Xor(mask, 0x7FFFFFFF) <> 0
out = Bit.And(In, Bit.Not(mask))
out = Bit.ShiftLeft(out, 1)
out = Bit.Or(out, Bit.And(In, mask))
mask = Bit.ShiftLeft(mask + 1, 8) - 1
In = out
Loop
Return out
End Sub
Private Sub mUnsynchSafe(In As Int) As Int
Dim out, mask As Int
mask = 0x7F000000
Do While mask <> 0
out = Bit.ShiftRight(out, 1)
out = Bit.Or(out, Bit.And(In, mask))
mask = Bit.ShiftRight(mask, 8)
Loop
Return out
End Sub