Delphi MP3 Cutting

I haven't written a blog for a long time. I sent an original Delphi MP3 cut. splitmp3 is the cut function and supports cutting by time and by size. Hope you can support it.

Refer to VC documents for compiling MP3 cutting unit in Delphi.

Unit unitmp3datautil;

{
MP3 cut unit.
@ Author Jim Wu
2009-08
}

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls;
Type
Mp3splitmode = (mp3splitbytime, mp3splitbydatelength );
Tmp3datainfo = packed record
Ismp3: Boolean;
Bitrate: integer;
Samplerate: integer;
Ismono: Boolean;
Isvbr: Boolean;
End;

Function readmp3head (filename: string): tmp3datainfo;
Function splitmp3 (Mode: mp3splitmode; Length: integer; FR: tfilestream; writefilename: string; var actuallength: integer; var actualmillisecond: integer): integer;

Const
Mpegbitratetable: array [1 .. 2, 1 .. 3, 1 .. 14] of integer = (
(
(32, 64, 96,128,160,192,224,256,288,320,352,384,416,448 ),
(32, 48, 56, 64, 80, 96,112,128,160,192,224,256,320,384 ),
(32, 40, 48, 56, 64, 80, 96,112,128,160,192,224,256,320)
),
(
(32, 48, 56, 64, 80, 96,112,128,144,160,176,192,224,256 ),
(8, 16, 24, 32, 40, 48, 56, 64, 80, 96,112,128,144,160 ),
(8, 16, 24, 32, 40, 48, 56, 64, 80, 96,112,128,144,160)
)
);
Samplingratetable: array [1 .. 3, 0 .. 2] of integer = (
(44100, 48000, 32000 ),
(16000 ),
(8000)
);
Framelengthtable: array [1 .. 2, 1 .. 3] of integer = (
(144000 ),
(24000,720 00, 72000)
);
Samplesperframetable: array [1 .. 2, 1 .. 3] of integer = (
(1152 ),
(576)
);

Implementation

Function readmp3head (filename: string): tmp3datainfo;
VaR
Bindata: array [0 .. 3] of byte;
Tempdate: array [0 .. 3] of byte;
FR: tfilestream;
Mpegpadding: byte;
Mpegversion: Double;
Mpeglayer: byte;
Seekdatalength: integer;
Begin
FR: = tfilestream. Create (filename, fmopenread );
Fr. Read (bindata, 4 );
If (bindata [0] = $49) and (bindata [1] = $44) and (bindata [2] = $33) then
Begin // readmp3head
Fr. Seek (2, sofromcurrent );
Fr. Read (tempdate, 4); // resolution Length
Seekdatalength: = tempdate [0] and $ 7f SHL 21 + tempdate [1] and $ 7f SHL 14 + tempdate [2] and $ 7f SHL 7 + tempdate [3] and $ 7f;
Fr. Seek (seekdatalength, sofromcurrent );
Fr. Read (bindata, 4 );
End;

If bindata [0] = $ FF then // data frame
Begin
Case bindata [1] SHR 3 and $3
0: mpegversion: = 2.5;
1:; // Reserved
2: mpegversion: = 2;
3: mpegversion: = 1;
End;

Mpeglayer: = 4-(bindata [1] SHR 1 and $3 );

Result. bitrate: = mpegbitratetable [trunc (mpegversion)] [mpeglayer] [bindata [2] SHR 4 and $ F];
Result. samplerate: = samplingratetable [trunc (mpegversion + 0.5)] [bindata [2] SHR 2 and $3];
Mpegpadding: = bindata [2] SHR 1 and $1;

If bindata [3] SHR 6 and $3 = 3 then
Result. ismono: = true
Else
Result. ismono: = false;

Fr. Seek (32, sofromcurrent); // read Xing (VBR) Flag
Fr. Read (tempdate, 4 );

If (tempdate [0] = $58) and (tempdate [1] = $69) and (tempdate [2] = $ 6e) and (tempdate [3] = $67) then
Result. isvbr: = true
Else
Result. isvbr: = false;
Result. ismp3: = true;
End
Else
Result. ismp3: = false; // not MP3 file

Fr. free;
End;

Function processframe (FR: tfilestream; Fw: tfilestream; var writelength: integer; var writemillisecond: Double): longint; // return: File Location
VaR
Bindata: array [0 .. 3] of byte;
Seekdatalength: integer;
Mpegpadding: byte;
Mpegversion: Double;
Mpeglayer: byte;
Mpegbitrate: integer;
Mpegsamplingrate: integer;
Trackmode: integer;
Begin
Fr. Read (bindata, 4 );
If (bindata [0] = $49) and (bindata [1] = $44) and (bindata [2] = $33) then
Begin // idv3
Fr. Seek (2, sofromcurrent );
Fr. Read (bindata, 4); // resolution Length
Seekdatalength: = bindata [0] and $ 7f SHL 21 + bindata [1] and $ 7f SHL 14 + bindata [2] and $ 7f SHL 7 + bindata [3] and $ 7f;
Fr. Seek (seekdatalength, sofromcurrent); // instead of write

Writelength: = 0;
Writemillisecond: = 0;
End
Else
If bindata [0] = $ FF then // data frame
Begin

Case bindata [1] SHR 3 and $3
0: mpegversion: = 2.5;
1:; // Reserved
2: mpegversion: = 2;
3: mpegversion: = 1;
End;

Mpeglayer: = 4-(bindata [1] SHR 1 and $3 );

Mpegbitrate: = mpegbitratetable [trunc (mpegversion)] [mpeglayer] [bindata [2] SHR 4 and $ F];
Mpegsamplingrate: = samplingratetable [trunc (mpegversion + 0.5)] [bindata [2] SHR 2 and $3];
Mpegpadding: = bindata [2] SHR 1 and $1;

Seekdatalength: = trunc (samplesperframetable [trunc (mpegversion)] [mpeglayer]/8 * mpegbitrate * 1000)/mpegsamplingrate) + mpegpadding;

Fr. Seek (32, sofromcurrent); // read Xing (VBR) Flag
Fr. Read (bindata, 4 );

If (bindata [0] = $58) and (bindata [1] = $69) and (bindata [2] = $ 6e) and (bindata [3] = $67) then
Begin
Fr. Seek (seekdatalength-4-32-4, sofromcurrent );
Result: = Fr. position;
Writelength: = 0;
Writemillisecond: = 0;
End
Else // writedata
Begin
Fr. Seek (-32-4-4, sofromcurrent );
FW. copyfrom (FR, seekdatalength); // copy a frame
Writelength: = seekdatalength;
Writemillisecond: = samplesperframetable [trunc (mpegversion)] [mpeglayer] * 1000.0/mpegsamplingrate;
Result: = Fr. position;
End;
End
Else
Begin
Writelength: = 0;
Writemillisecond: = 0;
Result: = Fr. position;
End;
End;

 

Function splitmp3 (Mode: mp3splitmode; Length: integer; FR: tfilestream; writefilename: string; var actuallength: integer; var actualmillisecond: integer): integer;
// Length: restriction. For splitbytime, It is millisecond. For length, it is byte.
// Actuallength indicates the actual splitting length, and actualtime indicates the actual splitting time in milliseconds.
VaR
Writelength: integer;
Writemillisecond: Double;
Tempmillisecond: Double;
FW: tfilestream;
Total: Double;
Begin

FW: = tfilestream. Create (writefilename, fmopenwrite or fmcreate );
Total: = 0;
Actuallength: = 0;
Tempmillisecond: = 0;
While true do
Begin
If fr. Position> = Fr. Size-4 then
Break;
If total> = length then
Break;

Result: = processframe (FR, FW, writelength, writemillisecond );
INC (actuallength, writelength );
Tempmillisecond: = tempmillisecond + writemillisecond;
If mode = mp3splitbytime then
Total: = total + writemillisecond
Else
Total: = total + writelength;
End;
Actualmillisecond: = trunc (tempmillisecond );
FW. Free;
End;

End.