Below you'll find the source for the Visual Basic 6 function id3v2_get_tag.
Attribute VB_Name = "modId3v2GetTag"
' These functions are downloaded from:
' http://www.stefanthoolen.nl/archive/vb6-functions/
'
' You may freely distribute this file but please leave all comments, including this one, in it.
'
' @Author Stefan Thoolen <mail@stefanthoolen.nl>
Option Explicit
' ID3v2 tag frame
Private Type id3v2_tag_frame
frame_id As String * 4
framesize As String * 4
flag_byte1 As Byte
flag_byte2 As Byte
End Type
' Used to send back the ID3 tag to the application
' This is different from id3v2_header and id3v2_tag_frame since this type does not have string lengths defined
' Also some reformatting has been done so usage will be more user friendly
Public Type id3v2_tag
has_tag As Boolean
tag_version As String
artist As String
title As String
album As String
year As String
comment As String
comment_language As String
genre As String
track As String
other_tags() As String
other_tags_cnt As Integer
End Type
' ID3v2 file header
Private Type id3v2_header
identifier As String * 3
'major_ver is always 2 and therefor not in the header
minor_ver As Byte
revision As Byte
flags As Byte
tagsize_byte1 As Byte
tagsize_byte2 As Byte
tagsize_byte3 As Byte
tagsize_byte4 As Byte
End Type
''
' When reading a binary file in another endian, this function can convert multiple bytes to a valid number
' @param string inp The bytes as string
' @return variant The actual number
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function change_endian(ByVal inp As String, Optional ByVal reverse As Boolean = False) As Variant
If Len(inp) = 0 Then change_endian = 0: Exit Function
Dim i As Integer, s As String
If reverse Then
For i = 1 To Len(inp)
s = s & zerofill(decbin(Asc(Mid(inp, i, 1))), 8)
Next i
Else
For i = Len(inp) To 1 Step -1
s = s & zerofill(decbin(Asc(Mid(inp, i, 1))), 8)
Next i
End If
change_endian = bindec(s)
End Function
''
' Trims all kind of whitespaces
' The VB6 trim() function only removes spaces, this function also removes null-chars, tabs, returns and linefeeds
' @param String txt The input text
' @return String The trimmed output text
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function RealTrim(ByVal txt As String) As String
Do
If Len(txt) = 0 Then
Exit Do
ElseIf Left(txt, 1) = Chr(0) Or _
Left(txt, 1) = vbTab Or _
Left(txt, 1) = " " Or _
Left(txt, 1) = vbCr Or _
Left(txt, 1) = vbLf Then
txt = Right(txt, Len(txt) - 1)
ElseIf Right(txt, 1) = Chr(0) Or _
Right(txt, 1) = vbTab Or _
Right(txt, 1) = " " Or _
Right(txt, 1) = vbCr Or _
Right(txt, 1) = vbLf Then
txt = Left(txt, Len(txt) - 1)
Else
Exit Do
End If
Loop
RealTrim = txt
End Function
''
' Makes a binary string from an integer number
' Same syntax as the PHP function 'decbin'
' See also: http://www.php.net/manual/en/function.decbin.php
' @param Integer number The decimal value
' @return String A binary presentation of the number (ex.: 00100111)
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function decbin(ByVal number As Integer) As String
Dim retval As String
Do Until number = 0
If (number Mod 2) Then retval = "1" & retval Else retval = "0" & retval
number = number \ 2
Loop
decbin = retval
End Function
''
' Makes an integer number from a binary string
' Same syntax as the PHP function 'bindec'
' See also: http://www.php.net/manual/en/function.bindec.php
' @param String binary_string The binary string (ex.: 00100111)
' @return Integer A decimal presentation of the binary value
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function bindec(binary_string As String) As Long
Dim i As Integer, pos As Integer, ret As Long
For i = 1 To Len(binary_string)
pos = Len(binary_string) - i
If Mid(binary_string, pos + 1, 1) = "1" Then ret = ret + (2 ^ (i - 1))
Next i
bindec = ret
End Function
''
' Completes a string by adding zero characters to the front
' @param string value The input string
' @param integer length The length the return value must be
' @param string character Optional, the character that should be used for filling, default: "0"
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function zerofill(ByVal value As String, ByVal length As Integer, Optional ByVal character = "0") As String
If Len(value) >= length Then zerofill = value: Exit Function
Dim i As Integer
Do
value = character & value
Loop While Len(value) < length
zerofill = value
End Function
''
' Reads an ID3v2-tag (to up to 2.3) from a file and returns it
' @param String FileName The filename of which we need the tags
' @return id3v2_tag The tag elements
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function id3v2_get_tag(ByVal filename As String) As id3v2_tag
' Some temporal reusable variables
Dim ff As Long, s As String
' Some internal values
Dim id3hdr As id3v2_header, retval As id3v2_tag, tagframe As id3v2_tag_frame
Dim tagsize As Long, unsynchronisation As Boolean, extended_header As Boolean, experimental_indicator As Boolean
ff = FreeFile
Open filename For Binary Access Read As #ff
Get #ff, 1, id3hdr
If id3hdr.identifier = "ID3" And id3hdr.minor_ver < 4 Then
' Some basic tag information
retval.has_tag = True
retval.tag_version = "2." & id3hdr.minor_ver & "." & id3hdr.revision
' Reading the flags
s = decbin(Val(id3hdr.flags))
If Mid(s, 8, 1) = "1" Then unsynchronisation = True
If Mid(s, 7, 1) = "1" Then extended_header = True
If Mid(s, 6, 1) = "1" Then experimental_indicator = True
' Reading the tag size
s = Left(zerofill(decbin(Val(id3hdr.tagsize_byte1)), 8), 7) ' The ID3v2 tag size is encoded with four bytes where the most
s = s & Left(zerofill(decbin(Val(id3hdr.tagsize_byte2)), 8), 7) ' significant bit (bit 7) is set to zero in every byte, making a total
s = s & Left(zerofill(decbin(Val(id3hdr.tagsize_byte3)), 8), 7) ' of 28 bits. The zeroed bits are ignored, so a 257 bytes long tag is
s = s & Left(zerofill(decbin(Val(id3hdr.tagsize_byte4)), 8), 7) ' represented as $00 00 02 01.
tagsize = bindec(s)
If extended_header Then
' Unsupported so far
retval.has_tag = False
id3v2_get_tag = retval
Close #ff
Exit Function
End If
' The ID3v2 tag size is the size of the complete tag after unsychronisation, including padding,
' excluding the header but not excluding the extended header (total tag size - 10).
Do While Seek(ff) < (tagsize + 10)
Get #ff, , tagframe
' Reading the actual value
s = String(change_endian(tagframe.framesize, True), 0): Get #ff, , s
Select Case UCase(tagframe.frame_id)
Case "TPE1": retval.artist = RealTrim(s)
Case "TIT2": retval.title = RealTrim(s)
Case "TALB": retval.album = RealTrim(s)
Case "TYER": retval.year = RealTrim(s)
Case "TCON": retval.genre = RealTrim(s)
Case "TRCK": retval.track = RealTrim(s)
Case "COMM"
' First byte: character encoding
' Three bytes: language
' Rest: Zero-byte with the actual value
retval.comment_language = Mid(s, 2, 3)
retval.comment = RealTrim(Mid(s, 5))
Case String(4, 0)
Exit Do
Case Else
ReDim Preserve retval.other_tags(0 To retval.other_tags_cnt)
retval.other_tags(retval.other_tags_cnt) = tagframe.frame_id & s
retval.other_tags_cnt = retval.other_tags_cnt + 1
End Select
Loop
End If
Close #ff
id3v2_get_tag = retval
End Function