as ever with the release of purebasic 4.20 compiles el 'execution works! ?
and as purebasic 4.0 does not work?, appears in the read error. in line 416.
ok run in purebasic 4.20 , error in version purebasic 4.30 in line 416 read data error:no more data
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
expect more news soon for the solution to 'error!
