www.pudn.com > MP4Cam2AVI_SRC_1.2.zip > AviMux.pas
// MP4Cam2AVI - .MP4 to .AVI converter
// Copyright (C) 2004 Oleg Mikheev, graywolf2004@mail.ru
//
// This program is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2 of the License, or
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with this program; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
//
// Any non-GPL usage of this software or parts of this software is strictly
// forbidden.
unit AviMux;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, StrUtils, FileCtrl, Menus, ExtCtrls, ComCtrls, Gauges,
IniFiles, ShellAPI, Math, Buttons, Buffer, libfaad2, Lame_dll;
type
TfMain = class(TForm)
MainMenu: TMainMenu;
nFile: TMenuItem;
nHelp: TMenuItem;
pWorkingDir: TPanel;
pDriveBox: TPanel;
pFileListBox: TPanel;
FileListBox: TFileListBox;
pDirListBox: TPanel;
DirListBox: TDirectoryListBox;
pMainContainer: TPanel;
DriveBox: TDriveComboBox;
pBottom: TPanel;
StatusBar: TStatusBar;
pMain: TPanel;
pStart: TPanel;
bStart: TButton;
pGauges: TPanel;
pGaugeCurrentOp: TPanel;
GaugeCurrent: TGauge;
lGaugeCurrent: TLabel;
pGaugesTotal: TPanel;
GaugeTotal: TGauge;
lGaugeTotal: TLabel;
pMedia: TPanel;
bSelectAll: TButton;
pRight: TPanel;
pStats: TPanel;
lStats: TLabel;
lStats1: TLabel;
lStats2: TLabel;
lStats0: TLabel;
lStats3: TLabel;
SaveDialog: TSaveDialog;
pFrozen: TPanel;
Memo: TMemo;
lFrozen0: TLabel;
OpenDialog: TOpenDialog;
Exit1: TMenuItem;
Manual1: TMenuItem;
About1: TMenuItem;
Homepage1: TMenuItem;
pToolBar: TPanel;
bPreview: TButton;
N3: TMenuItem;
AboutMP4Cam2AVI1: TMenuItem;
Changelog1: TMenuItem;
Releasenotes1: TMenuItem;
N1: TMenuItem;
Saveconversionlog1: TMenuItem;
pInfo: TPanel;
lInfo3: TLabel;
lInfo2: TLabel;
lInfo1: TLabel;
lInfo0: TLabel;
lInfo: TLabel;
Setti1: TMenuItem;
Settings1: TMenuItem;
pAction: TPanel;
rgFrozen: TRadioGroup;
eMinGoodTime: TEdit;
cbTargetName: TComboBox;
bOpenTarget: TButton;
lTargetName: TLabel;
eOutFile: TEdit;
lOutFile: TLabel;
cbCropFrames: TCheckBox;
cbFcc: TComboBox;
cbFrameSize: TComboBox;
lFrameSize: TLabel;
lFcc: TLabel;
cbAction: TComboBox;
lAction: TLabel;
lAudioFormat: TLabel;
cbAudioFormat: TComboBox;
procedure FormShow(Sender: TObject);
procedure bStartClick(Sender: TObject);
procedure DirListBoxChange(Sender: TObject);
procedure bOpenTargetClick(Sender: TObject);
procedure bSelectAllClick(Sender: TObject);
procedure cbActionChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FileListBoxDblClick(Sender: TObject);
procedure cbTargetNameChange(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure bBrowseAVIPlayerClick(Sender: TObject);
procedure bBrowseMP4PlayerClick(Sender: TObject);
procedure bBrowseASXPlayerClick(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure bPreviewClick(Sender: TObject);
procedure AboutMP4Cam2AVI1Click(Sender: TObject);
procedure Homepage1Click(Sender: TObject);
procedure Changelog1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Releasenotes1Click(Sender: TObject);
procedure Saveconversionlog1Click(Sender: TObject);
procedure FileListBoxClick(Sender: TObject);
procedure Manual1Click(Sender: TObject);
procedure Settings1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TChunk = record
Data: TBuffer;
Size: integer;
Pref: string[4];
Flags: integer;
FB: integer;
end;
TAVIState = record
ChunkInd: integer;
ChunkSize: integer;
Idx1Indx: integer;
Idx1Size: integer;
FramesRead: integer;
FilePos: integer;
DataSize: integer;
AudioSize: integer;
Chunks: integer;
Frames: integer;
FSize: integer;
end;
TAVIFile = class
Frames: integer;
FramesRead: integer;
W: integer;
H: integer;
FPS: real;
FPSA: integer;
FPSB: integer;
FourCC: string[4];
AudioTag: word;
AudioType: string;
AudioSize: integer;
Chunks: integer;
SampleRate: integer;
BytesPerSec: integer;
FrameAudioSize: real;
Channels: byte;
private
F: File;
FSize: integer;
HeaderSize: integer;
HeaderData: TBuffer;
DataOffs: integer;
DataSize: integer;
Idx1Size: integer;
Idx1Data: TBuffer;
Idx1Indx: integer;
ChunkInd: integer;
ChunkSize: integer;
public
constructor Create(fname: string; writing: boolean);
destructor Destroy;override;
function ReadHeader: string;
procedure WriteHeader;
procedure SetAudioFormat(FormatIndex: integer; var HeaderFile: string);
procedure WriteChunk(var Chunk: TChunk);
procedure WriteIdx1Data;
procedure ReadHeaderFromFile(fname: string);
procedure SaveState(var AVIState: TAVIState);
procedure TakeState(var AVIState: TAVIState);
end;
TMp4File = class
Frames: integer;
FramesRead: integer;
AFrames: integer;
AFramesRead: integer;
SampleSize: integer;
FPS: real;
FPSA: integer;
FPSB: integer;
W: integer;
H: integer;
ATrak: string;
VTrak: string;
SampleRate: integer;
Channels: Byte;
LastAACFrameDecoded: byte;
LastMP3FrameEncoded: byte;
private
F: File;
FSize: integer;
SizeBuf: TBuffer;
OffsBuf: TBuffer;
PrefBuf: TBuffer;
ASizeBuf: TBuffer;
AOffsBuf: TBuffer;
WavBuf: TBuffer;
WavPos: integer;
FramesRead_: integer;
FaadHandle: THandle;
FaadDecConfig: TBuffer;
public
constructor Create(fname: string; var err: string);
destructor Destroy;override;
function ReadChunk(var Chunk: TChunk):boolean;
function ReadAChunk(var Chunk: TChunk):boolean;
function ReadAACChunk(var Chunk: TChunk; cropFrames: boolean):boolean;
function ReadWavChunk(var Chunk: TChunk; ReadSamples: integer; cropFrames: boolean):boolean;
function ReadMp3Chunk(var Chunk: TChunk; cropFrames: boolean):boolean;
function LookForGoodInterval(ChunkPrev: TChunk; minTime: integer): integer;
procedure Snapshot;
procedure Revert;
procedure WriteAACFile(fname: string);
end;
TStartThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
public
end;
var
fMain: TfMain;
exePath, SaveFileName: string;
INIFile: TINIFile;
LameConfig: TBEConfig;
LameStream: THBESTREAM;
LameInitialized: boolean;
implementation
uses AboutForm, GPLForm, ChangeLogForm,
RelNotesForm, SettingsForm;
{$R *.dfm}
{ FUNCIONS }
function IntPrint(i: integer): string;
begin
IntPrint := Trim(FormatFloat('# ### ### ##0', i));
end;
function TimeToStr(t: integer):string;
var min: integer;
smin, ssec: string;
begin
if (t < 0) then t := 0;
t := Round(t / 1000);
min := Trunc(t / 60);
ssec := IntToStr(t - min * 60);
smin := IntToStr(min);
if Length(smin) = 1 then smin := '0' + smin;
if Length(ssec) = 1 then ssec := '0' + ssec;
TimeToStr := smin + ':' + ssec;
end;
procedure AVIFileChangeFourCC(fname, fcc: string);
var F: File of byte;
buf: TBuffer;
begin
AssignFile(F, fname);
Reset(F);
SetLength(buf, $C0);
BlockRead(F, buf[0], $C0);
if (BufferToString(buf, 0, 4) = 'RIFF') and (BufferToString(buf, 8, 4) = 'AVI ') then
begin
fcc := Copy(fcc, 1, 4);
BufferWriteString(buf, fcc, $70);
BufferWriteString(buf, fcc, $BC);
Seek(F, 0);
BlockWrite(F, buf[0], $C0);
end;
Close(F);
end;
procedure Exec(exeStr: string);
var
ProcessInfo: TProcessInformation;
start: TStartupInfo;
begin
FillChar(ProcessInfo, sizeof(TProcessInformation), 0);
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
// start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(exeStr), nil, nil, true, CREATE_NO_WINDOW or IDLE_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
begin
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
end;
procedure ReadINI;
begin
INIFile := TINIFile.Create(exePath + 'settings.ini');
fMain.DirListBox.Directory := INIFile.ReadString('MAIN', 'DIRECTORY', 'C:\');
fMain.cbAction.ItemIndex := StrToInt(INIFile.ReadString('MAIN', 'ACTION', '0'));
fMain.cbCropFrames.Checked := StrToBool(INIFile.ReadString('MAIN', 'CROPFRAMES', '0'));
fMain.cbFcc.ItemIndex := StrToInt(INIFile.ReadString('MAIN', 'FOURCCNUM', '0'));
fMain.cbFrameSize.ItemIndex := StrToInt(INIFile.ReadString('MAIN', 'FRAMESIZE', '1'));
fMain.cbAudioFormat.ItemIndex := StrToInt(INIFile.ReadString('MAIN', 'AUDIOFORMAT', '3'));
fMain.eOutFile.Text := INIFile.ReadString('MAIN', 'OUTFILE', 'C:\VideoOut.avi');
fMain.cbTargetName.ItemIndex := StrToInt(INIFile.ReadString('MAIN', 'TARGETAUTOUPDATE', '1'));
fMain.rgFrozen.ItemIndex := StrToInt(INIFile.ReadString('MAIN', 'FROZENFRAMES', '3'));
fMain.eMinGoodTime.Text := INIFile.ReadString('MAIN', 'MINGOODTIME', '2000');
fSettings.eMP4Player.Text := INIFile.ReadString('MAIN', 'MP4PLAYER', '');
fSettings.eAVIPlayer.Text := INIFile.ReadString('MAIN', 'AVIPLAYER', '');
fSettings.eASXPlayer.Text := INIFile.ReadString('MAIN', 'ASXPLAYER', '');
end;
procedure WriteINI;
begin
INIFile.WriteString('MAIN', 'DIRECTORY', fMain.DirListBox.Directory);
INIFile.WriteString('MAIN', 'ACTION', IntToStr(fMain.cbAction.ItemIndex));
INIFile.WriteString('MAIN', 'CROPFRAMES', BoolToStr(fMain.cbCropFrames.Checked));
INIFile.WriteString('MAIN', 'FOURCCNUM', IntToStr(fMain.cbFcc.ItemIndex));
INIFile.WriteString('MAIN', 'FRAMESIZE', IntToStr(fMain.cbFrameSize.ItemIndex));
INIFile.WriteString('MAIN', 'AUDIOFORMAT', IntToStr(fMain.cbAudioFormat.ItemIndex));
INIFile.WriteString('MAIN', 'OUTFILE', fMain.eOutFile.Text);
INIFile.WriteString('MAIN', 'TARGETAUTOUPDATE', IntToStr(fMain.cbTargetName.ItemIndex));
INIFile.WriteString('MAIN', 'FROZENFRAMES', IntToStr(fMain.rgFrozen.ItemIndex));
INIFile.WriteString('MAIN', 'MINGOODTIME', fMain.eMinGoodTime.Text);
INIFile.WriteString('MAIN', 'MP4PLAYER', fSettings.eMP4Player.Text);
INIFile.WriteString('MAIN', 'AVIPLAYER', fSettings.eAVIPlayer.Text);
INIFile.WriteString('MAIN', 'ASXPLAYER', fSettings.eASXPlayer.Text);
INIFile.Destroy;
end;
procedure PlayListSave(FileList: TStringList; FileName: string);
var F: TextFile;
i, p: integer;
s, name: string;
begin
AssignFile(F, FileName);
Rewrite(F);
WriteLn(F, '');
WriteLn(F, '');
WriteLn(F, '');
for i := 0 to Filelist.Count - 1 do
begin
s := FileList[i];
p := LastDelimiter('\', s);
name := Copy(s, p + 1, Length(s) - p + 1);
WriteLn(F, '');
WriteLn(F, '');
WriteLn(F, '');
WriteLn(F, '');
WriteLn(F, '');
WriteLn(F, '');
WriteLn(F, ' ');
end;
WriteLn(F, ' ');
CloseFile(F);
end;
procedure PlayListOpen(FileName: string);
var cmd: string;
begin
cmd := fSettings.eASXPlayer.Text;
if (cmd = '') then
begin
cmd := FileName;
FileName := '';
end;
ShellExecute(fMain.Handle, 'open', PChar(cmd), PChar(FileName), nil, SW_SHOWNORMAL);
end;
function Mp4FileReadFrames(FileName: string):integer;
var InFIle: TMP4File;
err: string;
begin
InFile := TMP4File.Create(FileName, err);
Mp4FileReadFrames := InFile.Frames;
InFile.Destroy;
end;
function SameChunkData(Chunk1, Chunk2: TChunk):boolean;
var i, MinSize: integer;
R: boolean;
begin
R := true;
MinSize := Min(Chunk1.Size, Chunk2.Size);
for i := 0 to MinSize - 1 do
begin
if (Chunk1.Data[i] <> Chunk2.Data[i]) then R := false;
end;
if MinSize = 0 then R := false;
SameChunkData := R;
end;
{ TAVIFile implementation }
constructor TAVIFile.Create(fname: string; writing: boolean);
begin
AssignFile(F, fname);
if (writing = true) then
Rewrite(F, 1) else
Reset(F, 1);
FSize := FileSize(F);
HeaderSize := 0;
DataOffs := 0;
DataSize := 4;
Idx1Size := 0;
Idx1Indx := 8;
SetLength(Idx1Data, 65536);
BufferWriteString(Idx1Data, 'idx1', 0);
BufferWriteDwordRev(Idx1Data, $00000000, 4);
ChunkInd := 4;
ChunkSize := 0;
Frames := 0;
FramesRead := 0;
W := 640; H := 480;
FPSA := 30000;
FPSB := 1001;
FPS := FPSA / FPSB;
Chunks := 0;
AudioSize := 0;
SampleRate := 48000;
BytesPerSec := 48000 * 4;
Channels := 2;
FrameAudioSize := BytesPerSec / FPS;
end;
destructor TAVIFile.Destroy;
begin
Close(F);
HeaderData := nil;
Idx1Data := nil;
end;
function TAVIFile.ReadHeader:string;
var buf: TBuffer;
junkSize: integer;
n: integer;
begin
ReadHeader := '';
SetLength(buf, 24);
if (FileSize(F) < 8192) then
begin
ReadHeader := 'ERROR 001: FILE IS LESS THAN 8192 BYTES';
Exit;
end;
Seek(F, 0);
BlockRead(F, buf[0], 24);
HeaderSize := 20 + BufferToDwordRev(buf, 16);
if (BufferToString(buf, 0, 4) <> 'RIFF') or (BufferToString(buf, 8, 4) <> 'AVI ') then
begin
ReadHeader := 'ERROR 002: WRONG AVI HEADER';
Exit;
end;
// JUNKS AND LISTS
Try
Repeat
Seek(F, HeaderSize);
BlockRead(F, buf[0], 20);
if (BufferToString(buf, 0, 4) = 'JUNK') or (BufferToString(buf, 0, 4) = 'LIST') then
begin
if (BufferToString(buf, 8, 4) <> 'movi') then
begin
junkSize := BufferToDwordRev(buf, 4);
HeaderSize := HeaderSize + 8 + junkSize;
if (HeaderSize + 12 > FileSize(F)) then
begin
ReadHeader := 'ERROR 003: START OF MOVI DATA NOT FOUND';
Exit;
end;
end;
end;
until (BufferToString(buf, 8, 4) = 'movi');
except
ReadHeader := 'ERROR 004: START OF MOVI DATA NOT FOUND';
Exit;
end;
// LIST movi (ÍÀ×ÀËÎ ÀÓÄÈÎ È ÂÈÄÅÎ)
DataSize := BufferToDwordRev(buf, 4);
DataOffs := HeaderSize + 8;
// NEXTCHUNKSIZE
ChunkSize := BufferToDwordRev(buf, 16);
// IDX1
Seek(F, DataOffs + DataSize);
BlockRead(F, buf[0], 8);
if (BufferToString(buf, 0, 4) <> 'idx1') then
begin
ReadHeader := 'ERROR 005: START OF IDX1 DATA NOT FOUND';
Exit;
end;
Idx1Size := BufferToDwordRev(buf, 4);
// ×ÈÒÀÅÌ ÇÀÃÎËÎÂÎÊ È ÈÇÂËÅÊÀÅÌ ÏÀÐÀÌÅÒÐÛ
Seek(F, 0);
SetLength(HeaderData, 65536);
BlockRead(F, HeaderData[0], HeaderSize + 12, n);
// ÂÈÄÅÎ
Frames := BufferToDwordRev(HeaderData, $30);
FPSA := BufferToDwordRev(HeaderData, $84);
FPSB := BufferToDwordRev(HeaderData, $80);
FPS := FPSA / FPSB;
FourCC := BufferToString(HeaderData, $70, 4);
W := BufferToDwordRev(HeaderData, $40);
H := BufferToDwordRev(HeaderData, $44);
// ÀÓÄÈÎ
BytesPerSec := BufferToDwordRev(HeaderData, $100);
AudioSize := BufferToDwordRev(HeaderData, $108);
Channels := BufferToByte(HeaderData, $12A);
SampleRate := BufferToDwordRev(HeaderData, $12C);
AudioTag := BufferToDwordRev(HeaderData, $128) AND $0000FFFF;
case AudioTag of
$0001: AudioType := 'PCM';
$0055: AudioType := 'mp3';
$00FF: AudioType := 'AAC';
else AudioType := 'unknown';
end;
// ÂÛ×ÈÑËßÅÌÛÅ ÏÀÐÀÌÅÒÐÛ
FrameAudioSize := BytesPerSec / FPS;
end;
procedure BufferRemoveBytes(var buf: TBuffer; index, count: integer);
var i: integer;
begin
for i := index + count to Length(buf) - 1 do
buf[i - count] := buf[i];
end;
procedure TAVIFile.SetAudioFormat(FormatIndex: integer; var HeaderFile: string);
begin
// AVI HEADER SELECT
// BYTESPERSEC
SampleRate := 48000;
Channels := 2;
case FormatIndex of
0: begin
HeaderFile := 'avih_aac.bin';
BytesPerSec := 18000;
Channels := 2;
end;
1: begin
HeaderFile := 'avih_pcm.bin';
BytesPerSec := SampleRate * Channels * 2;
end;
2: begin
HeaderFile := 'avih_mp3cbr.bin';
BytesPerSec := 32000;
end;
3: begin
HeaderFile := 'avih_mp3cbr.bin';
BytesPerSec := 16000;
end;
4: begin
HeaderFile := 'avih_mp3cbr.bin';
BytesPerSec := 8000;
Channels := 1;
end;
end;
FrameAudioSize := BytesPerSec / FPS;
end;
procedure TAVIFile.SaveState(var AVIState: TAVIState);
begin
// READ STATE
AVIState.ChunkInd := ChunkInd;
AVIState.ChunkSize := ChunkSize;
AVIState.Idx1Indx := Idx1Indx;
AVIState.FramesRead := FramesRead;
AVIState.FilePos := FilePos(F);
// WRITE STATE
AVIState.DataSize := DataSize;
AVIState.Idx1Size := Idx1Size;
AVIState.AudioSize := AudioSize;
AVIState.Chunks := Chunks;
AVIState.Frames := Frames;
AVIState.FSize := FSize;
end;
procedure TAVIFile.TakeState(var AVIState: TAVIState);
begin
// READ STATE
ChunkInd := AVIState.ChunkInd;
ChunkSize := AVIState.ChunkSize;
Idx1Indx := AVIState.Idx1Indx;
FramesRead := AVIState.FramesRead;
Seek(F, AVIState.FilePos);
// WRITE STATE
DataSize := AVIState.DataSize;
Idx1Size := AVIState.Idx1Size;
AudioSize := AVIState.AudioSize;
Chunks := AVIState.Chunks;
Frames := AVIState.Frames;
FSize := AVIState.FSize;
end;
procedure TAVIFile.ReadHeaderFromFile(fname: string);
var H: File;
begin
AssignFile(H, fname);
Reset(H, 1);
SetLength(HeaderData, FileSize(H) + 12);
BlockRead(H, HeaderData[0], FileSize(H), HeaderSize);
DataOffs := HeaderSize + 8;
end;
procedure TAVIFile.WriteHeader;
var t: integer;
fcc: string;
begin
// VIDEO HEADER INFORMATION
// AVI SIZE
t := HeaderSize + DataSize + Idx1Indx;
BufferWriteDwordRev(HeaderData, t, 4);
// MOVI SIZE
BufferWriteString(HeaderData, 'LIST', HeaderSize);
BufferWriteDwordRev(HeaderData, DataSize, HeaderSize + 4);
BufferWriteString(HeaderData, 'movi', HeaderSize + 8);
// FOURCC
fcc := Copy(fMain.cbFcc.Text, 1, 4);
BufferWriteString(HeaderData, fcc, $70);
BufferWriteString(HeaderData, fcc, $BC);
// FPS
BufferWriteDwordRev(HeaderData, FPSA, $84);
BufferWriteDwordRev(HeaderData, FPSB, $80);
// FRAMES
BufferWriteDwordRev(HeaderData, Frames, $30);
BufferWriteDwordRev(HeaderData, Frames, $8C);
// FRAME WIDTH AND HEIGHT
BufferWriteDwordRev(HeaderData, W, $40);
BufferWriteDwordRev(HeaderData, H, $44);
BufferWriteDwordRev(HeaderData, W, $B0);
BufferWriteDwordRev(HeaderData, H, $B4);
BufferWriteDwordRev(HeaderData, (H)*65536 + (W), $A0);
// AUDIO HEADER INFORMATION
BufferWriteDwordRev(HeaderData, BytesPerSec, $100);
BufferWriteDwordRev(HeaderData, BytesPerSec, $130);
BufferWriteDwordRev(HeaderData, Round(AudioSize), $108);
BufferWriteByte(HeaderData, Channels, $12A);
BufferWriteDwordRev(HeaderData, SampleRate, $12C);
// ÏÈØÅÌ Â ÔÀÉË
Seek(F, 0);
BlockWrite(F, HeaderData[0], HeaderSize + 12);
end;
procedure TAVIFile.WriteChunk(var Chunk: TChunk);
var ZeroSize: integer;
begin
// ÂÛÐÀÂÍÈÂÀÅÌ ÏÎ ÃÐÀÍÈÖÅ ÑËÎÂÀ
ZeroSize := 0;
if (Chunk.Size/2 <> Trunc(Chunk.Size/2)) then
begin
ZeroSize := 1;
Chunk.Data[Chunk.Size + 8] := Chr(0);
end;
if (Chunk.Pref = '00dc') or (Chunk.Pref = '00db') then
begin
Frames := Frames + 1;
end else
begin
Chunks := Chunks + 1;
AudioSize := AudioSize + Chunk.Size;
end;
// IDX1 DATA
if (Idx1Indx + 16 >= Length(Idx1Data)) then SetLength(Idx1Data, Length(Idx1Data) + 65536);
BufferWriteString(Idx1Data, Chunk.Pref, Idx1Indx);
BufferWriteDwordRev(Idx1Data, Chunk.Flags, Idx1Indx + 4);
BufferWriteDwordRev(Idx1Data, DataSize, Idx1Indx + 8);
BufferWriteDwordRev(Idx1Data, Chunk.Size, Idx1Indx + 12);
Idx1Indx := Idx1Indx + 16;
Idx1Size := Idx1Size + 16;
// ÏÈØÅÌ ÄÀÍÍÛÅ Â ÔÀÉË
BlockWrite(F, Chunk.Data[0], 8 + Chunk.Size + ZeroSize);
DataSize := DataSize + 8 + Chunk.Size + ZeroSize;
end;
procedure TAVIFile.WriteIdx1Data;
begin
Seek(F, DataOffs + DataSize);
BufferWriteString(Idx1Data, 'idx1', 0);
BufferWriteDwordRev(Idx1Data, Idx1Size, 4);
BlockWrite(F, Idx1Data[0], Idx1Indx);
end;
{TMp4 implementation}
constructor TMp4File.Create(fname: string; var err: string);
var header_start, header_size: integer;
buf: TBuffer;
mdat, moov, pos, len: integer;
v_trak, v_stsc, v_stsz, v_stco: integer;
a_trak, a_stsc, a_stsz, a_stco, a_esds: integer;
box_start, box_size: array[0..7] of integer;
box_id: array[0..7] of string[4];
header_type, trak_type: string;
BOffsSize, BSizeSize, BStscSize, bptr, bnext, bpos, bsize, fr, Offs, i, j, k, bnum, bcnt: integer;
BOffsBuf, BStscBuf, BSizeBuf: TBuffer;
ErrCode: ShortInt;
debug_level: integer;
Chunk: TChunk;
begin
// ÂÊËÞ×ÈÒÜ ÐÅÆÈÌ ÎÒËÀÄÊÈ
debug_level := 0;
if (debug_level > 0) then fMain.Memo.Clear;
// ÏÅÐÂÀß ×ÀÑÒÜ - ÈÙÅÌ ÇÀÃÎËÎÂÎÊ È ×ÈÒÀÅÌ ÅÃÎ Â ÁÓÔÅÐ
// ÂÎÇÂÐÀÙÀÅÌ FRAMES=0 ÅÑËÈ ÍÅ ÓÄÀÅÒÑß ÐÀÑÏÎÇÍÀÒÜ ÇÀÃÎËÎÂÎÊ
Frames := 0;
AFrames := 0;
SampleSize := 0;
// ×ÈÒÀÅÌ ÔÀÉË
AssignFile(F, fname);
Reset(F, 1);
FSize := FileSize(F);
if (FSize < 1024) then
begin
// ÎØÈÁÊÀ - ÔÀÉË ÑËÈØÊÎÌ ÌÀËÅÍÜÊÈÉ
err := 'file is too small';
Exit;
end;
// ÎÏÐÅÄÅËßÅÌ ÍÀ×ÀËÎ È ÐÀÇÌÅÐ ÇÀÃÎËÎÂÊÀ
SetLength(buf, 64);
BlockRead(F, buf[0], Length(buf));
mdat := BufferSearchString(buf, 'mdat', 0);
moov := BufferSearchString(buf, 'moov', 0);
if mdat > 0 then
begin
// MOV LAYOUT
header_start := BufferToDword(buf, mdat - 4) + mdat;
Seek(F, header_start);
header_size := FSize - header_start - 1;
header_type := 'mov';
if (debug_level > 0) then fMain.Memo.Lines.Add('MOV layout');
end
else if moov > 0 then
begin
// MP4 LAYOUT
header_size := BufferToDword(buf, moov - 4);
header_start := moov;
header_type := 'mp4';
if (debug_level > 0) then fMain.Memo.Lines.Add('MP4 layout');
end
else
begin
// ÎØÈÁÊÀ - ÍÅ ÓÄÀÅÒÑß ÍÀÉÒÈ ÇÀÃÎËÎÂÎÊ ÔÀÉËÀ
err := 'unable to locate movie header';
Exit;
end;
if (header_start + header_size >= FSize) then
begin
// ÎØÈÁÊÀ - ÇÀÃÎËÎÂÎÊ ÇÀ ÏÐÅÄÅËÛ ÔÀÉËÀ
err := 'movie header runs out of the file size';
Exit;
end;
// ÂÑÅ Â ÏÎÐßÄÊÅ - ×ÈÒÀÅÌ ÇÀÃÎËÎÂÎÊ Â ÁÓÔÅÐ
if (debug_level > 0) then fMain.Memo.Lines.Add('header: ' + IntToHex(header_start, 8) + ' ' + IntToHex(header_size, 8));
buf := nil;
SetLength(buf, header_size);
Seek(F, header_start);
BlockRead(F, buf[0], header_size);
if (BufferToString(buf, 0, 4) <> 'moov') then
begin
// ÎØÈÁÊÀ MOOV ATOM ÍÅ ÍÀÉÄÅÍ
err := 'moov atom not found';
Exit;
end;
// ÎÁÍÓËßÅÌ ÏÅÐÅÌÅÍÍÛÅ
VTrak := ''; v_trak := 0; v_stsc := 0; v_stsz := 0; v_stco := 0;
ATrak := ''; a_trak := 0; a_stsc := 0; a_stsz := 0; a_stco := 0; a_esds := 0;
// ×ÈÒÀÅÌ ÏÎ ÏÎÐßÄÊÓ ÂÑÅ ÏÎËß ÇÀÃÎËÎÂÊÀ ÒÅÊÓÙÅÃÎ ÓÐÎÂÍß
box_start[0] := 8;
Repeat
box_size[0] := BufferToDword(buf, box_start[0] - 4);
box_id[0] := BufferToString(buf, box_start[0], 4);
if (debug_level > 0) then fMain.Memo.Lines.Add('box: ' + box_id[0] + ' ' + IntToHex(header_start + box_start[0], 8) + ' ' + IntToHex(box_size[0], 8));
if (box_id[0] = 'trak') then
begin
// ÓÐÎÂÅÍÜ ÂËÎÆÅÍÍÎÑÒÈ 1
box_start[1] := box_start[0] + 8;
Repeat
box_size[1] := BufferToDword(buf, box_start[1] - 4);
box_id[1] := BufferToString(buf, box_start[1], 4);
if (debug_level > 0) then fMain.Memo.Lines.Add('L1 box: ' + box_id[1] + ' ' + IntToHex(header_start + box_start[1], 8) + ' ' + IntToHex(box_size[1], 8));
if (box_id[1] = 'mdia') then
begin
// ÓÐÎÂÅÍÜ ÂËÎÆÅÍÍÎÑÒÈ 2
box_start[2] := box_start[1] + 8;
Repeat
box_size[2] := BufferToDword(buf, box_start[2] - 4);
box_id[2] := BufferToString(buf, box_start[2], 4);
if (debug_level > 0) then fMain.Memo.Lines.Add('L2 box: ' + box_id[2] + ' ' + IntToHex(header_start + box_start[2], 8) + ' ' + IntToHex(box_size[2], 8));
if (box_id[2] = 'minf') then
begin
// ÓÐÎÂÅÍÜ ÂËÎÆÅÍÍÎÑÒÈ 3
box_start[3] := box_start[2] + 8;
Repeat
box_size[3] := BufferToDword(buf, box_start[3] - 4);
box_id[3] := BufferToString(buf, box_start[3], 4);
if (debug_level > 0) then fMain.Memo.Lines.Add('L3 box: ' + box_id[3] + ' ' + IntToHex(header_start + box_start[3], 8) + ' ' + IntToHex(box_size[3], 8));
if (box_id[3] = 'stbl') then
begin
// ÓÐÎÂÅÍÜ ÂËÎÆÅÍÍÎÑÒÈ 4
box_start[4] := box_start[3] + 8;
Repeat
box_size[4] := BufferToDword(buf, box_start[4] - 4);
box_id[4] := BufferToString(buf, box_start[4], 4);
if (debug_level > 0) then fMain.Memo.Lines.Add('L4 box: ' + box_id[4] + ' ' + IntToHex(header_start + box_start[4], 8) + ' ' + IntToHex(box_size[4], 8));
if (box_id[4] = 'stsd') then
begin
// ÓÐÎÂÅÍÜ ÂËÎÆÅÍÍÎÑÒÈ 5
// ÎÏÐÅÄÅËßÅÌ ÒÈÏ ÒÐÅÊÀ
trak_type := BufferToString(buf, box_start[4] + 16, 4);
if (debug_level > 0) then fMain.Memo.Lines.Add('trak_type: ' + trak_type);
// ÅÑËÈ ÝÒÎ ÂÈÄÅÎ ÒÐÅÊ
if (trak_type = 'mp4v') then
begin
// ÍÀ×ÀËÎ ÂÈÄÅÎ ÒÐÅÊÀ
v_trak := box_start[0];
VTrak := trak_type;
// 32-ÁÀÉÒÎÂÛÉ ÏÐÅÔÈÊÑ ÄËß ÏÅÐÂÎÃÎ ÊÀÄÐÀ
len := Ord(buf[box_start[4] + $83]);
SetLength(PrefBuf, len);
BufferToBuffer(PrefBuf, buf, box_start[4] + $84, len, 0);
end;
// ÅÑËÈ ÝÒÎ AAC ÀÓÄÈÎ ÒÐÅÊ
if (trak_type = 'mp4a') then
begin
// ÍÀ×ÀËÎ ÀÓÄÈÎ ÒÐÅÊÀ
a_trak := box_start[0];
a_esds := BufferSearchString(buf, 'esds', a_trak);
if (a_esds = 0) then
begin
err := 'ES audio config not found (esds box)';
Exit;
end;
ATrak := trak_type;
end;
// ECËÈ ÝÒÎ TWOS (WAV, PETAX OPTIO MX)
if (trak_type = 'ulaw') or (trak_type = 'twos') then
begin
a_trak := box_start[0];
ATrak := trak_type;
end;
end;
// ÎÏÐÅÄÅËßÅÌ ÑÌÅÙÅÍÈß ÍÅÎÁÕÎÄÈÌÛÕ ÁËÎÊÎÂ
// ÅÑËÈ ÌÛ ÂÍÓÒÐÈ ÂÈÄÅÎ ÒÐÅÊÀ
if (trak_type = VTrak) then
begin
if box_id[4] = 'stsc' then v_stsc := box_start[4];
if box_id[4] = 'stsz' then v_stsz := box_start[4];
if box_id[4] = 'stco' then v_stco := box_start[4];
end;
// ÅÑËÈ ÌÛ ÂÍÓÒÐÈ ÀÓÄÈÎ ÒÐÅÊÀ
if (trak_type = ATrak) then
begin
if box_id[4] = 'stsc' then a_stsc := box_start[4];
if box_id[4] = 'stsz' then a_stsz := box_start[4];
if box_id[4] = 'stco' then a_stco := box_start[4];
end;
box_start[4] := box_start[4] + box_size[4];
until (box_start[4] >= box_start[3] + box_size[3]);
end;
box_start[3] := box_start[3] + box_size[3];
until (box_start[3] >= box_start[2] + box_size[2]);
end;
box_start[2] := box_start[2] + box_size[2];
until (box_start[2] >= box_start[1] + box_size[1]);
end;
box_start[1] := box_start[1] + box_size[1];
until (box_start[1] >= box_start[0] + box_size[0]);
// ÎÁÍÓËßÅÌ ÒÈÏ ÒÐÅÊÀ
trak_type := '';
end;
box_start[0] := box_start[0] + box_size[0];
until (box_start[0] >= header_size);
// ÂÈÄÅÎ ÒÐÅÊ ÍÅ ÍÀÉÄÅÍ
if (VTrak = '') then
begin
err := 'MPEG-4 Video (mp4v) trak not found.';
Exit;
end;
// ÈÇÂËÅÊÀÅÌ ÍÅÎÁÕÎÄÈÌÛÅ ÄÀÍÍÛÅ ÈÇ ÂÈÄÅÎ ÇÀÃÎËÎÂÊÀ
// ÐÀÇÌÅÐ ÊÀÄÐÀ
W := BufferToDword(buf, v_trak + $56);
H := BufferToDword(buf, v_trak + $5A);
// ×ÈÑËÎ ÊÀÄÐÎÂ
Frames := BufferToDword(buf, v_stsz + 12);
if (Frames = 0) then
begin
err := 'No video data found.';
Exit;
end;
// FPS
pos := BufferSearchString(buf, 'mdhd', v_trak);
FPSA := BufferToDword(buf, pos + $10);
FPSB := Round(BufferToDword(buf, pos + $14) / Frames);
if (FPSB > 0) then FPS := FPSA / FPSB else FPS := 1;
// ×ÈÒÀÅÌ ÌÀÑÑÈ ÑÎ ÑÌÅÙÅÍÈßÌÈ ÁËÎÊÎÂ
BOffsSize := BufferToDword(buf, v_stco + 8);
BOffsBuf := nil;
SetLength(BOffsBuf, BOffsSize * 4);
BufferToBuffer(BOffsBuf, buf, v_stco + 12, BOffsSize * 4, 0);
// ÔÎÐÌÈÐÓÅÌ ÌÀÑÑÈÂ Ñ ÐÀÇÌÅÐÀÌÈ ÁËÎÊÎÂ (ÄËÈÍÀ ÇÀÏÈÑÈ - 12 ÁÀÉÒ)
BSizeSize := BufferToDword(buf, v_stsc + 8);
BSizeBuf := nil;
SetLength(BSizeBuf, BSizeSize * 12);
BufferToBuffer(BSizeBuf, buf, v_stsc + 12, BSizeSize * 12, 0);
// ×ÈÒÀÅÌ ÌÀÑÑÈÂ Ñ ÄËÈÍÀÌÈ ÊÀÄÐÎÂ
SetLength(SizeBuf, Frames * 4);
BufferToBuffer(SizeBuf, buf, v_stsz + 16, Frames * 4, 0);
// ÔÎÐÌÈÐÓÅÌ ÌÀÑÑÈ ÑÎ ÑÌÅÙÅÍÈßÌÈ ÊÀÄÐÎÂ
SetLength(OffsBuf, Frames * 4);
// ÎÄÍÎ ÑÌÅÙÅÍÈÅ - ÎÄÈÍ ÁËÎÊ ÈÇ BSIZE ÊÀÄÐÎÂ
fr := 0;
bcnt := 0;
for k := 0 to BSizeSize - 1 do
begin
bpos := BufferToDword(BSizeBuf, k * 12);
bsize := BufferToDword(BSizeBuf, 4 + k * 12);
if (k < BSizeSize - 1) then
bnum := BufferToDword(BSizeBuf, (k + 1) * 12) - bpos else
bnum := BOffsSize - bpos + 1;
for j := 0 to bnum - 1 do
begin
Offs := BufferToDword(BOffsBuf, (bpos + j - 1) * 4);
for i := 0 to bsize - 1 do
begin
if (fr < Frames) then
begin
BufferWriteDword(OffsBuf, Offs, fr * 4);
Offs := Offs + BufferToDword(SizeBuf, fr * 4);
end;
fr := fr + 1;
end;
end;
end;
// ÈÇÂËÅÊÀÅÌ ÍÅÎÁÕÎÄÈÌÛÅ ÄÀÍÍÛÅ ÈÇ ÀÓÄÈÎ ÇÀÃÎËÎÂÊÀ
if (ATrak <> '') then
begin
// ×ÈÒÀÅÌ ÌÀÑÑÈ ÑÎ ÑÌÅÙÅÍÈßÌÈ ÁËÎÊÎÂ
// BOffsSize - ×ÈÑËÎ ÁËÎÊÎÂ
BOffsSize := BufferToDword(buf, a_stco + 8);
BOffsBuf := nil;
SetLength(BOffsBuf, BOffsSize * 4);
BufferToBuffer(BOffsBuf, buf, a_stco + 12, BOffsSize * 4, 0);
// STCO BOX
BStscSize := BufferToDword(buf, a_stsc + 8);
BStscBuf := nil;
SetLength(BStscBuf, BStscSize * 12);
BufferToBuffer(BStscBuf, buf, a_stsc + 12, BStscSize * 12, 0);
// ÔÎÐÌÈÐÓÅÌ ÌÀÑÑÈÂ Ñ ÊÎË-ÂÎÌ ÊÀÄÐÎÂ ÏÎ ÁËÎÊÀÌ (ÄËÈÍÀ ÇÀÏÈÑÈ - 12 ÁÀÉÒ)
BSizeBuf := nil;
SetLength(BSizeBuf, BOffsSize * 4);
k := 0;
bnext := 0;
bptr := 0;
bsize := 0;
Repeat
if k >= bnext then
begin
if (bptr + 1 < BStscSize) then
bnext := BufferToDword(BStscBuf, (bptr + 1) * 12) - 1 else
bnext := BOffsSize;
bsize := BufferToDword(BStscBuf, 4 + bptr * 12);
bptr := bptr + 1;
end;
BufferWriteDword(BSizeBuf, bsize, k * 4);
k := k + 1;
until (k >= BOffsSize);
// DEBUG INFO
// for i := 0 to BOffsSize - 1 do
// fMain.Memo.Lines.Add(IntToStr(i) + ' ' + IntToHex(BufferToDword(BOffsBuf, i*4), 8) + ' ' + IntToHex(BufferToDword(BSizeBuf, i*4), 8));
// ×ÈÑËÎ ÊÀÄÐÎÂ
// ÔÎÐÌÈÐÓÅÌ ÌÀÑÑÈÂ Ñ ÐÀÇÌÅÐÀÌÈ ÊÀÄÐÎÂ
if BufferToDword(buf, a_stsz + 8) = 0 then
begin
// ÅÑËÈ ÇÂÓÊ AAC
// ×ÈÑËÎ ÀÓÄÈÎ ÊÀÄÐÎÂ
AFrames := BufferToDword(buf, a_stsz + 12);
// ×ÈÒÀÅÌ ÌÀÑÑÈÂ Ñ ÄËÈÍÀÌÈ ÊÀÄÐÎÂ
SetLength(ASizeBuf, AFrames * 4);
BufferToBuffer(ASizeBuf, buf, a_stsz + 16, AFrames * 4, 0);
// ÔÎÐÌÈÐÓÅÌ ÌÀÑÑÈ ÑÎ ÑÌÅÙÅÍÈßÌÈ ÊÀÄÐÎÂ
SetLength(AOffsBuf, AFrames * 4);
fr := 0;
for k := 0 to BOffsSize - 1 do
begin
bsize := BufferToDword(BSizeBuf, k * 4);
Offs := BufferToDword(BOffsBuf, k * 4);
for i := 0 to bsize - 1 do
begin
if (fr < AFrames) then
begin
BufferWriteDword(AOffsBuf, Offs, fr * 4);
Offs := Offs + BufferToDword(ASizeBuf, fr * 4);
end else
begin
// fMain.Memo.Lines.Add('ERROR ' + IntToStr(fr));
end;
fr := fr + 1;
end;
end;
end else
begin
// ÅÑËÈ ÇÂÓÊ WAV ÈËÈ ULAW
// ×ÈÑËÎ ÀÓÄÈÎ ÊÀÄÐÎÂ
AFrames := BOffsSize;
SampleSize := BufferToDword(buf, a_stsz + 8);
// ×ÈÒÀÅÌ ÌÀÑÑÈÂ Ñ ÄËÈÍÀÌÈ ÊÀÄÐÎÂ
SetLength(ASizeBuf, BOffsSize * 4);
SetLength(AOffsBuf, BOffsSize * 4);
// ÔÎÐÌÈÐÓÅÌ ÌÀÑÑÈÂ Ñ ÄËÈÍÀÌÈ È ÑÌÅÙÅÍÈßÌÈ ÊÀÄÐÎÂ
BufferWriteBuffer(ASizeBuf, BSizeBuf, 0);
BufferWriteBuffer(AOffsBuf, BOffsBuf, 0);
end;
end;
// ÂÛÂÎÄÈÌ ÑÌÅÙÅÍÈß ÊÀÄÐÎÂ (ÄËß ÎÒËÀÄÊÈ)
// for i := 0 to AFrames - 1 do
// fMain.Memo.Lines.Add(IntToStr(i) + ' ' + IntToHex(BufferToDword(AOffsBuf, i*4), 8) + ' ' + IntToHex(BufferToDword(ASizeBuf, i*4), 8));
// FAAD LIBRARY INIT
if (ATrak = 'mp4a') then
begin
// FAAD LIBRARY INIT
FaadHandle := NeAACDecOpen();
// TRACK ES CONFIGURATION
SetLength(FaadDecConfig, 2);
BufferToBuffer(FaadDecConfig, buf, a_esds + $27, 2, 0);
ErrCode := NeAACDecInit2(FaadHandle, FaadDecConfig, Length(FaadDecConfig), @SampleRate, @Channels);
if (ErrCode <> 0) then
begin
err := 'Cannot init libfaad2 dll, ErrorCode ' + IntToStr(ErrCode);
Exit;
end;
// WAVE BUFFER CREATE
SetLength(WavBuf, 8192);
WavPos := 0;
end;
// ÂÛÂÎÄÈÌ ÑÌÅÙÅÍÈß ÄËß ÎÒËÀÄÊÈ
// ÂÈÄÅÎ ÒÐÅÊ
if (debug_level > 0) then
begin
fMain.Memo.Lines.Add('video type: ' + VTrak);
fMain.Memo.Lines.Add('v_trak: ' + IntToHex(header_start + v_trak, 8));
fMain.Memo.Lines.Add('v_pref: ' + IntToHex(BufferToDword(PrefBuf, 0), 8) + ' ' + IntToHex(BufferToDword(PrefBuf, 4), 8) + ' ...');
fMain.Memo.Lines.Add('v_stsc: ' + IntToHex(header_start + v_stsc, 8));
fMain.Memo.Lines.Add('v_stsz: ' + IntToHex(header_start + v_stsz, 8));
fMain.Memo.Lines.Add('v_stco: ' + IntToHex(header_start + v_stco, 8));
fMain.Memo.Lines.Add('frame size: ' + IntToStr(W) + 'x' + IntToStr(H));
fMain.Memo.Lines.Add('video frames: ' + IntToStr(Frames));
fMain.Memo.Lines.Add('FPSA: ' + IntToStr(FPSA) + ' FPSB: ' + IntToStr(FPSB));
fMain.Memo.Lines.Add('FPS: ' + FloatToStrF(FPS, ffFixed, 7, 7));
if (debug_level > 1) then
begin
// ÂÛÂÎÄÈÌ ÑÌÅÙÅÍÈß ÊÀÄÐÎÂ (ÄËß ÎÒËÀÄÊÈ)
for i := 0 to Frames - 1 do
fMain.Memo.Lines.Add(IntToStr(i) + ' ' + IntToHex(BufferToDword(OffsBuf, i*4), 8) + ' ' + IntToHex(BufferToDword(SizeBuf, i*4), 8));
end;
end;
// ÀÓÄÈÎ ÒÐÅÊ
if (ATrak <> '') and (debug_level > 0) then
begin
fMain.Memo.Lines.Add('audio type: ' + ATrak);
fMain.Memo.Lines.Add('audio frames: ' + IntToStr(AFrames));
fMain.Memo.Lines.Add('a_trak: ' + IntToHex(header_start + a_trak, 8));
fMain.Memo.Lines.Add('a_stsc: ' + IntToHex(header_start + a_stsc, 8));
fMain.Memo.Lines.Add('a_stsz: ' + IntToHex(header_start + a_stsz, 8));
fMain.Memo.Lines.Add('a_stco: ' + IntToHex(header_start + a_stco, 8));
if (debug_level > 1) then
begin
// ÂÛÂÎÄÈÌ ÑÌÅÙÅÍÈß ÊÀÄÐÎÂ (ÄËß ÎÒËÀÄÊÈ)
for i := 0 to AFrames - 1 do
fMain.Memo.Lines.Add(IntToStr(i) + ' ' + IntToHex(BufferToDword(AOffsBuf, i*4), 8) + ' ' + IntToHex(BufferToDword(ASizeBuf, i*4), 8));
end;
end;
FramesRead := 0;
AFramesRead := 0;
LastAACFrameDecoded := 0;
LastMP3FrameEncoded := 0;
end;
destructor TMp4File.Destroy;
begin
if (ATrak = 'mp4a') then
begin
// FAAD LIBRARY CLOSE
NeAACDecClose(FaadHandle);
end;
beCloseStream(LameStream);
Close(F);
OffsBuf := nil;
PrefBuf := nil;
SizeBuf := nil;
end;
procedure TMp4File.WriteAACFile(fname: string);
var AF: File;
i, dpos, dsize: integer;
buf, aacpref: TBuffer;
begin
AssignFile(AF, fname);
Rewrite(AF, 1);
SetLength(aacpref, 7);
HexStringToBuffer(aacpref, 'FF F1 4C 80 29 7F 3C', 0);
for i := 0 to AFrames - 1 do
begin
dpos := BufferToDword(AOffsBuf, i*4);
dsize := BufferToDword(ASizeBuf, i*4);
buf := nil;
SetLength(buf, dsize);
Seek(F, dpos);
BlockRead(F, buf[0], dsize);
HexStringToBuffer(aacpref, 'FF F1 4C 80 29 7F 3C', 0);
BufferWriteWord(aacpref, dsize * $20 + $FF, 4);
BlockWrite(AF, aacpref[0], Length(aacpref));
BlockWrite(AF, buf[0], dsize);
end;
CloseFile(AF);
end;
procedure TMp4File.Snapshot;
begin
FramesRead_ := FramesRead;
end;
procedure TMp4File.Revert;
begin
FramesRead := FramesRead_;
end;
function TMp4File.ReadChunk(var Chunk: TChunk):boolean;
var d, dpos, coffs: integer;
R: boolean;
begin
R := false;
Chunk.Flags := $00000000;
Chunk.FB := $00000000;
Chunk.Size := 0;
if (FramesRead < Frames) then
begin
Chunk.Size := BufferToDword(SizeBuf, FramesRead * 4);
SetLength(Chunk.Data, Chunk.Size + 64);
// ×ÈÒÀÅÌ ÊÀÄÐ ÈÇ ÔÀÉËÀ
dpos := BufferToDword(OffsBuf, FramesRead * 4);
coffs := 0;
if (dpos < FSize) then
begin
Seek(F, dpos);
BlockRead(F, Chunk.Data[8], Chunk.Size);
d := BufferToDword(Chunk.Data, 12);
if ((d AND $40000000) = 0) then
begin
Chunk.Flags := $00000010;
// ÏÈØÅÌ 32-ÁÀÉÒÎÂÛÉ ÏÐÅÔÈÊÑ Â ÊÀÆÄÛÉ ÊËÞ×ÅÂÎÉ ÊÀÄÐ ÅÑËÈ ÅÃÎ ÒÀÌ ÅÙÅ ÍÅÒ
if BufferToDword(Chunk.Data, 8) <> $000001B0 then
begin
coffs := Length(PrefBuf);
Chunk.Size := Chunk.Size + coffs;
BufferShiftRight(Chunk.Data, coffs);
BufferWriteBuffer(Chunk.Data, PrefBuf, 8);
end;
end;
Chunk.Pref := '00dc';
Chunk.FB := BufferToDword(Chunk.Data, 8 + coffs);
BufferWriteString(Chunk.Data, Chunk.Pref, 0);
BufferWriteDwordRev(Chunk.Data, Chunk.Size, 4);
// ÄËß ÎÒËÀÄÊÈ
// fMain.Memo.Lines.Add(IntToStr(FramesRead) + ' ' + IntToHex(dpos, 8) + ' ' + IntToHex(BufferToDword(Chunk.Data, 8 + coffs), 8) + ' ' + IntToHex(Chunk.Size ,8));
FramesRead := FramesRead + 1;
R := true;
end;
end;
ReadChunk := R;
end;
function TMp4File.ReadAChunk(var Chunk: TChunk):boolean;
var dpos, dsize: integer;
R: boolean;
begin
R := false;
Chunk.Flags := $00000010;
Chunk.FB := $00000000;
Chunk.Size := 0;
Chunk.Data := nil;
if (AFramesRead < AFrames) then
begin
// ×ÈÒÀÅÌ ÊÀÄÐ ÈÇ ÔÀÉËÀ
dpos := BufferToDword(AOffsBuf, AFramesRead * 4);
dsize := BufferToDword(ASizeBuf, AFramesRead * 4);
Chunk.Size := dsize;
SetLength(Chunk.Data, Chunk.Size + 64);
FillChar(Chunk.Data[0], Length(Chunk.Data), 0);
if (dpos < FSize) then
begin
// ÂÛÐÀÂÍÈÂÀÍÈÅ ÏÎ ÄÂÓÕÁÀÉÒÎÂÎÉ ÃÐÀÍÈÖÅ ÄÅËÀÅÒÑß ÏÐÈ ÇÀÏÈÑÈ
Seek(F, dpos);
BlockRead(F, Chunk.Data[8], dsize);
Chunk.Pref := '01wb';
Chunk.FB := BufferToDword(Chunk.Data, 8);
BufferWriteString(Chunk.Data, Chunk.Pref, 0);
BufferWriteDwordRev(Chunk.Data, Chunk.Size, 4);
AFramesRead := AFramesRead + 1;
R := true;
end;
end;
ReadAChunk := R;
end;
function TMp4File.ReadAACChunk(var Chunk: TChunk; cropFrames: boolean):boolean;
var NewLen, i: integer;
R, Res: boolean;
begin
Res := false;
NewLen := 384;
Chunk.Flags := $00000010;
Chunk.FB := $00000000;
Chunk.Size := 0;
R := ReadAChunk(Chunk);
if (R = true) or (cropFrames = false) then
begin
SetLength(Chunk.Data, NewLen + 8);
if R = false then
begin
Chunk.Pref := '01wb';
Chunk.Size := 9;
BufferWriteString(Chunk.Data, Chunk.Pref, 0);
HexStringToBuffer(Chunk.Data, '21 00 49 90 02 19 00 23 80', 8);
end;
// ÎÑÒÀËÜÍÎÅ ÄÎÏÈÑÛÂÀÅÌ ÍÓËßÌÈ
for i := Chunk.Size to NewLen - 1 do
Chunk.Data[i + 8] := Chr(0);
Chunk.Size := NewLen;
BufferWriteDwordRev(Chunk.Data, Chunk.Size, 4);
Res := true;
end;
ReadAACChunk := Res;
end;
function TMp4File.ReadWavChunk(var Chunk: TChunk; ReadSamples: integer; cropFrames: boolean):boolean;
var AChunk: TChunk;
R, Res: boolean;
FaadFrameInfo: TFaacDecFrameInfo;
OutBufLen, i, j: Integer;
POutBuf: PSampleBuffer;
begin
Chunk.Flags := $00000010;
Chunk.FB := $00000000;
Chunk.Size := 0;
Res := false;
// ÇÀÒÛ×ÊÀ ÄËß ÔÀÉËΠÁÅÇ ÇÂÓÊÀ
if (Channels = 0) then
begin
Channels := 2;
end;
// IF AAC AUDIO TRACK
if (ATrak = 'mp4a') then
begin
// ÈÇÂËÅÊÀÅÌ ÐÀÑÏÀÊÎÂÀÍÍÛÉ ÀÓÄÈÎ ÔÐÀÃÌÅÍÒ ÍÓÆÍÎÉ ÄËÈÍÛ
Repeat
Repeat
// ×ÈÒÀÅÌ AAC AUDIO CHUNK
R := ReadAChunk(AChunk);
// ÎÁÍÓËßÅÌ ÄÀÍÍÛÅ
FaadFrameInfo.samples := 0;
POutBuf := nil;
OutBufLen := 0;;
if (R = true) then
begin
// ÅÑÒÜ AUDIO CHUNK
// ÄÅÊÎÄÈÐÎÂÀÍÈÅ -> OUTBUF
POutBuf := NeAACDecDecode(FaadHandle, @FaadFrameInfo, @AChunk.Data[8], AChunk.Size);
OutBufLen := FaadFrameInfo.samples * FaadFrameInfo.channels;
end
// ÇÄÅÑÜ < 1 ÎÇÍÀ×ÀÅÒ, ×ÒÎ 1 ÐÀÇ ÏÎÄÑÎÂÛÂÀÅÌ ÏÓÑÒÎÉ ÊÀÄÐ Â ÊÎÍÖÅ, Ò.Ê. ÄÅÊÎÄÈÐÎÂÀÍÈÅ ÈÄÅÒ Ñ ÇÀÄÅÐÆÊÎÉ
else if (LastAACFrameDecoded < 1) then
begin
// AUDIO CHUNK'È ÇÀÊÎÍ×ÈËÈÑÜ (ÍÀÄÎ ÂÛÏÎËÍÈÒÜ ÄÅÊÎÄÈÐÎÂÀÍÈÅ ÅÙÅ ÐÀÇ)
// ÏÎÄÑÎÂÛÂÀÅÌ ÏÓÑÒÎÉ ÊÀÄÐ
SetLength(AChunk.Data, 9);
AChunk.Size := 9;
HexStringToBuffer(AChunk.Data, '21 00 49 90 02 19 00 23 80', 0);
POutBuf := NeAACDecDecode(FaadHandle, @FaadFrameInfo, @AChunk.Data[0], AChunk.Size);
OutBufLen := FaadFrameInfo.samples * FaadFrameInfo.channels;
LastAACFrameDecoded := LastAACFrameDecoded + 1;
end;
until (FaadFrameInfo.samples > 0) or (POutBuf = nil);
if (FaadFrameInfo.samples > 0) then
begin
// ÏÈØÅÌ ÄÀÍÍÛÅ Â WAVE BUFFER
for j := 0 to OutBufLen - 1 do
begin
WavBuf[WavPos + j] := POutBuf^[j];
end;
WavPos := WavPos + OutBufLen;
end;
until ((WavPos > 0) and (WavPos >= ReadSamples * Channels * 2)) or (FaadFrameInfo.samples = 0)
end;
if (WavPos > 0) and (ReadSamples = 0) then
begin
// ÅÑËÈ READSAMPLES=0, ÂÎÇÂÐÀÙÀÅÌ ÂÑÅ ×ÒÎ ÅÑÒÜ Â ÁÓÔÅÐÅ
Chunk.Pref := '01wb';
Chunk.Size := WavPos;
SetLength(Chunk.Data, Chunk.Size + 8);
BufferWriteString(Chunk.Data, '01wb', 0);
BufferWriteDwordRev(Chunk.Data, Chunk.Size, 4);
BufferToBuffer(Chunk.Data, WavBuf, 0, Chunk.Size, 8);
WavPos := 0;
Res := true;
end
else if (WavPos > 0) and (WavPos >= ReadSamples * Channels * 2) then
begin
// ÅÑËÈ ÒÐÅÁÓÅÌÎÅ ÊÎË-ÂÎ ÑÅÌÏËÎÂ ÅÑÒÜ Â ÁÓÔÅÐÅ
Chunk.Pref := '01wb';
Chunk.Size := ReadSamples * Channels * 2;
SetLength(Chunk.Data, Chunk.Size + 8);
BufferWriteString(Chunk.Data, '01wb', 0);
BufferWriteDwordRev(Chunk.Data, Chunk.Size, 4);
BufferToBuffer(Chunk.Data, WavBuf, 0, Chunk.Size, 8);
BufferShiftLeft(WavBuf, Chunk.Size, WavPos);
WavPos := WavPos - Chunk.Size;
Res := true;
end
else if (cropFrames = false) then
begin
// ÅÑËÈ Â ÁÓÔÅÐÅ ÌÅÍÜØÅ ÑÅÌÏËÎÂ, ×ÅÌ ÒÐÅÁÓÅÒÑß ÈËÈ ÏÓÑÒÎ
Chunk.Pref := '01wb';
// ÏÎ ÓÌÎË×ÀÍÈÞ ×ÈÒÀÅÌ 1024 ÑÅÌÏËÀ
if (ReadSamples = 0) then ReadSamples := 1024;
Chunk.Size := ReadSamples * Channels * 2;
SetLength(Chunk.Data, Chunk.Size + 8);
BufferWriteString(Chunk.Data, '01wb', 0);
BufferWriteDwordRev(Chunk.Data, Chunk.Size, 4);
// ÅÑËÈ Â ÁÅÔÅÐÅ ÅÑÒÜ ÄÀÍÍÛÅ
if (WavPos > 0) then
BufferToBuffer(Chunk.Data, WavBuf, 0, WavPos, 8);
// ÄÎÁÀÂËßÅÌ ÍÓËÈ
for i := WavPos to Chunk.Size - 1 do Chunk.Data[i + 8] := Chr(0);
WavPos := 0;
Res := true;
end;
// DEBUG
// fMain.Memo.Lines.Add(IntToStr(AFramesRead) + ':' + IntToStr(Chunk.Size));
ReadWavChunk := Res;
end;
function TMp4File.ReadMp3Chunk(var Chunk: TChunk; cropFrames: boolean):boolean;
var ErrCode: integer;
LameSamples, LameBufferSize: DWORD;
Mp3BytesEncoded: DWORD;
WavChunk: TChunk;
R, Res: boolean;
begin
Chunk.Flags := $00000010;
Chunk.FB := $00000000;
Chunk.Size := 0;
Chunk.Data := nil;
Res := false;
if (AFramesRead = 0) and (LameInitialized = false) then
begin
// LAME_ENC LIBRARY INIT
LameConfig.Format.MP3.dwSampleRate := 48000;
if (Channels = 1) then
begin
// MONO
LameConfig.Format.MP3.byMode := BE_MP3_MODE_MONO;
end else
begin
// STEREO - DEFAULT
LameConfig.Format.MP3.byMode := BE_MP3_MODE_JSTEREO;
end;
// ÇÄÅÑÜ ÒÎÆÅ Ó×ÈÒÂÀÞÒÑß ÈÇÌÅÍÅÍÈß cbAudioFormat (avih)
case fMain.cbAudioFormat.ItemIndex of
2: LameConfig.Format.MP3.wBitrate := 256;
3: LameConfig.Format.MP3.wBitrate := 128;
4: LameConfig.Format.MP3.wBitrate := 64;
end;
// ÈÍÈÖÈÀËÈÇÈÐÓÅÌ STREAM (ÎÄÈÍ STREAM ÄËß ÂÑÅÕ ÑØÈÂÀÅÌÛÕ MP4)
ErrCode := beInitStream(LameConfig, LameSamples, LameBufferSize, LameStream);
LameInitialized := true;
// ÄÅÊÎÄÈÐÓÅÌ ÏÅÐÂÛÉ CHUNK (×ÒÎÁÛ Ó×ÅÑÒÜ ÇÀÄÅÐÆÊÓ Â 1 ÊÀÄÐ)
ReadWavChunk(WavChunk, 1152, false);
beEncodeChunk(LameStream, 1152 * Channels, @WavChunk.Data[8], @Chunk.Data[8], Mp3BytesEncoded);
end;
// ÄÅÊÎÄÈÐÓÅÌ Î×ÅÐÅÄÍÎÉ ÊÀÄÐ
R := ReadWavChunk(WavChunk, 1152, cropFrames);
// ÏÎÄÑÎÂÛÂÀÅÌ ÏÓÑÒÎÉ ÊÀÄÐ Â ÊÎÍÖÅ, Ò.Ê. LAME ÊÎÄÈÐÓÅÒ Ñ ÇÀÄÅÐÆÊÎÉ
if (R = false) and (LastMp3FrameEncoded < 1) then
begin
R := ReadWavChunk(WavChunk, 1152, false);
LastMp3FrameEncoded := LastMp3FrameEncoded + 1;
end;
if (R = true) then
begin
SetLength(Chunk.Data, 2048);
ErrCode := beEncodeChunk(LameStream, 1152 * Channels, @WavChunk.Data[8], @Chunk.Data[8], Mp3BytesEncoded);
if (Mp3BytesEncoded > 0) then
begin
Chunk.Size := Mp3BytesEncoded;
Chunk.Pref := '01wb';
BufferWriteString(Chunk.Data, '01wb', 0);
BufferWriteDwordRev(Chunk.Data, Chunk.Size, 4);
// DEBUG
// fMain.Memo.Lines.Add(IntToStr(AFrames) + ' ' + IntToStr(AFramesRead) + ' ' + IntToStr(Mp3BytesEncoded));
Res := true;
end;
end;
ReadMp3Chunk := Res;
end;
function TMp4File.LookForGoodInterval(ChunkPrev: TChunk; minTime:integer): integer;
var Chunk: TChunk;
R, KeyFrame, GoodFrame, OneMore: boolean;
GoodFrames, minFrames: Integer;
begin
minFrames := Round(minTime / 1000 * FPS);
// ÇÀÏÎÌÈÍÀÅÌ ÒÅÊÓÙÈÅ ÏÅÐÅÌÅÍÍÛÅ AVIFile
SnapShot;
// ÑÒÀÐÒÎÂÀß ÏÎÇÈÖÈß ÄËß ÄÀËÜÍÅÉØÅÃÎ ÏÎÈÑÊÀ
Repeat
// ÏÐÎËÈÑÒÛÂÀÅÌ ÏËÎÕÈÅ ÊÀÄÐÛ
GoodFrames := 0;
OneMore := false;
Repeat
R := ReadChunk(Chunk);
GoodFrame := false;
if (R = true) then
begin
GoodFrame := true;
if SameChunkData(Chunk, ChunkPrev) then GoodFrame := false;
if (Chunk.FB <> $000001B6) then
begin
GoodFrame := false;
OneMore := true;
end;
end;
ChunkPrev := Chunk;
until (R = false) or (GoodFrame);
// ÏÐÎËÈÑÒÛÂÀÅÌ ÅÙÅ ÎÄÈÍ ÊÀÄÐ (ÅÑËÈ ÁÛËÎ ÏÐÎÑÒÎ ÎÄÈÍÀÊÎÂÛÅ ÊÀÄÐÛ, ÏÐÎËÈÑÒÛÂÀÒÜ ÍÅ ÍÀÄÎ)
if (R = true) and (OneMore) then
R := ReadChunk(ChunkPrev);
// ÅÑËÈ ÍÅ ÊÎÍÅÖ ÔÀÉËÀ
if (R = true) then
begin
// ×ÈÒÀÅÌ ÄÎ ÏÅÐÂÎÃÎ ÊËÞ×ÅÂÎÃÎ ÊÀÄÐÀ
// KeyFrame := false;
// Repeat
// R := ReadChunk(Chunk);
// if (R = true) and ((Chunk.Pref = '00dc') or (Chunk.Pref = '00db')) then
// begin
// if (Chunk.Flags AND $00000010) = $00000010 then KeyFrame := true;
// end;
// until (R = false) or (KeyFrame);
KeyFrame := true;
if (KeyFrame) then
begin
// ÎÏÐÅÄÅËßÅÌ ÄËÈÍÓ ÕÎÐÎØÅÃÎ ÔÐÀÃÌÅÍÒÀ
Repeat
R := ReadChunk(Chunk);
GoodFrame := false;
if (R = true) then
begin
GoodFrame := true;
if SameChunkData(Chunk, ChunkPrev) then GoodFrame := false;
if (Chunk.FB <> $000001B6) then GoodFrame := false;
end;
if (GoodFrame) then GoodFrames := GoodFrames + 1;
ChunkPrev := Chunk;
until (R = false) or (GoodFrame = false);
end;
end;
until (GoodFrames >= minFrames) or (R = false);
if (GoodFrames >= minFrames) then
LookForGoodInterval := FramesRead - GoodFrames - 2 else
LookForGoodInterval := FramesRead;
// ÂÎÑÑÒÀÍÀÂËÈÂÀÅÌ ÏÅÐÅÌÅÍÍÛÅ AVIFile
Revert;
end;
{ FORM }
procedure TfMain.FormShow(Sender: TObject);
begin
// FORCE FORM RESIZE
fMain.FormResize(Application);
// FORM SIZE CONSTRAINS
pAction.Constraints.MinHeight := rgFrozen.Top + rgFrozen.Height + 7;
// ÊÀÒÀËÎÃ ÏÐÎÃÐÀÌÌÛ
exePath := Copy(CmdLine, pos('\', CmdLine) - 2, LastDelimiter('\', CmdLine) - pos('\', CmdLine) + 3);
// SAVEFILENAME
SaveFileName := '';
// ×ÈÒÀÅÌ INI ÔÀÉË
ReadINI();
fMain.cbActionChange(Application);
end;
procedure ManyMp4ToAvi(FileList: TStringList; OutFileName, TargetDir: string; cropFrames: boolean);
var Mp4Name, FileName, OutName, AviName, WavName, Mp3Name, exeStr, StatAdd, err, HeaderFile: string;
InFile: TMp4FIle;
OutFile: TAVIFile;
Chunk, ChunkPrev: TChunk;
AVIState: TAVIState;
ChunkA: array[0..7] of TChunk;
p, i, j, aChunk, AudioSize, AudioDelta, FramesCropped, FramesDone, FramesDup, FramesWas : integer;
AudioRefSize, newTime: real;
R, SkippingFrames, FileOK: boolean;
FramesArray: array of integer;
NextStartFrame, GoodFrames, BadFrames, FragmentsSaved, TotalFrames, CurrentFrames: integer;
Channels, SampleRate, BytesPerSec: integer;
begin
// ÏÀÐÀÌÅÒÐÛ LAME_ENC.DLL ÎÁÙÈÅ ÄËß ÂÑÅÕ ÑØÈÂÀÅÌÛÕ MP4 (ÎÄÈÍ STREAM)
LameInitialized := false;
// ÈÍÈÖÈÀËÈÇÈÐÓÅÌ ÏÅÐÅÌÅÍÍÛÅ
AudioRefSize := 0;
AudioSize := 0;
// ÏÅÐÅÌÅÍÍÛÅ ÒÀÉÌÅÐÀ
TotalFrames := 0;
FramesCropped := 0;
FramesDone := 0;
FramesDup := 0;
// ×ÈÒÀÅÌ ÇÀÃÎËÎÂÊÈ ÂÕÎÄÍÛÕ ÔÀÉËÎÂ, Ñ×ÈÒÀÅÌ ÊÎËÈ×ÅÑÒÂÎ ÊÀÄÐÎÂ
fMain.lGaugeCurrent.Caption := 'reading .mp4 headers...';
fMain.GaugeCurrent.Progress := 0;
SetLength(FramesArray, FileList.Count);
// FILE PARAMETERS
Channels := 0;
SampleRate := 0;
BytesPerSec := 0;
for i := 0 to FileList.Count - 1 do
begin
Mp4Name := FileList[i];
InFile := TMp4File.Create(Mp4Name, err);
FramesArray[i] := InFile.Frames;
if (err = '') then
begin
if (InFile.SampleRate > SampleRate) then
SampleRate := InFile.SampleRate;
if (InFile.Channels > Channels) then
Channels := InFile.Channels;
TotalFrames := TotalFrames + FramesArray[i];
fMain.GaugeCurrent.Progress := Round((i + 1)/FileList.Count*100);
end else
begin
// ERROR
p := LastDelimiter('\', Mp4Name);
FileName := Copy(Mp4Name, p + 1, Length(Mp4Name) - p + 1);
fMain.Memo.Lines.Add(FileName + ': ERROR');
fMain.Memo.Lines.Add(' CAN''T READ HEADER');
end;
end;
// OUTFILE CREATE
StatAdd := '';
FramesWas := 0;
OutFile := nil;
// OUTFILENAME = '' ÊÎÃÄÀ MANY MP4 -> MANY AVI
if (OutFileName <> '') then
begin
OutFile := TAVIFile.Create(OutFileName, true);
// SET AUDIO FORMAT
OutFile.SetAudioFormat(fMain.cbAudioFormat.ItemIndex, HeaderFile);
OutFile.ReadHeaderFromFile(exePath + HeaderFile);
OutFile.WriteHeader;
end;
// ÑÊËÅÈÂÀÅÌ ÔÀÉËÛ
for i := 0 to FileList.Count - 1 do if FramesArray[i] > 0 then
begin
CurrentFrames := FramesArray[i];
Mp4Name := FileList[i];
p := LastDelimiter('\', Mp4Name);
FileName := Copy(Mp4Name, p + 1, Length(Mp4Name) - p + 1);
// INFILE CREATE
InFile := TMP4File.Create(MP4Name, err);
fMain.Memo.Lines.Add(FileName + ' (' + IntToStr(InFile.Frames) + ' frames)');
// InFile.WriteAACFile(Mp4Name + '.aac');
// OUTFILE CREATE (ÅÑËÈ MANY MP4 -> MANY AVI)
if (OutFileName = '') then
begin
OutName := TargetDir + '\' + Copy(FileName, 1, Length(FileName) - 4) + '.avi';
OutFile := TAVIFile.Create(OutName, true);
// SET AUDIO FORMAT & HEADER FILE
OutFile.SetAudioFormat(fMain.cbAudioFormat.ItemIndex, HeaderFile);
OutFile.ReadHeaderFromFile(exePath + HeaderFile);
OutFile.WriteHeader;
end;
// OUTFILE PARAM
if (i = 0) or (OutFileName = '') then
begin
OutFile.W := InFile.W;
OutFile.H := InFile.H;
case fMain.cbFrameSize.ItemIndex of
1: begin
OutFile.W := 640;
OutFile.H := 480;
end;
2: begin
OutFile.W := 320;
OutFile.H := 240;
end;
end;
OutFile.FPSA := InFile.FPSA;
OutFile.FPSB := InFile.FPSB;
OutFile.FPS := InFile.FPS;
end;
// STATS
if (FramesWas > 0) then StatAdd := ', appended ' + TimeToStr(Round((TotalFrames - FramesCropped - FramesDup) * 1000 / OutFile.FPS));
fMain.lStats0.Caption := FileName + ', ' + IntToStr(i + 1) + ' of ' + IntToStr(FileList.Count) + ', ' + IntPrint(CurrentFrames) + ' frames, ' + TimeToStr(Round(CurrentFrames * 1000 / OutFile.FPS));
fMain.lStats1.Caption := 'total duration: ' + TimeToStr(Round((FramesWas + TotalFRames - FramesCropped - FramesDup) * 1000 / OutFile.FPS)) + StatAdd;
fMain.lGaugeCurrent.Caption := FileName + ': converting mp4 -> avi...';
fMain.GaugeCurrent.Progress := 0;
ChunkPrev.Size := 0;
SkippingFrames := false;
NextStartFrame := 0;
FragmentsSaved := 1;
GoodFrames := 0;
BadFrames := 0;
FileOK := true;
// SAVING STATE
OutFile.SaveState(AVIState);
while InFile.ReadChunk(Chunk) do
if (Chunk.Pref = '00dc') or (Chunk.Pref = '00db') then
begin
// START SKIPPING FRAMES (DUPLICATES FOUND)
if (SkippingFrames = false) and ((Chunk.FB AND $FFFFFFF0 <> $000001B0) or (SameChunkData(Chunk, ChunkPrev))) then
begin
SkippingFrames := true;
case fMain.rgFrozen.ItemIndex of
0: begin
SkippingFrames := false;
if (FileOK = true) then
begin
fMain.Memo.Lines.Add(' frozen frames found:');
fMain.Memo.Lines.Add(' -> ignoring');
end;
end;
1: begin
fMain.Memo.Lines.Add(' frozen frames found:');
fMain.Memo.Lines.Add(' -> skipping');
OutFile.TakeState(AVIState);
end;
2: begin
fMain.Memo.Lines.Add(' frozen frames found:');
fMain.Memo.Lines.Add(' -> truncating from ' + IntToStr(InFile.FramesRead));
end;
3: begin
fMain.Memo.Lines.Add(' frozen frames found:');
NextStartFrame := InFile.LookForGoodInterval(Chunk, StrToInt(fMain.eMinGoodTime.Text));
fMain.Memo.Lines.Add(' -> cutting from ' + IntToStr(InFile.FramesRead - 1) + ' to ' + IntToStr(NextStartFrame));
end;
end;
FileOK := false;
end;
// DUPLICATE FRAMES FOUND
if (SkippingFrames) and (InFile.FramesRead > NextStartFrame) and (NextStartFrame > 0) then
begin
SkippingFrames := false;
FragmentsSaved := FragmentsSaved + 1;
end;
if (SkippingFrames = false) then
GoodFrames := GoodFrames + 1 else
BadFrames := BadFrames + 1;
AudioRefSize := AudioRefSize + OutFile.FrameAudioSize;
// ×ÈÒÀÅÌ ÀÓÄÈÎ ×ÒÎÁÛ ÏÎÊÐÛÒÜ ÏÐÎ×ÈÒÀÍÍÛÉ ÊÀÄÐ
aChunk := 0;
Repeat
if fMain.cbAudioFormat.ItemIndex = 0 then
R := InFile.ReadAACChunk(ChunkA[aChunk], cropFrames)
else if fMain.cbAudioFormat.ItemIndex = 1 then
R := InFile.ReadWavChunk(ChunkA[aChunk], 0, cropFrames)
else
R := InFile.ReadMp3Chunk(ChunkA[aChunk], cropFrames);
if (R = true) then
begin
AudioSize := AudioSize + ChunkA[aChunk].Size;
aChunk := aChunk + 1;
end;
until (AudioSize >= AudioRefSize) or (R = false);
// ÏÈØÅÌ ÀÓÄÈÎ È ÂÈÄÅÎ Â ÔÀÉË
if (AudioSize >= AudioRefSize) and (SkippingFrames = false) then
begin
for j := 0 to aChunk - 1 do OutFile.WriteChunk(ChunkA[j]);
OutFile.WriteChunk(Chunk);
// GAUGE CURRENT
p := Round(InFile.FramesRead / CurrentFrames * 100);
if (p <> fMain.GaugeCurrent.Progress) then
fMain.GaugeCurrent.Progress := p;
end else
begin
if (SkippingFrames = false) then
FramesCropped := FramesCropped + 1 else
FramesDup := FramesDup + 1;
for j := 0 to aChunk - 1 do AudioSize := AudioSize - ChunkA[j].Size;
AudioRefSize := AudioRefSize - OutFile.FrameAudioSize;
end;
FramesDone := FramesDone + 1;
ChunkPrev := Chunk;
// GAUGE TOTAL
p := Round(FramesDone / (TotalFrames - BadFrames) * 100);
if (p <> fMain.GaugeTotal.Progress) then
fMain.GaugeTotal.Progress := p;
end;
// FRAGMENTS SAVED
if (BadFrames > 0) and (fMain.rgFrozen.ItemIndex > 1) then
fMain.Memo.Lines.Add(' -> saved ' + IntToStr(FragmentsSaved) + ' fragment(s), ' + IntToStr(Round(GoodFrames / InFile.Frames * 100)) + '%');
// STATS
if (FramesWas > 0) then StatAdd := ', appended ' + TimeToStr(Round((TotalFrames - FramesCropped) * 1000 / OutFile.FPS));
fMain.lStats1.Caption := 'total duration: ' + TimeToStr(Round((FramesWas + TotalFRames - FramesCropped - FramesDup) * 1000 / OutFile.FPS)) + StatAdd;
fMain.lStats2.Caption := 'total frames: ' + IntPrint(FramesWas + TotalFRames - FramesCropped - FramesDup) + ', cropped: ' + IntPrint(FramesCropped) + ', frozen: ' + IntPrint(FramesDup);
fMain.lStats3.Caption := 'audio chunks: ' + IntPrint(OutFile.Chunks) + ', àudio size: ' + IntPrint(OutFile.AudioSize);
// DESTROY FILES
InFile.Destroy;
// OUTFILE DESTROY (ÅÑËÈ MANY MP4 -> MANY AVI)
if (OutFileName = '') then
begin
// ÏÈØÅÌ IDX1
OutFile.WriteIdx1Data;
// ÏÈØÅÌ ÇÀÃÎËÎÂÎÊ ÂÛÕÎÄÍÎÃÎ ÔÀÉËÀ
OutFile.WriteHeader;
OutFile.Destroy;
end;
end;
if (OutFileName <> '') then
begin
// ÏÈØÅÌ IDX1
OutFile.WriteIdx1Data;
// ÏÈØÅÌ ÇÀÃÎËÎÂÎÊ ÂÛÕÎÄÍÎÃÎ ÔÀÉËÀ
OutFile.WriteHeader;
OutFile.Destroy;
end;
fMain.lGaugeCurrent.Caption := 'current operation:';
fMain.GaugeCurrent.Progress := 0;
fMain.GaugeTotal.Progress := 0;
// ÇÀÊÐÛÂÀÅÌ LAME STREAM ÅÑËÈ ÍÀÄÎ
if LameInitialized then beCloseStream(LameStream);
end;
procedure ManyAviChangeFourCC(FileList: TStringList);
var i, p: integer;
begin
fMain.lGaugeCurrent.Caption := 'changing .avi FourCC...';
fMain.GaugeCurrent.Progress := 0;
for i := 0 to FileList.Count - 1 do
begin
AviFileChangeFourCC(FileList[i], fMain.cbFcc.Text);
p := Round((i + 1) / FileList.Count * 100);
fMain.GaugeCurrent.Progress := p;
fMain.GaugeTotal.Progress := p;
end;
fMain.GaugeCurrent.Progress := 0;
fMain.GaugeTotal.Progress := 0;
end;
procedure TStartThread.Execute;
var FileList: TStringList;
TargetDir, dir: string;
i: integer;
OutFileName, ErrMsg: string;
begin
fMain.bStart.Enabled := false;
// SOURCE DIR
dir := fMain.DirListBox.Directory;
if (Length(dir) > 3) then dir := dir + '\';
// FILELIST
FileList := TStringList.Create;
for i := 0 to fMain.FileListBox.Count - 1 do
if fMain.FileListBox.Selected[i] then
FileList.Add(fMain.FileListBox.Items[i]);
OutFileName := trim(fMain.eOutFile.Text);
// ÏÐÎÂÅÐßÅÌ ÎØÈÁÊÈ
ErrMsg := '';
if (OutFileName = '') then ErrMsg := 'Target file not specified. ';
if (ErrMsg = '') then
begin
Case fMain.cbAction.ItemIndex of
0: ManyMp4ToAvi(FileList, fMain.eOutFile.Text, '', fMain.cbCropFrames.Checked);
1: begin
TargetDir := fMain.eOutFile.Text;
if (TargetDir[Length(TargetDir)] = '\') then TargetDir := Copy(TargetDir, 1, Length(TargetDir) - 1);
ManyMp4ToAvi(FileList, '', TargetDir, fMain.cbCropFrames.Checked);
end;
2: ManyAviChangeFourCC(FileList);
3: ManyMp4ToAvi(FileList, fMain.eOutFile.Text, '', fMain.cbCropFrames.Checked);
end;
end;
fMain.bStart.Enabled := true;
fMain.Memo.Lines.Add('COMPLETE');
end;
procedure TfMain.bStartClick(Sender: TObject);
var StartThread: TStartThread;
begin
// MESSAGE IF OUTFILE EXISTS
if ((cbAction.ItemIndex = 0) or (cbAction.ItemIndex = 3)) and (FileExists(eOutFile.Text) = true) then
case MessageDlg('File ' + eOutFile.Text + ' already exists. Do you want to owerwrite?' , mtConfirmation, mbOKCancel, 0) of
mrOK: DeleteFile(eOutFile.Text);
mrCancel: Exit;
end;
// ÇÀÏÎËÍßÅÌ FILE LIST ÑÏÈÑÊÎÌ ÔÀÉËΠÅÑËÈ ÎÍ ÏÓÑÒ
if FileListBox.SelCount = 0 then
begin
// ÂÛÄÅËßÅÌ ÂÑÅ ÅÑËÈ ÍÈ×ÅÃÎ ÍÅ ÂÛÄÅËÅÍÎ
FileListBox.SelectAll;
end;
Memo.Lines.Clear;
// ÇÀÏÓÑÊÀÅÌ ÍÈÒÜ
StartThread := TStartThread.Create(true);
StartThread.Priority := tpIdle;
StartThread.Resume;
end;
procedure TfMain.DirListBoxChange(Sender: TObject);
var dir, dirsl: string;
begin
dir := DirListBox.Directory;
dirsl := dir;
if (Length(dir) > 3) then dirsl := dirsl + '\';
case cbAction.ItemIndex of
0: begin
case cbTargetName.ItemIndex of
1: eOutFile.Text := dir + '.avi';
2: eOutFile.Text := dirsl + 'VideoOut.avi';
end;
lOutFile.Caption := 'target file:';
end;
1: begin
if cbTargetName.ItemIndex > 0 then
eOutFile.Text := dir;
lOutFile.Caption := 'target directory:';
end;
2: begin
case cbTargetName.ItemIndex of
1: eOutFile.Text := dir + '.avi';
2: eOutFile.Text := dirsl + 'VideoOut.avi';
end;
lOutFile.Caption := 'target file:';
end;
4: begin
case cbTargetName.ItemIndex of
1: eOutFile.Text := dir + '.avi';
2: eOutFile.Text := dirsl + 'VideoOut.avi';
end;
lOutFile.Caption := 'target file:';
end;
end;
end;
procedure TfMain.bOpenTargetClick(Sender: TObject);
var FName: string;
p: integer;
begin
SaveDialog.Filter := 'AVI Files|*.AVI';
SaveDialog.InitialDir := DirListBox.Directory;
SaveDialog.FileName := 'VideoOut.avi';
if (SaveDialog.Execute) then
begin
FName := SaveDialog.FileName;
if (cbAction.ItemIndex = 1) then
begin
p := LastDelimiter('\', FName);
FName := Copy(FName, 1, p - 1);
end;
eOutFile.Text := FName;
end;
end;
procedure TfMain.bSelectAllClick(Sender: TObject);
begin
FileListBox.SelectAll;
end;
procedure TfMain.cbActionChange(Sender: TObject);
begin
case cbAction.ItemIndex of
0: begin
FileListBox.Mask := '*.mp4;';
cbCropFrames.Enabled := true;
cbFrameSize.Enabled := true;
lFrameSize.Enabled := true;
cbAudioFormat.Enabled := true;
lAudioFormat.Enabled := true;
lOutFile.Enabled := true;
eOutFile.Enabled := true;
lTargetName.Enabled := true;
cbTargetName.Enabled := true;
bOpenTarget.Enabled := true;
rgFrozen.Enabled := true;
eMinGoodTime.Enabled := true;
end;
1: begin
FileListBox.Mask := '*.mp4';
cbCropFrames.Enabled := true;
cbFrameSize.Enabled := true;
lFrameSize.Enabled := true;
cbAudioFormat.Enabled := true;
lAudioFormat.Enabled := true;
lOutFile.Enabled := true;
eOutFile.Enabled := true;
lTargetName.Enabled := true;
cbTargetName.Enabled := true;
bOpenTarget.Enabled := true;
rgFrozen.Enabled := true;
eMinGoodTime.Enabled := true;
end;
2: begin
FileListBox.Mask := '*.avi';
cbCropFrames.Enabled := false;
cbFrameSize.Enabled := false;
lFrameSize.Enabled := false;
cbAudioFormat.Enabled := false;
lAudioFormat.Enabled := false;
lOutFile.Enabled := false;
eOutFile.Enabled := false;
lTargetName.Enabled := false;
cbTargetName.Enabled := false;
bOpenTarget.Enabled := false;
rgFrozen.Enabled := false;
eMinGoodTime.Enabled := false;
end;
3: begin
FileListBox.Mask := '*.mov';
cbCropFrames.Enabled := true;
cbFrameSize.Enabled := true;
lFrameSize.Enabled := true;
cbAudioFormat.Enabled := false;
lAudioFormat.Enabled := false;
lOutFile.Enabled := true;
eOutFile.Enabled := true;
lTargetName.Enabled := true;
cbTargetName.Enabled := true;
bOpenTarget.Enabled := true;
rgFrozen.Enabled := true;
eMinGoodTime.Enabled := true;
end;
end;
fMain.DirListBoxChange(Application);
end;
procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// ÏÈØÅÌ INI ÔÀÉË
WriteINI();
end;
procedure TfMain.FileListBoxDblClick(Sender: TObject);
var cmd, dir, FileName, ext: string;
begin
dir := DirListBox.Directory;
if (Length(dir) > 3) then dir := dir + '\';
FileName := dir + FileListBox.Items.Strings[FileListBox.ItemIndex];
ext := Copy(FileName, Length(FileName) - 2, 3);
cmd := '';
if (ext = 'MP4') or (ext = 'mp4') then
cmd := fSettings.eMP4Player.Text;
if (ext = 'AVI') or (ext = 'avi') then
cmd := fSettings.eAVIPlayer.Text;
if (cmd = '') then
begin
cmd := FileName;
FileName := '';
end;
ShellExecute(Handle, 'open', PChar(cmd), PChar(FileName), nil, SW_SHOWNORMAL);
end;
procedure TfMain.cbTargetNameChange(Sender: TObject);
begin
if cbTargetName.ItemIndex > 0 then
cbActionChange(Application);
end;
procedure TfMain.SpeedButton5Click(Sender: TObject);
var i: integer;
FileList: TStringList;
dir: string;
begin
FileList := TStringList.Create;
dir := fMain.DirListBox.Directory;
if (Length(dir) > 3) then dir := dir + '\';
// ÅÑËÈ FILE LIST ÏÓÑÒ, ÏÅÐÅÌÅÙÀÅÌ ÂÑÅ ÈÇ FILELISTBOX
if fMain.FileListBox.SelCount = 0 then
FileListBox.SelectAll;
for i := 0 to fMain.FilelistBox.Count - 1 do
if fMain.FileListBox.Selected[i] then
FileList.Add(fMain.FileListBox.Items[i]);
PlayListSave(FileList, exePath + 'playlist.asx');
// ÎÒÊÐÛÂÀÅÌ PLAYLIST
PlayListOpen(exePath + 'playlist.asx');
end;
procedure TfMain.bBrowseAVIPlayerClick(Sender: TObject);
begin
OpenDialog.Filter := 'EXE Files|*.EXE';
OpenDialog.InitialDir := 'C:\';
if (OpenDialog.Execute) then
begin
fSettings.eAVIPlayer.Text := OpenDialog.FileName;
end;
end;
procedure TfMain.bBrowseMP4PlayerClick(Sender: TObject);
begin
OpenDialog.Filter := 'EXE Files|*.EXE';
OpenDialog.InitialDir := 'C:\';
if (OpenDialog.Execute) then
begin
fSettings.eMP4Player.Text := OpenDialog.FileName;
end;
end;
procedure TfMain.bBrowseASXPlayerClick(Sender: TObject);
begin
OpenDialog.Filter := 'EXE Files|*.EXE';
OpenDialog.InitialDir := 'C:\';
if (OpenDialog.Execute) then
begin
fSettings.eASXPlayer.Text := OpenDialog.FileName;
end;
end;
procedure TfMain.About1Click(Sender: TObject);
begin
fAbout.Show;
end;
procedure TfMain.FormResize(Sender: TObject);
begin
bPreview.Width := pToolBar.Width - 16;
end;
procedure TfMain.bPreviewClick(Sender: TObject);
var i: integer;
FileList: TStringList;
dir: string;
begin
FileList := TStringList.Create;
dir := fMain.DirListBox.Directory;
if (Length(dir) > 3) then dir := dir + '\';
// ÅÑËÈ FILE LIST ÏÓÑÒ, ÏÅÐÅÌÅÙÀÅÌ ÂÑÅ ÈÇ FILELISTBOX
if fMain.FileListBox.SelCount = 0 then
FileListBox.SelectAll;
for i := 0 to fMain.FilelistBox.Count - 1 do
if fMain.FileListBox.Selected[i] then
FileList.Add(dir + fMain.FileListBox.Items[i]);
PlayListSave(FileList, exePath + 'playlist.asx');
// ÎÒÊÐÛÂÀÅÌ PLAYLIST
PlayListOpen(exePath + 'playlist.asx');
end;
procedure TfMain.AboutMP4Cam2AVI1Click(Sender: TObject);
begin
fAbout.Show;
end;
procedure TfMain.Homepage1Click(Sender: TObject);
begin
fGPL.Show;
end;
procedure TfMain.Changelog1Click(Sender: TObject);
begin
fChangeLog.Show;
end;
procedure TfMain.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TfMain.Releasenotes1Click(Sender: TObject);
begin
fReleaseNotes.Show;
end;
procedure TfMain.Saveconversionlog1Click(Sender: TObject);
begin
SaveDialog.Filter := 'Text files (*.txt)|*.TXT';
SaveDialog.FileName := 'log.txt';
if SaveDialog.Execute then
begin
Memo.Lines.SaveToFile(SaveDialog.FileName);
end;
end;
procedure TfMain.FileListBoxClick(Sender: TObject);
var FileName, dir, fmt, ext, err: string;
InFile: TMp4File;
AviFile: TAviFile;
begin
FileName := FileListBox.Items[FileListBox.ItemIndex];
dir := DirListBox.Directory;
if (Length(dir) > 3) then dir := dir + '\';
ext := LowerCase(Copy(FileName, Length(FileName) - 2, 3));
if (ext = 'mp4') or (ext = 'mov') then
begin
InFile := TMp4File.Create(dir + FileName, err);
if (err = '') then
begin
// MP4 FILE
lInfo0.Caption := 'Length: ' + TimeToStr(Round(1000 * InFile.Frames / InFile.FPS)) + ', ' + IntToStr(InFile.Frames) + ' frames';
fmt := InFile.Vtrak;
if (fmt = 'mp4v') then fmt := 'MPEG-4';
lInfo1.Caption := 'Video: ' + fmt + ', ' + IntToStr(InFile.W) + 'x' + IntToStr(InFile.H);
lInfo2.Caption := 'FPS: ' + IntToStr(InFile.FPSA) + ' / ' + IntToStr(InFile.FPSB) + ' = ' + FloatToStrF(InFile.FPS, ffFixed, 7, 2);
fmt := InFile.Atrak;
if (fmt = 'mp4a') then fmt := 'AAC LC' + IntToStr(InFile.SampleRate) + ' ' + IntToStr(InFIle.Channels) + ' Ch';
if (fmt = '') then fmt := 'no/unknown audio';
lInfo3.Caption := 'Audio: ' + fmt;
end;
InFile.Destroy;
end;
if (ext = 'avi') then
begin
AviFile := TAviFile.Create(dir + FileName, false);
AviFile.ReadHeader;
if (err = '') then
begin
// AVI FILE
lInfo0.Caption := 'Length: ' + TimeToStr(Round(1000 * AviFile.Frames / AviFile.FPS)) + ', ' + IntToStr(AviFile.Frames) + ' frames';
lInfo1.Caption := 'FourCC: ' + AviFile.FourCC + ', ' + IntToStr(AviFile.W) + 'x' + IntToStr(AviFile.H);
lInfo2.Caption := 'FPS: ' + IntToStr(AviFile.FPSA) + ' / ' + IntToStr(AviFile.FPSB) + ' = ' + FloatToStrF(AviFile.FPS, ffFixed, 7, 2);
lInfo3.Caption := 'Audio: ' + AviFile.AudioType;
end;
AviFile.Destroy;
end;
// ÎØÈÁÊÀ
if (err <> '') then
begin
lInfo0.Caption := FileName;
lInfo1.Caption := '-';
lInfo2.Caption := 'ERROR:';
lInfo3.Caption := err;
end;
end;
procedure TfMain.Manual1Click(Sender: TObject);
begin
ShellExecute(handle, 'open', PChar(exePath + 'ReadMe.txt'), nil, nil, SW_SHOWNORMAL);
end;
procedure TfMain.Settings1Click(Sender: TObject);
begin
fSettings.Show;
end;
end.