VB6 Reading MP3 Tags

**DJWim** · Jun 12 '07, 01:45 PM

Here's my modMP3header.ba s module, I assume you're able to extract whatever you need. As for tag's you must understand that you have two different kinds: ID3V1.1 This is fixed 128 bytes at the end of a MP3, and supported by this program, and the more advanced ID3V2. (Not supported by this program)

In fact this code reads much more info out of a MP3. It needs more cleaning, but it works for me...
Success!

Code:

Option Explicit

'''Created By Michael Karathanasis 990728'''''''''''''''''''''
'''Now support for variable bit rate'''
'''please report improvements to http://home12.inet.tele.dk/mkaratha
'''User may use or distrubute the code without restrictions
'''Cosmetic & minor changes by Wim Bloemendal 041115 (wb)
'Sample how to use:

'Dim filename as string
'filename="c:\mymp3.mp3"
'Call ReadMP3(filename, True, True)
'Text1.Text = GetMP3Info.Bitrate

Public Type MP3Info
    Bitrate As Integer
    Frequency As Long
    mode As String
    Emphasis As String
    'ModeExtension As String
    MpegVersion As Integer
    MpegLayer As Integer
    Padding As String
    CRC As String
    Duration As Long
    CopyRight As String
    Original As String
    PrivateBit As String
    HasTag As Boolean
    Tag As String
    Songname As String
    Artist As String
    Album As String
    Year As String
    Comment As String
    Genre As Integer
    Track As String
    VBR As Boolean
    Frames As Long
    HeaderFound As Long
    Size As Long
End Type
Private GetMP3Info As MP3Info

'-------------------------------------------------------------------------------
Public Function ReadMP3( _
          filename As String, ReadTag As Boolean, ReadHeader As Boolean) _
          As MP3Info
  
  On Error GoTo ErrHand
  With GetMP3Info    'reset values, wb
    .Bitrate = 0
    .CRC = vbNullString
    .Duration = 0
    .Emphasis = vbNullString
    .Frequency = 0
    .mode = vbNullString
    .MpegLayer = 0
    .MpegVersion = 0
    .Padding = vbNullString
    .Original = vbNullString
    .CopyRight = vbNullString
    .PrivateBit = vbNullString
    .HasTag = False
    .Songname = vbNullString
    .Artist = vbNullString
    .Album = vbNullString
    .Year = vbNullString
    .Comment = vbNullString
    .Track = vbNullString
    .Genre = 255
    .VBR = False
    .Frames = 0
    .HeaderFound = 0
    .Size = 0
  End With
  Dim bin As String, Version1 As Variant, MpegVersion As Integer, layer As Variant
  Dim MpegLayer As Integer, SMode As Variant, mode As String, Emph As Variant
  Dim Emphasis As String, Freq As Variant, Frequency As Long, Temp As Variant
  Dim Bitrate As Integer, Brate As Variant, NoYes As Variant, Original As String
  Dim CopyRight As String, Padding As String, PrivateBit As String
  Dim YesNo As Variant, CRC As String, Ms As Long, Duration As Integer
  
  bin = BinaryHeader(filename, ReadTag, ReadHeader)     'extract all 32 bits
  If LenB(bin) = 0 Then GoTo exitfunction               'if no header --> exit
  
  If Not ReadHeader Then GoTo exitfunction
  Version1 = Array(25, 0, 2, 1)                         'Mpegversion table
  MpegVersion = Version1(BinToDec(Mid(bin, 12, 2)))     'get mpegversion from table
  layer = Array(0, 3, 2, 1)                             'layer table
  MpegLayer = layer(BinToDec(Mid(bin, 14, 2)))          'get layer from table
  SMode = Array("stereo", "joint stereo", "dual channel", "single channel") 'mode table
  mode = SMode(BinToDec(Mid(bin, 25, 2)))               'get mode from table
  Emph = Array("no", "50/15", "reserved", "CCITT J 17") 'empasis table
  Emphasis = Emph(BinToDec(Mid(bin, 31, 2)))            'get empasis from table
  Select Case MpegVersion                               'look for version to create right table
    Case 1                                              'for version 1
      Freq = Array(44100, 48000, 32000)
    Case 2 Or 25                                        'for version 2 or 2.5
      Freq = Array(22050, 24000, 16000)
    Case Else
      Frequency = 0
      Exit Function
  End Select
  Frequency = Freq(BinToDec(Mid(bin, 21, 2)))           'look for frequency in table
  If GetMP3Info.VBR = True Then                         'check if variable bitrate
    Temp = Array(, 12, 144, 144)                        'define to calculate correct bitrate
    Bitrate = Frequency * (FileLen(filename) / (Int(GetMP3Info.Frames)) / 1000 / Temp(MpegLayer))
'   Bitrate = (FileLen(filename) * Frequency) / (Int(GetMP3Info.Frames)) / 1000 / temp(MpegLayer)

  Else                                                  'if not variable bitrate
    Dim LayerVersion As String
    LayerVersion = MpegVersion & MpegLayer              'combine version and layer to string
    Select Case Val(LayerVersion)                       'look for the right bitrate table
      Case 11                                           'Version 1, Layer 1
        Brate = Array(0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448)
      Case 12                                           'V1 L1
        Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384)
      Case 13                                                 'V1 L3"
        Brate = Array(0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320)
      Case 21 Or 251                                    'V2 L1 and 'V2.5 L1
        Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256)
      Case 22 Or 252 Or 23 Or 253                       ''V2 L2 and 'V2.5 L2 etc...
        Brate = Array(0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160)
      Case Else                                         'if variable bitrate
        Bitrate = 1                                     'e.g. for Variable bitrate
        Exit Function
    End Select
    Bitrate = Brate(BinToDec(Mid(bin, 17, 4)))
  End If

  NoYes = Array("no", "yes")
  Original = NoYes(Mid(bin, 30, 1))                     'Set original bit
  CopyRight = NoYes(Mid(bin, 29, 1))                    'Set copyright bit
  Padding = NoYes(Mid(bin, 23, 1))                      'get padding bit
  PrivateBit = NoYes(Mid(bin, 24, 1))
  YesNo = Array("yes", "no")                            'CRC table
  CRC = YesNo(Mid(bin, 16, 1))                          'Get CRC
  Ms = (FileLen(filename) * 8) / Bitrate                'calculate duration
  Duration = Int(Ms / 1000)
  With GetMP3Info                                       'set values
    .Bitrate = Bitrate                                  '
    .CRC = CRC
    .Duration = Duration
    .Emphasis = Emphasis
    .Frequency = Frequency
    .mode = mode
    .MpegLayer = MpegLayer
    .MpegVersion = MpegVersion
    .Padding = Padding
    .Original = Original
    .CopyRight = CopyRight
    .PrivateBit = PrivateBit
  End With
exitfunction:
  ReadMP3 = GetMP3Info
  Exit Function
ErrHand:
'If Err = 63 Then  'commented by wb. e.g any unexpected error, just abort
'  Resume Next
'Else
'  Resume Next
'End If
End Function

'-------------------------------------------------------------------------------
Private Function BinToDec(BinValue As String) As Long
  ''this function converts Binary string to decimal integer
  Dim i As Integer
  BinToDec = 0
  For i = 1 To Len(BinValue)
    If Mid(BinValue, i, 1) = "1" Then
      BinToDec = BinToDec + 2 ^ (Len(BinValue) - i)
    End If
  Next i
End Function

'-------------------------------------------------------------------------------
Private Function ByteToBit(ByteArray) As String
'convert 4*1 byte array to 4*8 bits'''''
  Dim Z As Integer, i As Integer
  ByteToBit = vbNullString
  For Z = 1 To 4
    For i = 7 To 0 Step -1
      If Int(ByteArray(Z) / (2 ^ i)) = 1 Then
        ByteToBit = ByteToBit & "1"
        ByteArray(Z) = ByteArray(Z) - (2 ^ i)
      Else
        If LenB(ByteToBit) <> 0 Then
          ByteToBit = ByteToBit & "0"
        End If
      End If
    Next i
  Next Z
End Function

'-------------------------------------------------------------------------------
Private Function BinaryHeader(filename As String, ReadTag As Boolean, ReadHeader As Boolean) As String
  Dim ByteArray(4) As Byte
  Dim XingH As String * 4
  Dim FIO As Integer, LenFil As Long
  Dim i As Long, j As Long, Headstart As Long, Frames As Long
  Dim pos As Long

  On Error GoTo ErrHand

  FIO = FreeFile
  Open filename For Binary Access Read As FIO
  LenFil = LOF(FIO)
  GetMP3Info.Size = LenFil
  If LenFil < 256 Then Close FIO: Exit Function
  
  If Not ReadHeader Then GoTo 5:   'if we only want to read the IDtag goto 5

'Find start of header. Code optimized by WB
'max for fixed strings is 65526. But a low value seems to be most effective
  Dim Hdr As String * 1024
'  Dim Hdr() As Byte: Hdr = Space$(1024)  ' 1024
  
  pos = 0
  
'Skip ID3V2 header, if present
  Get #FIO, 1, Hdr 'read first chuck to check for ID3 V2 tags
  If Left$(Hdr, 3) = "ID3" Then
    Dim bytTmp As Byte
    For i = 0 To 3 'bytes 10..7 from the header is the size
      Get #FIO, 10 - i, bytTmp 'byte 10 is LSB..byte 7 is MSB, in syncsafe integers
      pos = pos + (&H80 ^ i) * bytTmp
    Next i
    pos = pos + 10 '+ size of header = total length of ID3V2.
    Get #FIO, pos + 1, Hdr    'read first chunk after ID3V2
  End If
 
  Do
    i = InStr(Hdr, ChrW$(255) & ChrW$(251)) 'check for the sequence 255/251
    If i = 1 Then         'many songs with a 255/251 hdr starts @1
      Headstart = i + pos 'so exit immediatly
      Exit Do
    End If
    j = InStr(Hdr, ChrW$(255) & ChrW$(250)) 'and 255/250
    If j = 1 Then         'many songs with a 255/250 hdr starts @1
      Headstart = j + pos 'so exit immediatly
      Exit Do
    End If
    Headstart = IIf(i = 0, j, IIf(j = 0, i, IIf(i < j, i, j))) 'the winner is..
    If Headstart <> 0 Then  'the earliest occurence wins, & exits
      Headstart = Headstart + pos   'add (any) previous chunks
      Exit Do
    End If
    pos = pos + 1024 'Len(Hdr) 'else continue to find hdr in next chunk
    Get #FIO, pos + 1, Hdr                'read in a chunk of the file
  Loop Until Headstart <> 0 Or pos > LenFil 'until found or whole file is scanned
  GetMP3Info.HeaderFound = Headstart - 1 'wb
  If Headstart = 0 Then Close FIO: Exit Function 'no sense to continue if no header
'''end check start position for header'''''''''''''

''start check for XingHeader'''
  Get #FIO, Headstart + 36, XingH
  If XingH = "Xing" Then
    GetMP3Info.VBR = True
    For i = 1 To 4 '
      Get #FIO, Headstart + 43 + i, ByteArray(i) 'get framelength to array
    Next i
    Frames = BinToDec(ByteToBit(ByteArray))   'calculate # of frames
    GetMP3Info.Frames = Frames                'set frames
  Else
    GetMP3Info.VBR = False
  End If
'''end check for XingHeader

'''start extract the first 4 bytes (32 bits) to an array
  For i = 1 To 4 '
    Get #FIO, Headstart + i - 1, ByteArray(i)
  Next i
'''stop extract the first 4 bytes (32 bits) to an array

5:
  If ReadTag = False Then GoTo 10     'if we dont want to read the tag goto 10
''''start id3 tag''''''''''''''''''''''''''''''''''''''''''''''''
''  Dim Inbuf As String * 256
''  Get #FIO, (LenFil - 255), Inbuf:  Close FIO 'ny
''  i = InStr(1, Inbuf, "TAG", vbTextCompare) 'ny
  Dim Inbuf As String * 128
  Get #FIO, (LenFil - 127), Inbuf:  Close FIO 'ny
  i = InStr(1, Inbuf, "TAG", vbTextCompare) 'ny
  If i = 0 Then 'GetMP3Info already zeroed at startup WB
'    With GetMP3Info
'      .HasTag = False
'      .Songname = ""
'      .Artist = ""
'      .Album = ""
'      .Year = ""
'      .Comment = ""
'      .Track = ""
'      .Genre = 255
'    End With
  Else
    With GetMP3Info
      .HasTag = True
      .Songname = RTrim(Mid$(Inbuf, i + 3, 30))
      .Artist = RTrim(Mid$(Inbuf, i + 33, 30))
      .Album = RTrim(Mid$(Inbuf, i + 63, 30))
      .Year = RTrim(Mid$(Inbuf, i + 93, 4))
      .Comment = RTrim(Mid$(Inbuf, i + 97, 30))

      If Mid$(.Comment, 29, 1) = Chr$(0) Then 'allow to read in ID3v1.0 tags
        .Track = Trim$(Str(Asc(Mid$(Inbuf, i + 126, 1))))
      Else
        .Track = ""
      End If
      
      .Genre = Asc(Mid$(Inbuf, i + 127, 1))
      
    End With
  End If

''''stop id3 tag''''''''''''''''''''''''''''''
10:
  Close FIO
  BinaryHeader = ByteToBit(ByteArray)
  Exit Function
ErrHand:  'TBD handle error more elegant..
  Close FIO
End Function

'-------------------------------------------------------------------------------
Public Function WriteTag(filename As String, _
                          Songname As String, _
                          Artist As String, _
                          Album As String, _
                          Year As String, _
                          Comment As String, _
                          Genre As Integer, _
                          Track As Integer) As Long
  On Error GoTo ErrHand 'wb, return function value 0, if error
  Dim Tag As String * 3
  Dim sn As String * 30
  Dim art As String * 30
  Dim alb As String * 30
  Dim yr As String * 4
  Dim com As String * 29 '28 bytes for comments + 1 null byte
  Dim tr As String * 1
  Dim gr As String * 1
  
  Dim iFilNr As String
  Tag = "TAG"
  sn = Songname
  art = Artist
  alb = Album
  yr = Year
  com = Comment: Mid$(com, 29, 1) = Chr$(0)
  'If Genre >= 0 Then
    gr = Chr$(Genre)
  'Else
  '  gr = 255
  'End If
  tr = Chr$(Track)
  
  iFilNr = FreeFile: Open filename For Binary Access Write As #iFilNr
  Seek #iFilNr, FileLen(filename) - 127
  Put #iFilNr, , Tag
  Put #iFilNr, , sn
  Put #iFilNr, , art
  Put #iFilNr, , alb
  Put #iFilNr, , yr
  Put #iFilNr, , com
  Put #iFilNr, , tr
  Put #iFilNr, , gr
  Close #iFilNr
  WriteTag = 1
  Exit Function
ErrHand:
  WriteTag = 0
End Function

'-------------------------------------------------------------------------------
Public Function GenreText(Index As Integer) As String
  Dim matrix As Variant
  On Error GoTo ErrHand
  matrix = Array("Blues", "Classic Rock", "Country", "Dance", "Disco", "Funk", "Grunge", _
  "Hip-Hop", "Jazz", "Metal", "New Age", "Oldies", "Other", "Pop", "R&b", "Rap", "Reggae", _
  "Rock", "Techno", "Industrial", "Alternative", "Ska", "Death Metal", "Pranks", _
  "Soundtrack", "Euro-Techno", "Ambient", "Trip-Hop", "Vocal", "Jazz Funk", "Fusion", _
  "Trance", "Classical", "Instrumental", "Acid", "House", "Game", "Sound Clip", "Gospel", _
  "Noise", "AlternRock", "Bass", "Soul", "Punk", "Space", "Meditative", "Instrumental Pop", _
  "Instrumental Rock", "Ethnic", "Gothic", "Darkwave", "Techno-Industrial", "Electronic", _
  "Pop-Folk", "Eurodance", "Dream", "Southern Rock", "Comedy", "Cult", "Gangsta", "Top 40", _
  "Christian Rap", "Pop/Funk", "Jungle", "Native American", "Cabaret", "New Wave", _
  "Psychadelic", "Rave", "Showtunes", "Trailer", "Lo-Fi", "Tribal", "Acid Punk", "Acid Jazz", _
  "Polka", "Retro", "Musical", "Rock & Roll", "Hard Rock", "Folk", "Folk/Rock", "National Folk", _
  "Swing", "Fast-Fusion", "Bebob", "Latin", "Revival", "Celtic", "Bluegrass", "Avantgarde", "Gothic Rock", _
  "Progressive Rock", "Psychedelic Rock", "Symphonic Rock", "Slow Rock", "Big Band", "Chorus", "Easy Listening", _
  "Acoustic", "Humour", "Speech", "Chanson", "Opera", "Chamber Music", "Sonata", "Symphony", "Booty Bass", _
  "Primus", "Porn Groove", "Satire", "Slow Jam", "Club", "Tango", "Samba", "Folklore", "Ballad", "Power Ballad", _
  "Rhythmic Soul", "Freestyle", "Duet", "Punk Rock", "Drum Solo", "A Cappella", _
  "Euro- House", "Dance Hall", "Goa", "Drum & Bass", "Club- House", "Hardcore", "Terror", "Indie", "BritPop", _
  "Negerpunk", "Polsk Punk", "Beat", "Christian Gangsta Rap", "Heavy Metal", "Black Metal", "Crossover", _
  "Contemporary Christian", "Christian Rock", "Merengue", "Salsa", "Thrash Metal", "Anime", "JPop", "Synthpop")
  GenreText = matrix(Index)

  Exit Function
ErrHand:
  GenreText = ""
End Function

**DJWim** · Jun 12 '07, 01:50 PM

I've added a whole bunch of code in my reply, but it seems not there?!
Let me know if I have to re-post it

**kjflash** · Jun 12 '07, 02:30 PM

Would you mind reposting?..... It seems to have disappeared.

Thanks,

Keith

Originally posted by DJWim

I've added a whole bunch of code in my reply, but it seems not there?!
Let me know if I have to re-post it

**DJWim** · Jun 13 '07, 07:41 AM

See what happens: I've included here ~400 lines of code, is there a limitation in length?

Code:

Option Explicit

'''Created By Michael Karathanasis 990728'''''''''''''''''''''
'''Now support for variable bit rate'''
'''please report improvements to http://home12.inet.tele.dk/mkaratha
'''User may use or distrubute the code without restrictions
'''Cosmetic & minor changes by Wim Bloemendal 041115 (wb)
'Sample how to use:

'Dim filename as string
'filename="c:\mymp3.mp3"
'Call ReadMP3(filename, True, True)
'Text1.Text = GetMP3Info.Bitrate

Public Type MP3Info
    Bitrate As Integer
    Frequency As Long
    mode As String
    Emphasis As String
    'ModeExtension As String
    MpegVersion As Integer
    MpegLayer As Integer
    Padding As String
    CRC As String
    Duration As Long
    CopyRight As String
    Original As String
    PrivateBit As String
    HasTag As Boolean
    Tag As String
    Songname As String
    Artist As String
    Album As String
    Year As String
    Comment As String
    Genre As Integer
    Track As String
    VBR As Boolean
    Frames As Long
    HeaderFound As Long
    Size As Long
End Type
Private GetMP3Info As MP3Info

'-------------------------------------------------------------------------------
Public Function ReadMP3( _
          filename As String, ReadTag As Boolean, ReadHeader As Boolean) _
          As MP3Info
  
  On Error GoTo ErrHand
  With GetMP3Info    'reset values, wb
    .Bitrate = 0
    .CRC = vbNullString
    .Duration = 0
    .Emphasis = vbNullString
    .Frequency = 0
    .mode = vbNullString
    .MpegLayer = 0
    .MpegVersion = 0
    .Padding = vbNullString
    .Original = vbNullString
    .CopyRight = vbNullString
    .PrivateBit = vbNullString
    .HasTag = False
    .Songname = vbNullString
    .Artist = vbNullString
    .Album = vbNullString
    .Year = vbNullString
    .Comment = vbNullString
    .Track = vbNullString
    .Genre = 255
    .VBR = False
    .Frames = 0
    .HeaderFound = 0
    .Size = 0
  End With
  Dim bin As String, Version1 As Variant, MpegVersion As Integer, layer As Variant
  Dim MpegLayer As Integer, SMode As Variant, mode As String, Emph As Variant
  Dim Emphasis As String, Freq As Variant, Frequency As Long, Temp As Variant
  Dim Bitrate As Integer, Brate As Variant, NoYes As Variant, Original As String
  Dim CopyRight As String, Padding As String, PrivateBit As String
  Dim YesNo As Variant, CRC As String, Ms As Long, Duration As Integer
  
  bin = BinaryHeader(filename, ReadTag, ReadHeader)     'extract all 32 bits
  If LenB(bin) = 0 Then GoTo exitfunction               'if no header --> exit
  
  If Not ReadHeader Then GoTo exitfunction
  Version1 = Array(25, 0, 2, 1)                         'Mpegversion table
  MpegVersion = Version1(BinToDec(Mid(bin, 12, 2)))     'get mpegversion from table
  layer = Array(0, 3, 2, 1)                             'layer table
  MpegLayer = layer(BinToDec(Mid(bin, 14, 2)))          'get layer from table
  SMode = Array("stereo", "joint stereo", "dual channel", "single channel") 'mode table
  mode = SMode(BinToDec(Mid(bin, 25, 2)))               'get mode from table
  Emph = Array("no", "50/15", "reserved", "CCITT J 17") 'empasis table
  Emphasis = Emph(BinToDec(Mid(bin, 31, 2)))            'get empasis from table
  Select Case MpegVersion                               'look for version to create right table
    Case 1                                              'for version 1
      Freq = Array(44100, 48000, 32000)
    Case 2 Or 25                                        'for version 2 or 2.5
      Freq = Array(22050, 24000, 16000)
    Case Else
      Frequency = 0
      Exit Function
  End Select
  Frequency = Freq(BinToDec(Mid(bin, 21, 2)))           'look for frequency in table
  If GetMP3Info.VBR = True Then                         'check if variable bitrate
    Temp = Array(, 12, 144, 144)                        'define to calculate correct bitrate
    Bitrate = Frequency * (FileLen(filename) / (Int(GetMP3Info.Frames)) / 1000 / Temp(MpegLayer))
'   Bitrate = (FileLen(filename) * Frequency) / (Int(GetMP3Info.Frames)) / 1000 / temp(MpegLayer)

  Else                                                  'if not variable bitrate
    Dim LayerVersion As String
    LayerVersion = MpegVersion & MpegLayer              'combine version and layer to string
    Select Case Val(LayerVersion)                       'look for the right bitrate table
      Case 11                                           'Version 1, Layer 1
        Brate = Array(0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448)
      Case 12                                           'V1 L1
        Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384)
      Case 13                                                 'V1 L3"
        Brate = Array(0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320)
      Case 21 Or 251                                    'V2 L1 and 'V2.5 L1
        Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256)
      Case 22 Or 252 Or 23 Or 253                       ''V2 L2 and 'V2.5 L2 etc...
        Brate = Array(0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160)
      Case Else                                         'if variable bitrate
        Bitrate = 1                                     'e.g. for Variable bitrate
        Exit Function
    End Select
    Bitrate = Brate(BinToDec(Mid(bin, 17, 4)))
  End If

  NoYes = Array("no", "yes")
  Original = NoYes(Mid(bin, 30, 1))                     'Set original bit
  CopyRight = NoYes(Mid(bin, 29, 1))                    'Set copyright bit
  Padding = NoYes(Mid(bin, 23, 1))                      'get padding bit
  PrivateBit = NoYes(Mid(bin, 24, 1))
  YesNo = Array("yes", "no")                            'CRC table
  CRC = YesNo(Mid(bin, 16, 1))                          'Get CRC
  Ms = (FileLen(filename) * 8) / Bitrate                'calculate duration
  Duration = Int(Ms / 1000)
  With GetMP3Info                                       'set values
    .Bitrate = Bitrate                                  '
    .CRC = CRC
    .Duration = Duration
    .Emphasis = Emphasis
    .Frequency = Frequency
    .mode = mode
    .MpegLayer = MpegLayer
    .MpegVersion = MpegVersion
    .Padding = Padding
    .Original = Original
    .CopyRight = CopyRight
    .PrivateBit = PrivateBit
  End With
exitfunction:
  ReadMP3 = GetMP3Info
  Exit Function
ErrHand:
'If Err = 63 Then  'commented by wb. e.g any unexpected error, just abort
'  Resume Next
'Else
'  Resume Next
'End If
End Function

'-------------------------------------------------------------------------------
Private Function BinToDec(BinValue As String) As Long
  ''this function converts Binary string to decimal integer
  Dim i As Integer
  BinToDec = 0
  For i = 1 To Len(BinValue)
    If Mid(BinValue, i, 1) = "1" Then
      BinToDec = BinToDec + 2 ^ (Len(BinValue) - i)
    End If
  Next i
End Function

'-------------------------------------------------------------------------------
Private Function ByteToBit(ByteArray) As String
'convert 4*1 byte array to 4*8 bits'''''
  Dim Z As Integer, i As Integer
  ByteToBit = vbNullString
  For Z = 1 To 4
    For i = 7 To 0 Step -1
      If Int(ByteArray(Z) / (2 ^ i)) = 1 Then
        ByteToBit = ByteToBit & "1"
        ByteArray(Z) = ByteArray(Z) - (2 ^ i)
      Else
        If LenB(ByteToBit) <> 0 Then
          ByteToBit = ByteToBit & "0"
        End If
      End If
    Next i
  Next Z
End Function

'-------------------------------------------------------------------------------
Private Function BinaryHeader(filename As String, ReadTag As Boolean, ReadHeader As Boolean) As String
  Dim ByteArray(4) As Byte
  Dim XingH As String * 4
  Dim FIO As Integer, LenFil As Long
  Dim i As Long, j As Long, Headstart As Long, Frames As Long
  Dim pos As Long

  On Error GoTo ErrHand

  FIO = FreeFile
  Open filename For Binary Access Read As FIO
  LenFil = LOF(FIO)
  GetMP3Info.Size = LenFil
  If LenFil < 256 Then Close FIO: Exit Function
  
  If Not ReadHeader Then GoTo 5:   'if we only want to read the IDtag goto 5

'Find start of header. Code optimized by WB
'max for fixed strings is 65526. But a low value seems to be most effective
  Dim Hdr As String * 1024
'  Dim Hdr() As Byte: Hdr = Space$(1024)  ' 1024
  
  pos = 0
  
'Skip ID3V2 header, if present
  Get #FIO, 1, Hdr 'read first chuck to check for ID3 V2 tags
  If Left$(Hdr, 3) = "ID3" Then
    Dim bytTmp As Byte
    For i = 0 To 3 'bytes 10..7 from the header is the size
      Get #FIO, 10 - i, bytTmp 'byte 10 is LSB..byte 7 is MSB, in syncsafe integers
      pos = pos + (&H80 ^ i) * bytTmp
    Next i
    pos = pos + 10 '+ size of header = total length of ID3V2.
    Get #FIO, pos + 1, Hdr    'read first chunk after ID3V2
  End If
 
  Do
    i = InStr(Hdr, ChrW$(255) & ChrW$(251)) 'check for the sequence 255/251
    If i = 1 Then         'many songs with a 255/251 hdr starts @1
      Headstart = i + pos 'so exit immediatly
      Exit Do
    End If
    j = InStr(Hdr, ChrW$(255) & ChrW$(250)) 'and 255/250
    If j = 1 Then         'many songs with a 255/250 hdr starts @1
      Headstart = j + pos 'so exit immediatly
      Exit Do
    End If
    Headstart = IIf(i = 0, j, IIf(j = 0, i, IIf(i < j, i, j))) 'the winner is..
    If Headstart <> 0 Then  'the earliest occurence wins, & exits
      Headstart = Headstart + pos   'add (any) previous chunks
      Exit Do
    End If
    pos = pos + 1024 'Len(Hdr) 'else continue to find hdr in next chunk
    Get #FIO, pos + 1, Hdr                'read in a chunk of the file
  Loop Until Headstart <> 0 Or pos > LenFil 'until found or whole file is scanned
  GetMP3Info.HeaderFound = Headstart - 1 'wb
  If Headstart = 0 Then Close FIO: Exit Function 'no sense to continue if no header
'''end check start position for header'''''''''''''

''start check for XingHeader'''
  Get #FIO, Headstart + 36, XingH
  If XingH = "Xing" Then
    GetMP3Info.VBR = True
    For i = 1 To 4 '
      Get #FIO, Headstart + 43 + i, ByteArray(i) 'get framelength to array
    Next i
    Frames = BinToDec(ByteToBit(ByteArray))   'calculate # of frames
    GetMP3Info.Frames = Frames                'set frames
  Else
    GetMP3Info.VBR = False
  End If
'''end check for XingHeader

'''start extract the first 4 bytes (32 bits) to an array
  For i = 1 To 4 '
    Get #FIO, Headstart + i - 1, ByteArray(i)
  Next i
'''stop extract the first 4 bytes (32 bits) to an array

5:
  If ReadTag = False Then GoTo 10     'if we dont want to read the tag goto 10
''''start id3 tag''''''''''''''''''''''''''''''''''''''''''''''''
''  Dim Inbuf As String * 256
''  Get #FIO, (LenFil - 255), Inbuf:  Close FIO 'ny
''  i = InStr(1, Inbuf, "TAG", vbTextCompare) 'ny
  Dim Inbuf As String * 128
  Get #FIO, (LenFil - 127), Inbuf:  Close FIO 'ny
  i = InStr(1, Inbuf, "TAG", vbTextCompare) 'ny
  If i = 0 Then 'GetMP3Info already zeroed at startup WB
'    With GetMP3Info
'      .HasTag = False
'      .Songname = ""
'      .Artist = ""
'      .Album = ""
'      .Year = ""
'      .Comment = ""
'      .Track = ""
'      .Genre = 255
'    End With
  Else
    With GetMP3Info
      .HasTag = True
      .Songname = RTrim(Mid$(Inbuf, i + 3, 30))
      .Artist = RTrim(Mid$(Inbuf, i + 33, 30))
      .Album = RTrim(Mid$(Inbuf, i + 63, 30))
      .Year = RTrim(Mid$(Inbuf, i + 93, 4))
      .Comment = RTrim(Mid$(Inbuf, i + 97, 30))

      If Mid$(.Comment, 29, 1) = Chr$(0) Then 'allow to read in ID3v1.0 tags
        .Track = Trim$(Str(Asc(Mid$(Inbuf, i + 126, 1))))
      Else
        .Track = ""
      End If
      
      .Genre = Asc(Mid$(Inbuf, i + 127, 1))
      
    End With
  End If

''''stop id3 tag''''''''''''''''''''''''''''''
10:
  Close FIO
  BinaryHeader = ByteToBit(ByteArray)
  Exit Function
ErrHand:  'TBD handle error more elegant..
  Close FIO
End Function

'-------------------------------------------------------------------------------
Public Function WriteTag(filename As String, _
                          Songname As String, _
                          Artist As String, _
                          Album As String, _
                          Year As String, _
                          Comment As String, _
                          Genre As Integer, _
                          Track As Integer) As Long
  On Error GoTo ErrHand 'wb, return function value 0, if error
  Dim Tag As String * 3
  Dim sn As String * 30
  Dim art As String * 30
  Dim alb As String * 30
  Dim yr As String * 4
  Dim com As String * 29 '28 bytes for comments + 1 null byte
  Dim tr As String * 1
  Dim gr As String * 1
  
  Dim iFilNr As String
  Tag = "TAG"
  sn = Songname
  art = Artist
  alb = Album
  yr = Year
  com = Comment: Mid$(com, 29, 1) = Chr$(0)
  'If Genre >= 0 Then
    gr = Chr$(Genre)
  'Else
  '  gr = 255
  'End If
  tr = Chr$(Track)
  
  iFilNr = FreeFile: Open filename For Binary Access Write As #iFilNr
  Seek #iFilNr, FileLen(filename) - 127
  Put #iFilNr, , Tag
  Put #iFilNr, , sn
  Put #iFilNr, , art
  Put #iFilNr, , alb
  Put #iFilNr, , yr
  Put #iFilNr, , com
  Put #iFilNr, , tr
  Put #iFilNr, , gr
  Close #iFilNr
  WriteTag = 1
  Exit Function
ErrHand:
  WriteTag = 0
End Function

'-------------------------------------------------------------------------------
Public Function GenreText(Index As Integer) As String
  Dim matrix As Variant
  On Error GoTo ErrHand
  matrix = Array("Blues", "Classic Rock", "Country", "Dance", "Disco", "Funk", "Grunge", _
  "Hip-Hop", "Jazz", "Metal", "New Age", "Oldies", "Other", "Pop", "R&b", "Rap", "Reggae", _
  "Rock", "Techno", "Industrial", "Alternative", "Ska", "Death Metal", "Pranks", _
  "Soundtrack", "Euro-Techno", "Ambient", "Trip-Hop", "Vocal", "Jazz Funk", "Fusion", _
  "Trance", "Classical", "Instrumental", "Acid", "House", "Game", "Sound Clip", "Gospel", _
  "Noise", "AlternRock", "Bass", "Soul", "Punk", "Space", "Meditative", "Instrumental Pop", _
  "Instrumental Rock", "Ethnic", "Gothic", "Darkwave", "Techno-Industrial", "Electronic", _
  "Pop-Folk", "Eurodance", "Dream", "Southern Rock", "Comedy", "Cult", "Gangsta", "Top 40", _
  "Christian Rap", "Pop/Funk", "Jungle", "Native American", "Cabaret", "New Wave", _
  "Psychadelic", "Rave", "Showtunes", "Trailer", "Lo-Fi", "Tribal", "Acid Punk", "Acid Jazz", _
  "Polka", "Retro", "Musical", "Rock & Roll", "Hard Rock", "Folk", "Folk/Rock", "National Folk", _
  "Swing", "Fast-Fusion", "Bebob", "Latin", "Revival", "Celtic", "Bluegrass", "Avantgarde", "Gothic Rock", _
  "Progressive Rock", "Psychedelic Rock", "Symphonic Rock", "Slow Rock", "Big Band", "Chorus", "Easy Listening", _
  "Acoustic", "Humour", "Speech", "Chanson", "Opera", "Chamber Music", "Sonata", "Symphony", "Booty Bass", _
  "Primus", "Porn Groove", "Satire", "Slow Jam", "Club", "Tango", "Samba", "Folklore", "Ballad", "Power Ballad", _
  "Rhythmic Soul", "Freestyle", "Duet", "Punk Rock", "Drum Solo", "A Cappella", _
  "Euro- House", "Dance Hall", "Goa", "Drum & Bass", "Club- House", "Hardcore", "Terror", "Indie", "BritPop", _
  "Negerpunk", "Polsk Punk", "Beat", "Christian Gangsta Rap", "Heavy Metal", "Black Metal", "Crossover", _
  "Contemporary Christian", "Christian Rock", "Merengue", "Salsa", "Thrash Metal", "Anime", "JPop", "Synthpop")
  GenreText = matrix(Index)

  Exit Function
ErrHand:
  GenreText = ""
End Function

**DJWim** · Jun 13 '07, 07:45 AM

I don't know what's going on, I did (again) added code (~400 lines) but it seems not to accept!? I can send it by e-mail if you want.

**DJWim** · Jun 13 '07, 08:54 AM

I've extracted some of the relevant code from my .bas module, hope this will paste here correctly. The original struct MP3Info is much larger, and contains all kind of other information of a MP3. All retrieved with the code I was trying to paste here. At least you have the code to read ID3V1 tags. (V2 tags is a whole other story...!)
This has not been tested as such, but the code has been proven to work correctly. (But I might have overlooked a declare, or something)

Code:

Public Type MP3Info
    HasTag As Boolean
    Tag As String
    Songname As String
    Artist As String
    Album As String
    Year As String
    Comment As String
    Genre As Integer
    Track As String
End Type

Public GetMP3Info As MP3Info

Public Sub GetTag(sMP3Name)
''''start id3 tag''''''''''''''''''''''''''''''''''''''''''''''''
  Dim Inbuf As String * 128, i As Integer, FIO As Integer
  FIO = FreeFile
  Open sMP3Name For Binary Access Read As FIO
  Get #FIO, (LenFil - 127), Inbuf:  Close FIO
  i = InStr(1, Inbuf, "TAG", vbTextCompare)
  If i = 0 Then
    With GetMP3Info
      .HasTag = False
      .Songname = ""
      .Artist = ""
      .Album = ""
      .Year = ""
      .Comment = ""
      .Track = ""
      .Genre = 255
    End With
  Else
    With GetMP3Info
      .HasTag = True
      .Songname = RTrim(Mid$(Inbuf, i + 3, 30))
      .Artist = RTrim(Mid$(Inbuf, i + 33, 30))
      .Album = RTrim(Mid$(Inbuf, i + 63, 30))
      .Year = RTrim(Mid$(Inbuf, i + 93, 4))
      .Comment = RTrim(Mid$(Inbuf, i + 97, 30))
      If Mid$(.Comment, 29, 1) = Chr$(0) Then 'allow to read in ID3v1.0 tags
        .Track = Trim$(Str(Asc(Mid$(Inbuf, i + 126, 1))))
      Else
        .Track = ""
      End If
      .Genre = Asc(Mid$(Inbuf, i + 127, 1))
    End With
  End If
End Sub

Public Function GenreText(Index As Integer) As String
  Dim matrix As Variant
  On Error GoTo ErrHand
  matrix = Array("Blues", "Classic Rock", "Country", "Dance", "Disco", "Funk", "Grunge", _
  "Hip-Hop", "Jazz", "Metal", "New Age", "Oldies", "Other", "Pop", "R&b", "Rap", "Reggae", _
  "Rock", "Techno", "Industrial", "Alternative", "Ska", "Death Metal", "Pranks", _
  "Soundtrack", "Euro-Techno", "Ambient", "Trip-Hop", "Vocal", "Jazz Funk", "Fusion", _
  "Trance", "Classical", "Instrumental", "Acid", "House", "Game", "Sound Clip", "Gospel", _
  "Noise", "AlternRock", "Bass", "Soul", "Punk", "Space", "Meditative", "Instrumental Pop", _
  "Instrumental Rock", "Ethnic", "Gothic", "Darkwave", "Techno-Industrial", "Electronic", _
  "Pop-Folk", "Eurodance", "Dream", "Southern Rock", "Comedy", "Cult", "Gangsta", "Top 40", _
  "Christian Rap", "Pop/Funk", "Jungle", "Native American", "Cabaret", "New Wave", _
  "Psychadelic", "Rave", "Showtunes", "Trailer", "Lo-Fi", "Tribal", "Acid Punk", "Acid Jazz", _
  "Polka", "Retro", "Musical", "Rock & Roll", "Hard Rock", "Folk", "Folk/Rock", "National Folk", _
  "Swing", "Fast-Fusion", "Bebob", "Latin", "Revival", "Celtic", "Bluegrass", "Avantgarde", "Gothic Rock", _
  "Progressive Rock", "Psychedelic Rock", "Symphonic Rock", "Slow Rock", "Big Band", "Chorus", "Easy Listening", _
  "Acoustic", "Humour", "Speech", "Chanson", "Opera", "Chamber Music", "Sonata", "Symphony", "Booty Bass", _
  "Primus", "Porn Groove", "Satire", "Slow Jam", "Club", "Tango", "Samba", "Folklore", "Ballad", "Power Ballad", _
  "Rhythmic Soul", "Freestyle", "Duet", "Punk Rock", "Drum Solo", "A Cappella", _
  "Euro- House", "Dance Hall", "Goa", "Drum & Bass", "Club- House", "Hardcore", "Terror", "Indie", "BritPop", _
  "Negerpunk", "Polsk Punk", "Beat", "Christian Gangsta Rap", "Heavy Metal", "Black Metal", "Crossover", _
  "Contemporary Christian", "Christian Rock", "Merengue", "Salsa", "Thrash Metal", "Anime", "JPop", "Synthpop")
  GenreText = matrix(Index)

  Exit Function
ErrHand:
  GenreText = ""
End Function