Calculate exact playtime of MP3 Files with VBR
Posted: Sat Apr 14, 2007 8:52 am
As this was requested a long time ago, here it is. You can also get FrameHeader Information from this procedures as well as the correct playtime of a mp3. (Hopefully) 
Please test this source with much mp3-files you have and give feedback.
The GetMp3FrameHeaderInformation() Prozedure isnt optimized yet. Ive done some optimizations on the GetAverangeBitrate() Procedure but I'm sure there is much more potential to optimize something more.
Have fun.
Please test this source with much mp3-files you have and give feedback.
The GetMp3FrameHeaderInformation() Prozedure isnt optimized yet. Ive done some optimizations on the GetAverangeBitrate() Procedure but I'm sure there is much more potential to optimize something more.
Have fun.
Code: Select all
; -------------------------------------------------------------------------
; Mp3 FrameHeader Playtime calculation coded by Mike Delling aka Tranquil
; Done on 14-04-2007 for PB 4.02
;
; ENABLE DEBUGGER AND IN-LINE ASSEMBLER TO RUN THIS EXAMPLE!
;
; Use it as you want, give feedback on optimizations and so on... :-)
;
; Sorry Rings, it tooks me some more time to port old codes. :-(
; -------------------------------------------------------------------------
Procedure MyGetBitAsm(val.l, bitnum.b) ; Value, bit number (bit 0-31)
MOV edx, val
MOV al, bitnum
result.l
PUSH ecx
MOV cl, al
MOV eax, 1
SHL eax, cl
POP ecx
NOT eax
OR eax, edx
MOV edx, 1
NOT eax
TEST eax, eax
!jz .End
!XOR edx, edx
!.End:
MOV result, edx
ProcedureReturn result
EndProcedure
Structure Mp3Frame
StreamHeader.l
MPEGSize.l
Version.b
Layer.b
Protection.b
Bitrate.w
AVGBitrate.w
Copyright.b
Private.b
Original.b
Padding.b
SamplingRate.l
ChannelMode.s
ModeExtension.s
Emphasis.s
EndStructure
; Find mp3 Header ; Returns -1 if no Header can be found
Procedure.l FindMp3Header(FileName.s)
idFile = ReadFile(#PB_Any, FileName)
If idFile = 0
ProcedureReturn -1
EndIf
ID3.s = Space(3)
ReadData(idFile,@ID3, 3)
; must be ID3v2.3.x
If ID3 = "ID3" And ReadByte(idFile) = $03
ID3Exists = #True
; skip revision and flag bytes
ReadWord(idFile)
; get tag size
ID3Size.l = 0
For Byte.l = 3 To 0 Step -1
ID3Size + (ReadByte(idFile) << (7*Byte))
Next
EndIf
FileSeek(idFile,ID3Size)
Repeat
If ReadByte(idFile)=-1
Byte1.b = ReadByte(idFile)
If MyGetBitAsm(Byte1,7) = 1 And MyGetBitAsm(Byte1,6) = 1 And MyGetBitAsm(Byte1,5) = 1
FileSeek(idFile,Loc(idFile)-2)
Finish = #True
Else
FileSeek(idFile,Loc(idFile)-1)
EndIf
EndIf
Until Finish = #True
HeaderStart.l = Loc(idFile)
If HeaderStart.l = Lof(idFile)
HeaderStart = -1
EndIf
CloseFile(idFile)
ProcedureReturn HeaderStart.l
EndProcedure
; Fills the Mp3Frame Structure with information out of the First-FrameHeader
Procedure.l GetMp3FrameInformation(FileName.s)
Dim V1L1.w(15)
Dim V1L2.w(15)
Dim V1L3.w(15)
Dim V2L1.w(15)
Dim V2L2.w(15)
Dim V2L3.w(15)
For n = 1 To 15 : Read V1L1(n) : Next
For n = 1 To 15 : Read V1L2(n) : Next
For n = 1 To 15 : Read V1L3(n) : Next
For n = 1 To 15 : Read V2L1(n) : Next
For n = 1 To 15 : Read V2L2(n) : Next
For n = 1 To 15 : Read V2L3(n) : Next
DataSection
Data.w 32,64,96,128,160,192,224,256,288,320,353,384,416,448,-1
Data.w 32,48,56,64,80,96,112,128,160,192,224,256,320,384,-1
Data.w 32,40,48,56,64,80,96,112,128,160,192,224,256,320,-1
Data.w 32,64,96,128,160,192,224,256,288,320,352,384,416,448,-1
Data.w 32,48,56,64,80,96,112,128,160,192,224,256,320,384,-1
Data.w 8,16,24,32,64,80,56,64,128,160,112,128,256,320,-1
EndDataSection
StreamHeader = FindMp3Header(FileName.s)
If StreamHeader = -1
ProcedureReturn #False
EndIf
idFile = ReadFile(#PB_Any,FileName.s)
MPEGSize = Lof(idFile)-StreamHeader
TAG$ = Space(3) : FileSeek(idFile,Lof(idFile)-128) : ReadData(idFile,@TAG$,3)
If Tag$="TAG"
MPEGSize - 128
EndIf
FileSeek(idFile,StreamHeader)
;in diesen 4 Bytes stehen alle Info's
Byte0.b = ReadByte(idFile)
Byte1.b = ReadByte(idFile)
Byte2.b = ReadByte(idFile)
Byte3.b = ReadByte(idFile)
; Ist das ein richtiger FrameHeader? (Die ersten 11 Bits müssen gesetzt sein!)
If Byte0 <> -1 Or MyGetBitAsm(Byte1,7) = 0 Or MyGetBitAsm(Byte1,6) = 0 Or MyGetBitAsm(Byte1,5) = 0
Debug "frame header error"
CloseFile(idFile)
ProcedureReturn -1
EndIf
; MPEG Audio Version
If MyGetBitAsm(Byte1,4) = 1 And MyGetBitAsm(Byte1,3) = 1
MPEGVersion$ = "1"
EndIf
If MyGetBitAsm(Byte1,4) = 1 And MyGetBitAsm(Byte1,3) = 0
MPEGVersion$ = "2"
EndIf
If MyGetBitAsm(Byte1,4) = 0 And MyGetBitAsm(Byte1,3) = 1
MPEGVersion$ = "Reserved"
EndIf
If MyGetBitAsm(Byte1,4) = 0 And MyGetBitAsm(Byte1,3) = 0
MPEGVersion$ = "2.5"
EndIf
; Layer
If MyGetBitAsm(Byte1,2) = 1 And MyGetBitAsm(Byte1,1) = 1
MPEGLayer$ = "1"
EndIf
If MyGetBitAsm(Byte1,2) = 1 And MyGetBitAsm(Byte1,1) = 0
MPEGLayer$ = "2"
EndIf
If MyGetBitAsm(Byte1,2) = 0 And MyGetBitAsm(Byte1,1) = 1
MPEGLayer$ = "3"
EndIf
If MyGetBitAsm(Byte1,2) = 0 And MyGetBitAsm(Byte1,1) = 0
MPEGLayer$ = "Reserves"
EndIf
; Protection-Bit
MPEGProtection$ = Str(MyGetBitAsm(Byte0,0))
bitr$ = Str(MyGetBitAsm(Byte2,7))
bitr$ + Str(MyGetBitAsm(Byte2,6))
bitr$ + Str(MyGetBitAsm(Byte2,5))
bitr$ + Str(MyGetBitAsm(Byte2,4))
bitr$ = Str(MyGetBitAsm(Byte2,7))
bitr$ + Str(MyGetBitAsm(Byte2,6))
bitr$ + Str(MyGetBitAsm(Byte2,5))
bitr$ + Str(MyGetBitAsm(Byte2,4))
Select bitr$
Case "0001"
BitPos = 1
Case "0010"
BitPos = 2
Case "0011"
BitPos = 3
Case "0100"
BitPos = 4
Case "0101"
BitPos = 5
Case "0110"
BitPos = 6
Case "0111"
BitPos = 7
Case "1000"
BitPos = 8
Case "1001"
BitPos = 9
Case "1010"
BitPos = 10
Case "1011"
BitPos = 11
Case "1100"
BitPos = 12
Case "1101"
BitPos = 13
Case "1110"
BitPos = 14
Case "1111"
BitPos = 15
EndSelect
If MPEGLayer$ = "1" And MPEGVersion$ = "1"
Bitrate.l = V1L1(BitPos)
EndIf
If MPEGLayer$ = "2" And MPEGVersion$ = "1"
Bitrate.l = V1L2(BitPos)
EndIf
If MPEGLayer$ = "3" And MPEGVersion$ = "1"
Bitrate.l = V1L3(BitPos)
EndIf
If MPEGLayer$ = "1" And MPEGVersion$ = "2"
Bitrate.l = V2L1(BitPos)
EndIf
If MPEGLayer$ = "2" And MPEGVersion$ = "2"
Bitrate.l = V2L2(BitPos)
EndIf
If MPEGLayer$ = "3" And MPEGVersion$ = "2"
Bitrate.l = V2L3(BitPos)
EndIf
MPEGBitrate$ = Bitrate$
; Sampling Rate Indexes
Sam$ = Str(MyGetBitAsm(Byte2,3))
Sam$ + Str(MyGetBitAsm(Byte2,2))
Select MPEGVersion$
Case "1"
Select Sam$
Case "00"
SampleRate$ = "44100"
Case "01"
SampleRate$ = "48000"
Case "10"
SampleRate$ = "32000"
Case "11"
CloseFile(idFile)
ProcedureReturn #False
EndSelect
Case "2"
Select Sam$
Case "00"
SampleRate$ = "22050"
Case "01"
SampleRate$ = "24000"
Case "10"
SampleRate$ = "16000"
Case "11"
CloseFile(idFile)
ProcedureReturn #False
EndSelect
EndSelect
MPEGSamplingRate$ = SampleRate$
; Padding Bit
MPEGPadding$ = Str(MyGetBitAsm(Byte2,1))
; Private Bit
MPEGPrivate$ = Str(MyGetBitAsm(Byte2,0))
; ChannelMode
cmode$ = Str(MyGetBitAsm(Byte3,7))
cmode$ + Str(MyGetBitAsm(Byte3,6))
Select cmode$
Case "00"
Cha$ = "Stereo"
Case "01"
Cha$ = "Joint Stereo"
Case "10"
Cha$ = "Dual Chanel"
Case "11"
Cha$ = "Mono"
EndSelect
MPEGChannelMode$ = Cha$
; Mode extenstion
Mex$ = Str(MyGetBitAsm(Byte3,5))
Mex$ + Str(MyGetBitAsm(Byte3,4))
Select Mpegversion$
Case "1"
Select Mex$
Case "00"
ModeExt$ = "4"
Case "01"
ModeExt$ = "8"
Case "10"
ModeExt$ = "12"
Case "11"
ModeExt$ = "16"
EndSelect
Case "2"
Select Mex$
Case "00"
ModeExt$ = "0"
Case "01"
ModeExt$ = "4"
Case "10"
ModeExt$ = "8"
Case "11"
ModeExt$ = "16"
EndSelect
EndSelect
MPEGModExtension$ = ModeExt$
; Copyright
MPEGCopyright$ = Str(MyGetBitAsm(Byte3,3))
; Original
MPEGOriginal$ = Str(MyGetBitAsm(Byte3,2))
; Emphasis
Emp$ = Str(MyGetBitAsm(Byte3,1)) + Str(MyGetBitAsm(Byte3,0))
Select Emp$
Case "00"
Emp$ = "None"
Case "01"
Emp$ = "50/15 microseconds"
Case "10"
Emp$ = "Dunno"
Case "11"
Emp$ = "CITT j.17"
EndSelect
Global Mp3Frame.Mp3Frame
Mp3Frame\MPEGSize = MPEGSize
Mp3Frame\Original = Val(MPEGOriginal$)
Mp3Frame\Copyright = Val(MPEGCopyright$)
Mp3Frame\ModeExtension = MPEGModExtension$
Mp3Frame\SamplingRate = Val(SampleRate$)
Mp3Frame\Layer = Val(MPEGLayer$)
Mp3Frame\Version = Val(MPEGVersion$)
Mp3Frame\StreamHeader = StreamHeader
Mp3Frame\Emphasis = Emp$
Mp3Frame\Bitrate = Bitrate.l
ProcedureReturn #True
EndProcedure
; Build an averante Bitrate from the complete Bitstream
Procedure.w GetAveranteBitrate(FileName.s)
StreamHeader = FindMp3Header(FileName.s)
If StreamHeader = -1
ProcedureReturn -1
EndIf
idFile = ReadFile(#PB_Any,FileName.s)
MPEGSize = Lof(idFile)-StreamHeader
TAG$ = Space(3) : FileSeek(idFile,Lof(idFile)-128) : ReadData(idFile,@TAG$,3)
If Tag$="TAG"
MPEGSize - 128
EndIf
FileSeek(idFile,StreamHeader)
; Bitrate
;Bitraten-Tabellen
Dim V1L1.w(15)
Dim V1L2.w(15)
Dim V1L3.w(15)
Dim V2L1.w(15)
Dim V2L2.w(15)
Dim V2L3.w(15)
For n = 1 To 15 : Read V1L1(n) : Next
For n = 1 To 15 : Read V1L2(n) : Next
For n = 1 To 15 : Read V1L3(n) : Next
For n = 1 To 15 : Read V2L1(n) : Next
For n = 1 To 15 : Read V2L2(n) : Next
For n = 1 To 15 : Read V2L3(n) : Next
DataSection
Data.w 32,64,96,128,160,192,224,256,288,320,353,384,416,448,-1
Data.w 32,48,56,64,80,96,112,128,160,192,224,256,320,384,-1
Data.w 32,40,48,56,64,80,96,112,128,160,192,224,256,320,-1
Data.w 32,64,96,128,160,192,224,256,288,320,352,384,416,448,-1
Data.w 32,48,56,64,80,96,112,128,160,192,224,256,320,384,-1
Data.w 8,16,24,32,64,80,56,64,128,160,112,128,256,320,-1
EndDataSection
BitRateChanged.b = #False
FirstBitrate.w = 0
Repeat
;in diesen 4 Bytes stehen alle Info's
Byte0.b = ReadByte(idFile)
Byte1.b = ReadByte(idFile)
Byte2.b = ReadByte(idFile)
Byte3.b = ReadByte(idFile)
; Ist das ein richtiger FrameHeader? (Die ersten 11 Bits müssen gesetzt sein!)
If Byte0 <> -1 Or MyGetBitAsm(Byte1,7) = 0 Or MyGetBitAsm(Byte1,6) = 0 Or MyGetBitAsm(Byte1,5) = 0
Finish = #True
Else
Finish = #False
EndIf
If Finish = #False
; MPEG Audio Version
If MyGetBitAsm(Byte1,4) = 1 And MyGetBitAsm(Byte1,3) = 1
MPEGVersion = 1
EndIf
If MyGetBitAsm(Byte1,4) = 1 And MyGetBitAsm(Byte1,3) = 0
MPEGVersion = 2
EndIf
If MyGetBitAsm(Byte1,4) = 0 And MyGetBitAsm(Byte1,3) = 1
MPEGVersion = 0
EndIf
If MyGetBitAsm(Byte1,4) = 0 And MyGetBitAsm(Byte1,3) = 0
MPEGVersion = 2
EndIf
; Layer
If MyGetBitAsm(Byte1,2) = 1 And MyGetBitAsm(Byte1,1) = 1
MPEGLayer = 1
EndIf
If MyGetBitAsm(Byte1,2) = 1 And MyGetBitAsm(Byte1,1) = 0
MPEGLayer = 2
EndIf
If MyGetBitAsm(Byte1,2) = 0 And MyGetBitAsm(Byte1,1) = 1
MPEGLayer = 3
EndIf
If MyGetBitAsm(Byte1,2) = 0 And MyGetBitAsm(Byte1,1) = 0
MPEGLayer = 0
EndIf
bitr$ = Str(MyGetBitAsm(Byte2,7))
bitr$ + Str(MyGetBitAsm(Byte2,6))
bitr$ + Str(MyGetBitAsm(Byte2,5))
bitr$ + Str(MyGetBitAsm(Byte2,4))
Select bitr$
Case "0001"
BitPos = 1
Case "0010"
BitPos = 2
Case "0011"
BitPos = 3
Case "0100"
BitPos = 4
Case "0101"
BitPos = 5
Case "0110"
BitPos = 6
Case "0111"
BitPos = 7
Case "1000"
BitPos = 8
Case "1001"
BitPos = 9
Case "1010"
BitPos = 10
Case "1011"
BitPos = 11
Case "1100"
BitPos = 12
Case "1101"
BitPos = 13
Case "1110"
BitPos = 14
Case "1111"
BitPos = 15
EndSelect
If MPEGLayer = 1 And MPEGVersion = 1
Bitrate.l = V1L1(BitPos)
EndIf
If MPEGLayer = 2 And MPEGVersion = 1
Bitrate.l = V1L2(BitPos)
EndIf
If MPEGLayer = 3 And MPEGVersion = 1
Bitrate.l = V1L3(BitPos)
EndIf
If MPEGLayer = 1 And MPEGVersion = 2
Bitrate.l = V2L1(BitPos)
EndIf
If MPEGLayer = 2 And MPEGVersion = 2
Bitrate.l = V2L2(BitPos)
EndIf
If MPEGLayer = 3 And MPEGVersion = 2
Bitrate.l = V2L3(BitPos)
EndIf
; Sampling Rate Indexes
Sam$ = Str(MyGetBitAsm(Byte2,3))
Sam$ + Str(MyGetBitAsm(Byte2,2))
Select MPEGVersion
Case 1
Select Sam$
Case "00"
SampleRate = 44100
Case "01"
SampleRate = 48000
Case "10"
SampleRate = 32000
Case "11"
finish = #True
EndSelect
Case 2
Select Sam$
Case "00"
SampleRate = 22050
Case "01"
SampleRate = 24000
Case "10"
SampleRate = 16000
Case "11"
finish = #True
EndSelect
EndSelect
If SampleRate<> 0
FrameCount + 1
Framesize.l = 144 * (Bitrate*1000) / SampleRate + MyGetBitAsm(Byte2,1)
AVGBitrateSum.q + Bitrate
FileSeek(idFile,Loc(idFile)+FrameSize-4)
EndIf
; Optimization:
; If the first 100 FrameHeader contains the same Bitrate, we expect that the mp3 file has a constant
; bitrate and we break here to safe MUCH time running through the complete stream.
; To be absolutly sure of the averange bitstream you may comment this lines out.
If BitRateChanged = #False
If FirstBitrate <> Bitrate And FirstBitrate>0
BitRateChanged = #True
EndIf
If FrameCount=>100
CloseFile(idFile)
ProcedureReturn BitRate
EndIf
FirstBitrate = Bitrate
EndIf
EndIf ; Finish=#False endet hier
Until Eof(idFile) Or finish = #True
CloseFile(idFile)
ProcedureReturn AVGBitrateSum.q/(FrameCount-1)
EndProcedure
; - Xample
File$ = OpenFileRequester("Select Mp3 File","","*.mp3 | *.mp3",0)
If GetMp3FrameInformation(File$)
Debug "First-Frame-Header Information:"
Debug "Mpeg Version:"+Str(Mp3Frame\Version)
Debug "Layer:"+Str(Mp3Frame\Layer)
Debug "SamplingRate:"+Str(Mp3Frame\SamplingRate)
Debug "Please wait...."
AVGBitrate=GetAveranteBitrate(File$)
; Accordings to our averange Bitrate we can calculate out oplaytime
If AVGBitrate > 0 And Mp3Frame\SamplingRate > 0
Sek.l = Int(Mp3Frame\MPEGSize * 8) / (AVGBitrate *1000)
Debug "avg-Bitrate:"+Str(avgbitrate)
Debug "Time : "+Str(Sek/60)+":"+RSet(Str(Sek % 60),2,"0")+" min"
EndIf
Else
Debug "File Could not be opened."
EndIf
End
