Attribute VB_Name = "Module4" '''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