MP3 related questions

[kourosh]

HI, I am writing a MP3 player program although I don't know to get:
Total Time of the file
Total time Elapsed
Bit Rate
Stereo or Mono
KHZ

If anyone know how to get this information of an MP3 file, please help me (I am Despirate).

[MidgetsBro]

Put this code in a module

Attribute VB_Name = "Module1"
'''Created By Michael Karathanasis 990728'''''''''''''''''''''
'''Does not return correct duration or bitrate if file has variable bit rate
'''The bitrates for Mpeg Version 2 MIGHT not be correct
'''please report improvements to http://home12.inet.tele.dk/mkaratha
'''User may use or distrubute the code without restrictions
'Sample how to use:

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

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 String
    Track As String
End Type
Public GetMP3Info As MP3Info
''this function converts Binary string to decimal integer
Public Function BinToDec(BinValue As String) 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
Public Function BinaryHeader(filename As String, ReadTag As Boolean, ReadHeader As Boolean) As String
Dim ByteArray(4) As Byte
FIO% = FreeFile
Open filename For Binary Access Read As FIO%
n& = LOF(FIO%): If n& < 256 Then Close FIO%: Return 'ny
If ReadHeader = False Then GoTo 5:   'if we only want to read the IDtag goto 5
Dim x As Byte
'''''start check startposition for header''''''''''''
'''''if start position <>1 then id3v2 tag exists'''''
   For i = 1 To 5000            'check up to 5000 bytes for the header
    Get #FIO%, i, x
    If x = 255 Then             'header always start with 255 followed by 250 or 251
        Get #FIO%, i + 1, x
        If x > 249 And x < 252 Then
            HeadStart = i       'set header start position
            Exit For
        End If
    End If
Next i
'''end check start position for header'''''''''''''

'''start extract the first 4 bytes (32 bits) to an array
   For z = 1 To 4 '
      Get #1, HeadStart + z - 1, ByteArray(z)
    Next z
'''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%, (n& - 255), Inbuf:  Close FIO% 'ny
        p = InStr(1, Inbuf, "tag", 1)  'ny
        If p = 0 Then
            With GetMP3Info
                .HasTag = False
                .Songname = ""
                .Artist = ""
                .Album = ""
                .Year = ""
                .Comment = ""
                .Track = ""
                .Genre = ""
            End With
        Else
            With GetMP3Info
                .HasTag = True
                .Songname = RTrim(Mid$(Inbuf, p + 3, 30))
                .Artist = RTrim(Mid$(Inbuf, p + 33, 30))
                .Album = RTrim(Mid$(Inbuf, p + 63, 30))
                .Year = RTrim(Mid$(Inbuf, p + 93, 4))
                .Comment = RTrim(Mid$(Inbuf, p + 97, 29))
                .Track = RTrim(Mid$(Inbuf, p + 126, 1))
                .Genre = Asc(RTrim(Mid$(Inbuf, p + 127, 1)))
        End With
    End If
''''stop id3 tag''''''''''''''''''''''''''''''
10:
Close FIO%
'start convert 4*1 byte array to 4*8 bits'''''
 BinaryHeader = ""
   For z = 1 To 4
    For i = 7 To 0 Step -1
      If Int(ByteArray(z) / (2 ^ i)) = 1 Then
        BinaryHeader = BinaryHeader & "1"
        ByteArray(z) = ByteArray(z) - (2 ^ i)
      Else
            If BinaryHeader <> "" Then
                BinaryHeader = BinaryHeader & "0"
            End If
      End If
  Next
Next z
'stop convert 4*1 byte array to 4*8 bits
End Function
Public Function ReadMP3(filename As String, ReadTag As Boolean, ReadHeader As Boolean) As MP3Info
  bin = BinaryHeader(filename, ReadTag, ReadHeader)                     'extract all 32 bits
If ReadHeader = False Then Exit Function
Version = Array(25, 0, 2, 1)                        'Mpegversion table
MpegVersion = Version(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
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)))
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
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
End Function

and usage is like this:

Private Sub Command1_Click()
text1.text = getMP3Info.Bitrate
text2.text = getMP3Info.Frequency
text3.text = getMP3Info.Mode
End Sub

[kourosh]

Thanks but it had alot of variables which weren't declared and now it does not work.

Thanks anyway

[MidgetsBro]

If you'd like, I can send you the whole project, which does work. I think you might have to declare the variables in the General Delcare area. Send me an e-mail if you want the project... [email protected]

Originally posted by kourosh
Thanks but it had alot of variables which weren't declared and now it does not work.

Thanks anyway

This would only happen if you have a Option Explicit in the form/module declarations.