mp3 Play Length

[robertx]

I was able to get the length simply by creating a function that plays the mp3, gets the length and stops playing it. That way, the info is extracted without the sound actually coming through the speakers. Thanks guys.

[formulav8]

I thought you said you didn't want to have to get it from playing it.

[macai]

Can you post that function please? :-D

[robertx]

Public Function Getmp3Length(sFilePath As String) As String
mp3Play (sFilePath)
Getmp3Length = Length
mp3Stop
End Function

'Pass the full mp3 file path.

[oetje]

It would be much better to get the length from the header. I think you can get the file format specification of mp3 at wotsit.org

[daydee]

Originally posted by robertx
Is there any way of determing the play length time of an mp3 file?

If you strickly want to pass the path of the mp3 file and return the length, then try this...
(modified from one of my apps to only return the duration from the mp3 file header)

'IN A MODULE
Option Explicit
Type MP3Info
    Bitrate As Integer
    Frequency As Long
    MpegLayer As Integer
    Duration As String
    VBR As Boolean
    Frames As Integer
End Type
Public GetMP3Info As MP3Info
''this function converts Binary string to decimal integer
Public Function BinToDec(BinValue As String) As Long
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 ByteToBit(ByteArray) As String
'convert 4*1 byte array to 4*8 bits'''''
ByteToBit = ""
   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 ByteToBit <> "" Then
                ByteToBit = ByteToBit & "0"
            End If
      End If
  Next
Next Z
End Function
Private Function BinaryHeader(filename As String, ReadHeader As Boolean) As String
Dim ByteArray(4) As Byte
Dim XingH As String * 4
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 check for XingHeader'''
    Get #1, Headstart + 36, XingH
    If XingH = "Xing" Then
        GetMP3Info.VBR = True
                    For Z = 1 To 4 '
                    Get #1, Headstart + 43 + Z, ByteArray(Z)  'get framelength to array
                    Next Z
                    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
   On Error GoTo msg 'ADDED AA june 4 2002
   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:
 
Close FIO%
BinaryHeader = ByteToBit(ByteArray)
Exit Function
msg:
MsgBox "Could not retreive header information from: " & filename, vbCritical
GoTo 5
End Function
Public Function ReadMP3(filename As String, ReadHeader As Boolean) As MP3Info
 
 Dim lngSeconds As Long, lngHours As Long, lngMins As Long, lngSecs2 As Long, lngSecs As Long
 
 bin = BinaryHeader(filename, 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
 
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 = (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
 
ms = (FileLen(filename) * 8) / Bitrate                  'calculate duration
lngSeconds = Int(ms / 1000)
lngHours = Fix(lngSeconds / 3600)
    lngSecs = lngSeconds - (lngHours * 3600)
    lngMins = Fix(lngSecs / 60)
    lngSecs2 = lngSecs - (lngMins * 60)
     Duration = Format(lngMins, "0:") & Format(lngSecs2, "00")
 
 GetMP3Info.Duration = Duration                       'set values
     
End Function
 
'USAGE 
Private Sub Command1_Click()
Dim tmpString As String
tmpString = "D:\Full Albums\America - Greatest Hits\05 - Don't Cross The River.mp3"
Call ReadMP3(tmpString, True)
MsgBox tmpString & " <" & GetMP3Info.Duration & ">"
End Sub

Cheers!