Simple ID3 tag reader in only FreeBASIC (no FMOD needed)

[squall4226]

Yeah this is a very simple, somewhat slow ID3 tag reader. It is from my LHMP, but I thought it might be useful to some so here it is. The version in my LHMP also has an album art function but it is kinda hackish. I will add it here later when it is more acceptable.

Anyway, of course you can use FMOD to read ID3 tags but what if you don't want to use FMOD or any other library? Also I discovered that sometimes FMOD gets confused and returns data that is truncated and incomplete. Anyway, this is a solution that uses only FreeBASIC code. It is not like zoom fast or anything but it gets the job done. Currently it is only searching/reading ID3 v2. It has a feature that lets you search for tags by a more sensible name, like "Title" instead of "TIT2" Note that only some of the tags have word based names associated with them, but the code will still find any tag you tell it to find as long as it is four characters and exists in the mp3. Anyway, here it is. As usual sorry if the formatting got screwed up by the code box.

~Blyss

Code: Select all

Function getmp3tag(searchtag As String, fn As String) As String
	'so we can avoid having the user need TALB for album, TIT2 for title etc, although they are accepted
	Dim As Integer skip, offset' in order to read certain things right
	Dim As UInteger sig_to_find, count, fnum, maxcheck = 100000
	dim as UShort tag_length
	Dim As UShort unitest, mp3frametest
	Dim As String tagdata


	Select Case UCase(searchtag)
		Case "HEADER", "ID3"
			searchtag = "ID3" & Chr(&h03)
			
		Case "TITLE", "TIT2"
			searchtag = "TIT2"

		Case "ARTIST", "TPE1"
			searchtag = "TPE1"

		Case "ALBUM", "TALB"
			searchtag = "TALB"

		Case "COMMENT", "COMM"
			searchtag = "COMM"

		Case "COPYRIGHT", "TCOP"
			searchtag = "TCOP"

		Case "COMPOSER", "TCOM"
			searchtag = "TCOM"

		Case "BEATS PER MINUTE", "BPM", "TPBM"
			searchtag = "TBPM"

		Case "PUBLISHER", "TPUB"
			searchtag = "TPUB"

		Case "URL", "WXXX"
			searchtag = "WXXX"

		Case "PLAY COUNT" "PCNT"
			searchtag = "PCNT"

		Case "GENRE", "TCON"
			searchtag = "TCON"

		Case "ENCODER", "TENC"
			searchtag = "TENC"

		Case "TRACK", "TRACK NUMBER", "TRCK"
			searchtag = "TRCK"

		Case "YEAR", "TYER"
			searchtag = "TYER"
		
		'Special, in this case we will return the datasize if present, or "-1" if no art
		Case "PICTURE", "APIC"
			searchtag = "APIC"
			'Not implemented yet!

		Case Else
			'Tag may be invalid, but search anyway, there are MANY tags, and we have error checking

	End Select

	fnum = FreeFile
	Open fn For Binary Access Read As #fnum
	If Lof(fnum) < maxcheck Then maxcheck = Lof(fnum)
	For count = 0 to maxcheck Step 1
		Get #fnum, count, sig_to_find
		If sig_to_find = Cvi(searchtag) Then
			
			If searchtag = "ID3" & Chr(&h03) Then
				Close #fnum
				Return "1" 'Because there is no data here, we were just checking for the ID3 header
			EndIf
					'test for unicode
			Get #fnum, count+11, unitest
			
			If unitest = &hFEFF Then 'unicode string
				skip = 4
				offset = 13
				
			Else 'not unicode string
				skip = 0
				offset = 10
				
			EndIf
			
			Get #fnum, count +7, tag_length 'XXXXYYYZZ Where XXXX is the TAG, YYY is flags or something, ZZ is size

			If tag_length-skip < 1 Then
				Close #fnum
				Return "ERROR" 'In case of bad things
			EndIf
			
			Dim As Byte dataget(1 To tag_length-skip)
			Get #fnum, count+offset, dataget()
			
			For i As Integer = 1 To tag_length - skip
				If dataget(i) <> 0 Then tagdata + = Chr(dataget(i)) 'remove null spaces from ASCII data in UNICODE string
			Next
		End If
			If tagdata <> "" then exit For ' stop searching!
	Next
	Close #fnum
	
	If Len(tagdata) = 0 Then 
		'If the tag was just not found or had no data then "----"
		tagdata = "----"
	EndIf
	Return tagdata
End Function

[thrive4]

Well it's been a while but I would be remiss...
I would like to thank you for sharing your code
I have been using it in a mini app, which hopefully,
I'll put on the forum under projects.

Never the less great code I've tried bass but got stuck with the pointer:
https://www.un4seen.com/doc/#bass/BASS_ ... tTags.html
sdl mixer fares better but also the cover art is a nogo:
https://wiki.libsdl.org/SDL_mixer/CategoryAPI

Plus quite a number of tags, in both dlls,
can not be queried.. but can with your code
so a tip of the hat!

> The version in my LHMP also has an album art function but it is kinda hackish

Know what you mean I've tried something along these lines
(gets funky real fast specifically since a mp3 can have multiple
images included...):

Code: Select all

' attempt to extract and write cover art of mp3 to temp thumb file
Function getmp3cover(filename As String) As boolean
    Dim buffer  As String
    dim chunk   as string
    dim length  as string
    dim bend    as integer
    dim ext     as string = ""
    dim thumb   as string
    ' remove old thumb if present
    delfile(exepath + "\thumb.jpg")
    delfile(exepath + "\thumb.png")
    Open filename For Binary Access Read As #1
        If LOF(1) > 0 Then
            buffer = String(LOF(1), 0)
            Get #1, , buffer
        End If
    Close #1
    if instr(1, buffer, "APIC") > 0 then
        length = mid(buffer, instr(buffer, "APIC") + 4, 4)
        ' ghetto check funky first 4 bytes signifying length image
        ' not sure how reliable this info is
        ' see comment codecaster https://stackoverflow.com/questions/47882569/id3v2-tag-issue-with-apic-in-c-net
        if val(asc(length, 1) & asc(length, 2)) = 0 then
            bend = (asc(length, 3) shl 8) or asc(length, 4)
        else
            bend = val(((asc(length, 1) shl 8) or asc(length, 2)) & ((asc(length, 3) shl 8) or asc(length, 4)))
        end if
        if instr(1, buffer, "JFIF") > 0 then
            chunk = mid(buffer, instr(buffer, "JFIF") - 6, bend)
            ext = ".jpg"
        end if
        ' use ext to catch false png
        if instr(1, buffer, "‰PNG") > 0 and ext = "" then
            chunk = mid(buffer, instr(buffer, "‰PNG"), bend)
            ext = ".png"
        end if
        buffer = ""
        Close #1
        ' attempt to write thumbnail to temp file
        if ext <> "" then
            thumb = exepath + "\thumb" + ext
            open thumb for Binary Access Write as #1
                put #1, , chunk
            close #1
        else
            ' no cover art in mp3 optional use folder.jpg if present as thumb
        end if
        return true
    else
        ' no cover art in mp3 optional use folder.jpg if present as thumb
        logentry("warning", "no cover art found in: " + filename)
        return false
    end if
end function

See:
viewtopic.php?t=32040