4aiman/nlve
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Сборка потоком: куски идут сразу в готовый файл, без кэша

Browse source 
Раньше каждый кусок монтажа вырезался в отдельный файл, и только потом
список этих файлов шёл на склейку. Кэш весил столько же, сколько готовый
фильм — замерено 110 ГБ на часе материала, — а диск писал всё дважды.

Теперь каждый кусок режется своим ffmpeg прямо в MPEG-TS на стандартный
вывод, все потоки подряд переливаются в один принимающий ffmpeg, а тот
пишет готовый файл. Место куску задаёт -output_ts_offset, считаемый в
кадрах от начала. На диск ложится только результат и звуковая дорожка.

Через кэш по-прежнему собирается то, что потоком не выходит: кодек, не
переносимый в MPEG-TS, и пересборка всего ролика под площадку.

Сверено на четырёх монтажах, включая настоящий материал с дрона
(HEVC 2688x1512, 55 Мбит/с, файлы с шестью потоками): картинка совпала
попиксельно, PSNR бесконечен на каждом кадре, длина и размер те же.
Сверка шла и с прошлым выпуском, а не только нового пути со старым.
На отрывке в 17.5 с: 14.2 с и 421 КБ на диске против 17.5 с и 152 МБ.

По дороге найдены две ловушки, обе записаны в README:
-avoid_negative_ts make_zero отменяет -output_ts_offset, а -fflags
+igndts у приёмника сминает кадры на стыках.
This commit is contained in:
4aiman 2026-09-30 16:12:00 +03:00
commit 38f4b295b9
5 changed files with 794 additions and 96 deletions
Download patch file Download diff file Expand all files Collapse all files

44
README.md
View file

@ -625,15 +625,29 @@ Linux потом искала по нему `.dll`.
только время: при копировании ffmpeg отмеряет конец по времени
декодирования, и у записи с B-кадрами кусок выходит длиннее
запрошенного.
6. Куски склеиваются concat-демультиплексором с явно указанной
длительностью каждого. Результат сверяется дважды: сумма пакетов кусков
обязана совпасть с числом пакетов в готовом файле, а число кадров — с
тем, что просил монтаж. Второе и есть проверка синхронности звука с
картинкой; вердикт пишется в журнал сборки.
6. Куски идут в готовый файл потоком. Каждый режется своим ffmpeg прямо
в MPEG-TS на стандартный вывод, все потоки подряд переливаются в один
принимающий ffmpeg, а тот пишет готовый файл. Место куску в общем
потоке задаёт `-output_ts_offset`, считаемое в кадрах от начала. На
диск не ложится ничего, кроме результата и звуковой дорожки.
7. Результат сверяется дважды: сумма кадров кусков обязана совпасть с
числом пакетов в готовом файле, а число кадров — с тем, что просил
монтаж. Второе и есть проверка синхронности звука с картинкой; вердикт
пишется в журнал сборки.
Звук в кусках картинки не хранится: звуковая дорожка собирается отдельно и
точнее, а лишний поток в куске MPEG-TS ещё и сбивает тайминг склейки —
замерено 36 мс на стык.
Звук собирается раньше картинки: приёмник берёт его вторым входом. В
кусках картинки звука нет — звуковая дорожка собирается отдельно и точнее,
а лишний поток в куске MPEG-TS ещё и сбивает тайминг склейки: замерено
36 мс на стык.
**Через кэш кусков** собирается то, что потоком не выходит: когда кодек
проекта не переносится в MPEG-TS или когда весь ролик пересобирается под
площадку одним кодировщиком. Тогда каждый кусок пишется в отдельный файл,
а склейка идёт concat-демультиплексором с явно указанной длительностью
каждого. Этот путь и был единственным раньше; оба дают побитово один и тот
же ролик — сверено на материале с дрона, PSNR бесконечен на каждом кадре.
Разница в цене: на отрывке в 17.5 с кэш весил 152 МБ против 421 КБ, а
времени ушло 17.5 с против 14.2 с.
Напрашивающийся способ — один проход с директивами `inpoint` и `outpoint`,
без временных файлов — проверен и отвергнут: он давал 574 кадра вместо 600
@ -801,6 +815,20 @@ Wine с новой библиотекой не грузилось ничего.
`TThread`, `Name` и `Caption` — у формы. Компилятор ловит это как
«Duplicate identifier», но причину не объясняет.
**Сдвиг к нулю отменяет сдвиг по времени.** При сборке потоком место
куску задаёт `-output_ts_offset`, но `-avoid_negative_ts make_zero`
считается уже после него и двигает кусок обратно в ноль — ключ просто
перестаёт действовать. Замерено: все шесть кусков встали в начало,
картинка разошлась с эталоном (PSNR 18 дБ) при верном числе кадров и
тех же пакетах. В потоке сдвиг к нулю выключен; отрицательные метки в
самом начале подбирает приёмник, у него make_zero свой.
**`-fflags +igndts` сминает кадры на стыках.** С ним ffmpeg выбрасывает
пришедшие метки декодирования и считает свои, а материал с B-кадрами
хранится не в том порядке, в каком показывается. На стыке появлялось по
три кадра с одной меткой, картинка расходилась с эталоном. Без этого
ключа метки идут шаг в шаг, и ни одной жалобы на непоследовательность.
**Двойной щелчок съедает второй щелчок.** Пока у элемента есть
`csDoubleClicks`, второй щелчок подряд приходит не как `Click`, а как
`DblClick`, и обработчик кнопки его не видит: человек щёлкает три раза,

343
src/uExport.pas
View file

@ -48,7 +48,7 @@ unit uExport;
interface
uses
Classes, SysUtils, uAppTypes, uKeyframeIndex, uMediaProbe;
Classes, SysUtils, uAppTypes, uKeyframeIndex, uMediaProbe, uProcRunner;
type
{ Настройки сборки с перекодированием.
@ -149,8 +149,21 @@ type
FIntermediateFormat: string;
FIntermediateExt: string;
{ Сборка потоком: куски идут в трубу приёмнику, а не в файлы кэша. }
FStreaming: Boolean;
FAllowStream: Boolean;
FSink: TProcSink;
{ Сколько кадров уже отправлено. Отсюда берётся время следующего
куска: считать кадрами, а не складывая секунды, — единственный
способ не накопить ошибку округления на тысяче кусков. }
FSentFrames: Int64;
function DistinctSourceCount: Integer;
procedure ChooseIntermediateFormat;
{ Можно ли собирать потоком и стоит ли. }
function CanStream(out AWhy: string): Boolean;
{ Время, на которое встанет следующий отправленный кусок. }
function SentTime: Double;
procedure SyncProgress;
procedure SyncLog;
@ -169,13 +182,20 @@ type
function CancelQuery: Boolean;
procedure ProgressLine(const ALine: string);
procedure ErrorLine(const ALine: string);
{ Поток ошибок отправителя: там вперемешку и журнал, и ход работы. }
procedure StreamLine(const ALine: string);
procedure PacketCountLine(const ALine: string);
function RunFfmpeg(const AArgs: array of string; const AWhat: string): Boolean;
{ Один кусок: в файл кэша или в трубу — смотря как собираем. }
function RunPart(const AArgs: array of string; const AWhat: string): Boolean;
function CountPackets(const APath: string): Int64;
function ExtractSegments: Boolean;
function WriteConcatList(out AListPath: string): Boolean;
function ConcatAll(const AListPath: string): Boolean;
{ Сборка потоком: приёмник запускается один раз, куски идут в него
по очереди, на диск ложится только готовый файл. }
function StreamAll: Boolean;
procedure Verify;
{ Сборка звука: куски сводятся в сырой поток и сжимаются одним
проходом. Сырой поток нужен для точности — стык получается с
@ -228,6 +248,9 @@ type
Проверять по одному только наличию файла нельзя: сборку могли
прервать посреди записи, и файл окажется обрезанным. }
property Resume: Boolean read FResume write FResume;
{ Разрешить сборку потоком. Выключено — собираем через кэш кусков,
как раньше. Нужно для сверки двух способов между собой. }
property AllowStream: Boolean read FAllowStream write FAllowStream;
{ Сколько кусков взято готовыми. Для отчёта. }
property ReusedParts: Integer read FReusedParts;
end;
@ -238,7 +261,7 @@ function CacheDirFor(const AOutputPath: string): string;
implementation
uses
Math, md5, FileUtil, uFfmpegCmd, uProcRunner;
Math, md5, FileUtil, uFfmpegCmd;
{ Размер файла или ноль, если его нет. }
function FileSizeOf(const APath: string): Int64;
@ -287,6 +310,9 @@ var
begin
FMaster := AMaster;
FProfile := AProfile;
{ Потоком — обычный путь; через кэш собираем, только когда потоком
нельзя или когда просят сверить два способа. }
FAllowStream := True;
inherited Create(True);
FreeOnTerminate := False;
@ -498,6 +524,23 @@ begin
Log('ffmpeg: ' + ALine);
end;
{ При сборке потоком стандартный вывод занят материалом, и ход работы
ffmpeg шлёт в поток ошибок — туда же, куда пишет журнал. Строки там
разного вида, и разбираются они по очереди: сперва пробуем прочесть
как ход работы, не вышло — значит это журнал. }
procedure TExportThread.StreamLine(const ALine: string);
var
Seconds: Double;
AtEnd: Boolean;
begin
Seconds := 0;
AtEnd := False;
if ParseProgressLine(ALine, Seconds, AtEnd) then
ProgressLine(ALine)
else
ErrorLine(ALine);
end;
procedure TExportThread.PacketCountLine(const ALine: string);
var
Value: Int64;
@ -543,6 +586,48 @@ begin
Result := True;
end;
{ Кусок при сборке потоком.
Отличий от обычного запуска два: вывод уходит не в файл, а приёмнику, и
журнал с ходом работы приходит одним потоком. Всё остальное — те же
проверки и тот же учёт работы. }
function TExportThread.RunPart(const AArgs: array of string;
const AWhat: string): Boolean;
var
Res: TProcResult;
begin
if not FStreaming then
Exit(RunFfmpeg(AArgs, AWhat));
Log('> ' + CommandToString(FfmpegExe, AArgs));
FStepPosition := 0;
Res := RunProcessInto(FfmpegExe, AArgs, FSink, @StreamLine, @CancelQuery);
if not Res.Started then
begin
FReport.Message := Res.ErrorText;
Exit(False);
end;
if Res.Cancelled then
begin
FReport.Cancelled := True;
FReport.Message := 'Отменено.';
Exit(False);
end;
if Res.ExitCode <> 0 then
begin
FReport.Message := AWhat + ': ffmpeg завершился с кодом ' +
IntToStr(Res.ExitCode) + '. Подробности в журнале.';
Exit(False);
end;
FDoneWork := FDoneWork + FStepWork;
FStepPosition := 0;
PublishProgress;
Result := True;
end;
function TExportThread.CountPackets(const APath: string): Int64;
var
Res: TProcResult;
@ -620,6 +705,47 @@ begin
'первого куска ко всем остальным.');
end;
{ Можно ли собрать ролик потоком, без кэша кусков.
Потоком куски идут в MPEG-TS, поэтому нужны кодеки, которые он несёт.
Пересборка всего ролика под площадку идёт своим путём: там весь
материал проходит через один кодировщик, и куски ему нужны списком.
Кадровая сетка обязательна: время каждому куску задаётся в кадрах от
начала, и без частоты кадров проекта эти времена не посчитать. }
function TExportThread.CanStream(out AWhy: string): Boolean;
begin
AWhy := '';
if not FAllowStream then
begin
AWhy := 'так попросили';
Exit(False);
end;
if FProfile.Enabled then
begin
AWhy := 'ролик пересобирается под площадку';
Exit(False);
end;
if (FMaster.FpsNum <= 0) or (FMaster.FpsDen <= 0) then
begin
AWhy := 'у проекта не задана частота кадров';
Exit(False);
end;
if not TsSupportsCodecs(FMaster.VideoCodec, FMaster.AudioCodec) then
begin
AWhy := 'кодек ' + FMaster.VideoCodec + ' не переносится в MPEG-TS';
Exit(False);
end;
Result := True;
end;
function TExportThread.SentTime: Double;
begin
if (FMaster.FpsNum <= 0) or (FMaster.FpsDen <= 0) then
Exit(0);
Result := FSentFrames * FMaster.FpsDen / FMaster.FpsNum;
end;
{ Первый опорный кадр строго правее указанного времени. Ноль означает,
что правее ничего нет. }
function NextKeyframeAfter(const AIndex: TKeyframeIndex;
@ -674,6 +800,11 @@ var
при продолжении просто терялась. }
function NeedRun(const ADst: string): Boolean;
begin
{ Потоком кэша нет вовсе: брать готовое неоткуда, и всё делается
заново. Продолжение прерванной сборки там устроено иначе — по уже
записанной части готового файла. }
if FStreaming then
Exit(True);
Result := not (IsDone(ExtractFileName(ADst)) and FileExists(ADst));
if not Result then
begin
@ -682,6 +813,40 @@ var
end;
end;
{ Куда пишется эта часть: в файл кэша или в трубу приёмнику. }
function PartDst(const ASuffix: string; AIndex: Integer): string;
begin
if FStreaming then
Result := 'pipe:1'
else
Result := FCacheDir +
Format('part_%.3d_%s%s', [AIndex, ASuffix, FIntermediateExt]);
end;
{ Время, на которое встанет эта часть в общем потоке. Отрицательное —
значит пишем в файл, и время куску не нужно: он начинается с нуля. }
function PartAt: Double;
begin
if FStreaming then
Result := SentTime
else
Result := -1;
end;
{ Часть ушла — двигаем счётчик отправленных кадров. }
procedure PartSent(AFrames: Integer);
begin
if FStreaming and (AFrames > 0) then
Inc(FSentFrames, AFrames);
end;
{ Пометка «готово» имеет смысл только для кэша. }
procedure PartDone(const ADst: string);
begin
if not FStreaming then
MarkDone(ExtractFileName(ADst));
end;
begin
Result := False;
PartCount := 0;
@ -715,7 +880,7 @@ begin
кадру нечего — они начинаются с нуля, а ноль всегда опорный. }
if (FSegments[I].Kind <> skVideo) and (FSegments[I].SubFile = '') then
begin
Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]);
Dst := PartDst('a', I);
Rep.Index := I;
Rep.SourcePath := FSegments[I].FilePath;
Rep.RequestedStart := 0;
@ -727,15 +892,15 @@ begin
FStepWork := FSegments[I].Duration;
if NeedRun(Dst) then
if not RunFfmpeg(ArgsExtract(FSegments[I].FilePath, Dst,
if not RunPart(ArgsExtract(FSegments[I].FilePath, Dst,
0, FSegments[I].Duration, FIntermediateFormat,
FSegments[I].Volume, FMaster.AudioCodec, Rep.WantFrames, WithAudio),
'Подготовка вставки ' + IntToStr(I + 1)) then
FSegments[I].Volume, FMaster.AudioCodec, Rep.WantFrames, WithAudio,
PartAt), 'Подготовка вставки ' + IntToStr(I + 1)) then
Exit;
Rep.TempPath := Dst;
MarkDone(ExtractFileName(Dst));
PartSent(Rep.WantFrames);
PartDone(Dst);
AddPart(Rep);
Continue;
end;
@ -747,7 +912,7 @@ begin
begin
SetStage(Format('Собираю наложение, кусок %d из %d',
[I + 1, Length(FSegments)]));
Dst := FCacheDir + Format('part_%.3d_x%s', [I, FIntermediateExt]);
Dst := PartDst('x', I);
Rep.Index := I;
Rep.SourcePath := FSegments[I].Layers[0].FilePath;
Rep.RequestedStart := FSegments[I].Layers[0].SrcStart;
@ -759,18 +924,18 @@ begin
FStepWork := FSegments[I].Duration;
if NeedRun(Dst) then
if not RunFfmpeg(ArgsRenderLayers(FSegments[I].Layers, Dst,
if not RunPart(ArgsRenderLayers(FSegments[I].Layers, Dst,
FSegments[I].Duration, FMaster.Width, FMaster.Height,
FMaster.FpsNum, FMaster.FpsDen, FMaster.PixFmt,
PreferredEncoder(FMaster.VideoCodec),
FIntermediateFormat = 'mpegts', FMaster.VideoBitrate,
FSegments[I].SubFile),
FSegments[I].SubFile, PartAt),
'Наложение в куске ' + IntToStr(I + 1)) then
Exit;
Rep.TempPath := Dst;
MarkDone(ExtractFileName(Dst));
PartSent(Rep.WantFrames);
PartDone(Dst);
AddPart(Rep);
Continue;
end;
@ -800,7 +965,7 @@ begin
begin
SetStage(Format('Пересобираю кусок %d из %d (файл не совпадает с проектом)',
[I + 1, Length(FSegments)]));
Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]);
Dst := PartDst('a', I);
Rep.Index := I;
Rep.SourcePath := FSegments[I].FilePath;
Rep.RequestedStart := FSegments[I].SrcStart;
@ -820,19 +985,19 @@ begin
Rep.ActualStart := Rep.RequestedStart;
if NeedRun(Dst) then
if not RunFfmpeg(ArgsTranscodeSegment(FSegments[I].FilePath, Dst,
if not RunPart(ArgsTranscodeSegment(FSegments[I].FilePath, Dst,
Rep.RequestedStart, Rep.RequestedStart + FSegments[I].Duration,
FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen,
FMaster.VideoCodec, FMaster.PixFmt, FMaster.AudioCodec,
FMaster.SampleRate, FMaster.Channels, FSegments[I].Volume,
FIntermediateFormat, FSegments[I].Filter, FSegments[I].SubFile,
FMaster.VideoBitrate),
FMaster.VideoBitrate, PartAt),
'Пересборка куска ' + IntToStr(I + 1)) then
Exit;
Rep.TempPath := Dst;
MarkDone(ExtractFileName(Dst));
PartSent(Rep.WantFrames);
PartDone(Dst);
AddPart(Rep);
Continue;
end;
@ -856,13 +1021,13 @@ begin
if Abs(SnapNearest(Index, FSegments[I].SrcStart) -
FSegments[I].SrcStart) < HalfFrame then
begin
Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]);
Dst := PartDst('a', I);
FStepWork := FSegments[I].Duration;
if NeedRun(Dst) then
if not RunFfmpeg(ArgsExtract(FSegments[I].FilePath, Dst,
if not RunPart(ArgsExtract(FSegments[I].FilePath, Dst,
FSegments[I].SrcStart, SegEnd, FIntermediateFormat,
FSegments[I].Volume, FMaster.AudioCodec, WantFrames, WithAudio),
'Вырезание куска ' + IntToStr(I + 1)) then
FSegments[I].Volume, FMaster.AudioCodec, WantFrames, WithAudio,
PartAt), 'Вырезание куска ' + IntToStr(I + 1)) then
Exit;
Rep.ActualStart := FSegments[I].SrcStart;
@ -870,7 +1035,8 @@ begin
Rep.WantFrames := WantFrames;
Rep.TempPath := Dst;
Rep.Encoded := False;
MarkDone(ExtractFileName(Dst));
PartSent(WantFrames);
PartDone(Dst);
AddPart(Rep);
Continue;
end;
@ -901,15 +1067,15 @@ begin
SecondsToStr(EncodeUntil - FSegments[I].SrcStart),
HeadFrames, TailFrames]));
Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]);
Dst := PartDst('a', I);
FStepWork := EncodeUntil - FSegments[I].SrcStart;
if NeedRun(Dst) then
if not RunFfmpeg(ArgsEncodeFragment(FSegments[I].FilePath, Dst,
if not RunPart(ArgsEncodeFragment(FSegments[I].FilePath, Dst,
FSegments[I].SrcStart, EncodeUntil,
FMaster.FpsNum, FMaster.FpsDen,
FMaster.VideoCodec, FMaster.PixFmt, FMaster.AudioCodec,
FMaster.SampleRate, FMaster.Channels, FIntermediateFormat,
HeadFrames, WithAudio, FMaster.VideoBitrate),
HeadFrames, WithAudio, FMaster.VideoBitrate, PartAt),
'Перекодирование стыка куска ' + IntToStr(I + 1)) then
Exit;
@ -918,21 +1084,22 @@ begin
Rep.WantFrames := HeadFrames;
Rep.TempPath := Dst;
Rep.Encoded := True;
MarkDone(ExtractFileName(Dst));
PartSent(HeadFrames);
PartDone(Dst);
AddPart(Rep);
if TailFrames > 0 then
begin
Dst := FCacheDir + Format('part_%.3d_b%s', [I, FIntermediateExt]);
Dst := PartDst('b', I);
FStepWork := SegEnd - EncodeUntil;
{ Копия начинается ровно с опорного кадра: проверено замером —
первым кадром выходит именно он, кадры предыдущей группы за ним
не тянутся. Значит стык с огрызком получается кадр в кадр. }
if NeedRun(Dst) then
if not RunFfmpeg(ArgsExtract(FSegments[I].FilePath, Dst,
if not RunPart(ArgsExtract(FSegments[I].FilePath, Dst,
EncodeUntil, SegEnd, FIntermediateFormat,
FSegments[I].Volume, FMaster.AudioCodec, TailFrames, WithAudio),
'Вырезание куска ' + IntToStr(I + 1)) then
FSegments[I].Volume, FMaster.AudioCodec, TailFrames, WithAudio,
PartAt), 'Вырезание куска ' + IntToStr(I + 1)) then
Exit;
Rep.ActualStart := EncodeUntil;
@ -940,7 +1107,8 @@ begin
Rep.WantFrames := TailFrames;
Rep.TempPath := Dst;
Rep.Encoded := False;
MarkDone(ExtractFileName(Dst));
PartSent(TailFrames);
PartDone(Dst);
AddPart(Rep);
end;
@ -1039,6 +1207,53 @@ begin
FOutputPath), 'Склейка');
end;
{ Сборка потоком.
Приёмник запускается первым и живёт до конца: он держит открытым
готовый файл. Куски шлются в него по очереди, каждый со своим временем.
Закрытый ввод для приёмника — знак, что материал кончился; только после
этого он дописывает оглавление и завершается.
Звук должен быть готов заранее: приёмник берёт его вторым входом. }
function TExportThread.StreamAll: Boolean;
var
Args: TArgs;
Code: Integer;
begin
Result := False;
Args := ArgsStreamMux(FAudioPath, FSubtitlePath, FOutputPath);
Log('> ' + CommandToString(FfmpegExe, Args) + ' (приёмник)');
FSink := TProcSink.Create(FfmpegExe, Args, nil, @ErrorLine);
try
if not FSink.Started then
begin
FReport.Message := FSink.Error;
Exit;
end;
if not ExtractSegments then
begin
{ Приёмнику работать больше не для кого. Недописанный файл остаётся
лежать: с него продолжают прерванную сборку. }
FSink.Stop;
Exit;
end;
SetStage('Дописываю файл');
Code := FSink.Wait;
if Code <> 0 then
begin
FReport.Message := 'Сборка потоком: ffmpeg завершился с кодом ' +
IntToStr(Code) + '. Подробности в журнале.';
Exit;
end;
Result := True;
finally
FreeAndNil(FSink);
end;
end;
procedure TExportThread.Verify;
var
I: Integer;
@ -1049,7 +1264,13 @@ begin
Sum := 0;
for I := 0 to High(FReport.Segments) do
begin
N := CountPackets(FReport.Segments[I].TempPath);
{ Потоком кусков на диске нет, и считать в них нечего: сколько кадров
каждый кусок должен был дать, мы и так знали заранее — именно это
число получал ffmpeg ключом -frames:v. }
if FStreaming then
N := FReport.Segments[I].WantFrames
else
N := CountPackets(FReport.Segments[I].TempPath);
FReport.Segments[I].Packets := N;
if N > 0 then
Inc(Sum, N);
@ -1375,7 +1596,7 @@ var
ListPath: string;
I: Integer;
Freed: Int64;
ToolError: string;
ToolError, StreamWhy: string;
begin
try
if Length(FSegments) = 0 then
@ -1401,30 +1622,49 @@ begin
Log('Временные куски: ' + FCacheDir);
ChooseIntermediateFormat;
{ Потоком или через кэш кусков.
Потоком на диск не ложится ничего, кроме готового файла, и весь
материал переписывается один раз вместо двух. Куски при этом идут
в MPEG-TS, поэтому формат промежутка здесь не обсуждается. }
FStreaming := CanStream(StreamWhy);
if FStreaming then
begin
FIntermediateFormat := 'mpegts';
FIntermediateExt := '.ts';
Log('Собираю потоком: куски идут сразу в готовый файл, кэш не ' +
'создаётся.');
end
else
Log('Собираю через кэш кусков: ' + StreamWhy + '.');
{ Список готовых кусков — после выбора промежуточного формата: от него
зависят их имена. }
LoadDoneList;
if FResume and (FDone.Count > 1) then
if (not FStreaming) and FResume and (FDone.Count > 1) then
Log(Format('Продолжаю прерванную сборку: готовых кусков %d.',
[FDone.Count - 1]));
{ Единица учёта работы — секунда материала. Каждая секунда проходит
через вырезание, склейку и сборку звука, отсюда тройной вес. }
FTotalWork := FReport.TotalDuration * 3;
через вырезание, склейку и сборку звука, отсюда тройной вес.
Потоком склейки отдельным проходом нет, и вес вдвое меньше. }
if FStreaming then
FTotalWork := FReport.TotalDuration * 2
else
FTotalWork := FReport.TotalDuration * 3;
FDoneWork := 0;
if not ExtractSegments then
Exit;
if not WriteConcatList(ListPath) then
Exit;
{ Звук собирается раньше картинки, и склейка сразу кладёт всё вместе в
конечный файл.
Так было не всегда: сперва картинка собиралась в отдельный файл, а
потом сшивалась со звуком. На часовом ролике это 91 ГБ
промежуточного файла и лишний полный проход копирования — места
требовалось вдвое больше готового ролика. }
требовалось вдвое больше готового ролика.
При сборке потоком порядок ещё и обязателен: приёмник берёт звук
вторым входом и запускается раньше первого куска картинки. }
FVideoPath := '';
if not BuildAudio then
begin
@ -1435,8 +1675,21 @@ begin
FAudioPath := '';
end;
if not ConcatAll(ListPath) then
Exit;
ListPath := '';
if FStreaming then
begin
if not StreamAll then
Exit;
end
else
begin
if not ExtractSegments then
Exit;
if not WriteConcatList(ListPath) then
Exit;
if not ConcatAll(ListPath) then
Exit;
end;
Verify;

170
src/uFfmpegCmd.pas
View file

@ -71,7 +71,7 @@ function ToolsAvailable(out AError: string): Boolean;
function ArgsExtract(const ASrc, ADst: string; AStart, AEnd: Double;
const AFormat: string; AVolume: Double = 1;
const AAudioCodec: string = ''; AFrames: Integer = 0;
AWithAudio: Boolean = True): TArgs;
AWithAudio: Boolean = True; AAt: Double = -1): TArgs;
{ Перепаковать файл целиком в заданный формат, копируя потоки. }
function ArgsCopyTo(const ASrc, ADst, AFormat: string): TArgs;
@ -88,7 +88,7 @@ function ArgsEncodeFragment(const ASrc, ADst: string; AStart, AEnd: Double;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer; const AFormat: string;
AFrames: Integer = 0; AWithAudio: Boolean = True;
ABitrate: Int64 = 0): TArgs;
ABitrate: Int64 = 0; AAt: Double = -1): TArgs;
{ Пересобрать кусок в параметры проекта.
@ -100,7 +100,8 @@ function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer; AVolume: Double;
const AFormat: string; const AFilter: string = '';
const ASubFile: string = ''; ABitrate: Int64 = 0): TArgs;
const ASubFile: string = ''; ABitrate: Int64 = 0;
AAt: Double = -1): TArgs;
{ Путь внутри строки фильтра. Двоеточие там разделяет настройки, обратная
косая и кавычка имеют своё значение — всё это надо обезвредить, иначе
@ -140,6 +141,12 @@ function ArgsConcat(const AListFile, ADst: string): TArgs;
надо. Пусто в AAudio — значит звука нет, тогда это обычная склейка. }
function ArgsConcatMux(const AListFile, AAudio, ASubFile, ADst: string): TArgs;
{ Приёмник сборки потоком: читает MPEG-TS из трубы и пишет готовый файл.
То же, что ArgsConcatMux, только куски приходят не списком файлов, а
одним потоком в стандартный ввод. AAudio и ASubFile — как там. }
function ArgsStreamMux(const AAudio, ASubFile, ADst: string): TArgs;
{ Склеить куски и сразу перекодировать картинку в заданный размер и поток.
Нужно для сборки «под площадку»: когда ролик надо отдать в 1080p с
@ -189,7 +196,8 @@ function ArgsRenderLayers(const ALayers: array of TSegmentLayer;
const ATarget: string; const ADuration: Double;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const APixFmt, ACodec: string; AIsTs: Boolean;
ABitrate: Int64 = 0; const ASubFile: string = ''): TArgs;
ABitrate: Int64 = 0; const ASubFile: string = '';
AAt: Double = -1): TArgs;
{ Сшивание готовой картинки с готовым звуком. Оба потока копируются.
@ -284,6 +292,10 @@ uses
слоёв, а она по тексту раньше самой функции. }
function BitrateArgs(ABitrate: Int64): TArgs; forward;
{ Хвост вывода: куда писать и как докладывать о ходе работы. Объявлено
здесь по той же причине — отрисовка слоёв идёт раньше. }
function TailArgs(const AFormat, ADst: string; AAt: Double): TArgs; forward;
const
{ Поток для чёрных вставок: мегабит в секунду. }
BlackBitrate = 1000000;
@ -334,7 +346,7 @@ function ArgsRenderLayers(const ALayers: array of TSegmentLayer;
const ATarget: string; const ADuration: Double;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const APixFmt, ACodec: string; AIsTs: Boolean;
ABitrate: Int64; const ASubFile: string): TArgs;
ABitrate: Int64; const ASubFile: string; AAt: Double): TArgs;
var
I: Integer;
Graph, Fit, Src, OutLabel: string;
@ -448,12 +460,11 @@ begin
'-c:v', PreferredEncoder(ACodec), '-r', Format('%d/%d', [AFpsNum, AFpsDen]),
'-pix_fmt', APixFmt]);
Result := Concat(Result, BitrateArgs(ABitrate));
Result := Concat(Result,
['-bf', '0', '-an', '-avoid_negative_ts', 'make_zero',
'-progress', 'pipe:1', '-nostats']);
Result := Concat(Result, ['-bf', '0', '-an']);
if AIsTs then
Result := Concat(Result, ['-f', 'mpegts']);
Result := Concat(Result, [ATarget]);
Result := Concat(Result, TailArgs('mpegts', ATarget, AAt))
else
Result := Concat(Result, TailArgs('', ATarget, AAt));
end;
function ArgsMux(const AVideo, AAudio, ATarget: string;
@ -569,6 +580,64 @@ begin
Result := ['-progress', 'pipe:1', '-nostats'];
end;
{ То же, когда стандартный вывод занят: в него идёт сам материал.
Прогресс тогда отправляется в поток ошибок, вперемешку с журналом.
Строки там разные и разбираются по-разному, так что смешение не мешает:
ход работы — это «ключ=значение», журнал — обычный текст. }
function ProgressArgsToStderr: TArgs;
begin
Result := ['-progress', 'pipe:2', '-nostats'];
end;
{ Хвост вывода: файл или труба.
AAt < 0 — обычный файл в заданном контейнере. AAt >= 0 — труба, и тогда
контейнер всегда MPEG-TS: только он даёт склеивать куски встык, повторяя
параметры кодека перед каждым опорным кадром.
-output_ts_offset ставит кусок на его место в общем потоке. Без него
каждый кусок начинался бы с нуля, и приёмник свалил бы их в одну точку.
-muxdelay и -muxpreload в ноль: обычно MPEG-TS откладывает начало на
семь десятых секунды под буфер проигрывателя, и эта задержка сдвинула бы
каждый кусок относительно заданного ему времени.
-copyts здесь намеренно нет: с ним метки остаются исходными, и на пробе
ролик из шести кусков по четыре секунды вышел длиной 48.7 с вместо
24.0. }
function OutputTail(const AFormat, ADst: string; AAt: Double): TArgs;
begin
if AAt < 0 then
begin
{ Метки времени вырезанного куска должны начинаться с нуля, иначе при
склейке куски разъедутся по времени. }
Result := ['-avoid_negative_ts', 'make_zero'];
{ Пустое имя контейнера — значит его выбирает сам ffmpeg по
расширению файла. }
if AFormat = '' then
Result := Concat(Result, [ADst])
else
Result := Concat(Result, ['-f', AFormat, ADst]);
Exit;
end;
{ А вот в потоке make_zero всё ломает, и это стоило разбирательства.
Сдвиг к нулю считается уже после того, как применён -output_ts_offset,
и сдвигает кусок обратно в ноль — ключ просто перестаёт действовать.
Замерено: все шесть кусков встали в начало, метки времени в готовом
файле перестали расти, а картинка разошлась с эталоном (PSNR 18 дБ
вместо бесконечности при том же числе кадров и тех же пакетах).
Поэтому здесь сдвиг к нулю выключен: место куску задаёт offset, а
отрицательные метки в самом начале ролика подберёт приёмник — у него
make_zero свой. }
Result := ['-avoid_negative_ts', 'disabled',
'-output_ts_offset', SecondsToStr(AAt),
'-muxdelay', '0', '-muxpreload', '0',
'-f', 'mpegts', 'pipe:1'];
end;
function Concat(const A, B: TArgs): TArgs;
var
I: Integer;
@ -581,6 +650,16 @@ begin
Result[Length(A) + I] := B[I];
end;
{ Ход работы и хвост вывода разом: они всегда меняются вместе. }
function TailArgs(const AFormat, ADst: string; AAt: Double): TArgs;
begin
if AAt < 0 then
Result := ProgressArgs
else
Result := ProgressArgsToStderr;
Result := Concat(Result, OutputTail(AFormat, ADst, AAt));
end;
{ Нужен ли контейнеру перенос заголовка в начало файла.
Для MP4 это делает файл пригодным для воспроизведения по мере загрузки.
@ -595,7 +674,7 @@ end;
function ArgsExtract(const ASrc, ADst: string; AStart, AEnd: Double;
const AFormat: string; AVolume: Double; const AAudioCodec: string;
AFrames: Integer; AWithAudio: Boolean): TArgs;
AFrames: Integer; AWithAudio: Boolean; AAt: Double): TArgs;
begin
Result := Concat(CommonFfmpegPrefix, [
'-ss', SecondsToStr(AStart),
@ -633,11 +712,7 @@ begin
if AFrames > 0 then
Result := Concat(Result, ['-frames:v', IntToStr(AFrames)]);
{ Метки времени вырезанного куска должны начинаться с нуля, иначе
при склейке куски разъедутся по времени. }
Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']);
Result := Concat(Result, ProgressArgs);
Result := Concat(Result, ['-f', AFormat, ADst]);
Result := Concat(Result, TailArgs(AFormat, ADst, AAt));
end;
function ArgsCopyTo(const ASrc, ADst, AFormat: string): TArgs;
@ -656,7 +731,8 @@ function ArgsEncodeFragment(const ASrc, ADst: string; AStart, AEnd: Double;
AFpsNum, AFpsDen: Integer;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer; const AFormat: string;
AFrames: Integer; AWithAudio: Boolean; ABitrate: Int64): TArgs;
AFrames: Integer; AWithAudio: Boolean; ABitrate: Int64;
AAt: Double): TArgs;
var
HalfFrame, StopAt: Double;
begin
@ -704,9 +780,7 @@ begin
кадр, и лишнему взяться неоткуда. }
if AFrames > 0 then
Result := Concat(Result, ['-frames:v', IntToStr(AFrames)]);
Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']);
Result := Concat(Result, ProgressArgs);
Result := Concat(Result, ['-f', AFormat, ADst]);
Result := Concat(Result, TailArgs(AFormat, ADst, AAt));
end;
function EscapeFilterPath(const APath: string): string;
@ -721,7 +795,7 @@ function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer; AVolume: Double;
const AFormat: string; const AFilter: string;
const ASubFile: string; ABitrate: Int64): TArgs;
const ASubFile: string; ABitrate: Int64; AAt: Double): TArgs;
var
Chain: string;
begin
@ -757,9 +831,7 @@ begin
Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen,
AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels, ABitrate));
Result := Concat(Result, NoBFramesArgs);
Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']);
Result := Concat(Result, ProgressArgs);
Result := Concat(Result, ['-f', AFormat, ADst]);
Result := Concat(Result, TailArgs(AFormat, ADst, AAt));
end;
function TsSupportsCodecs(const AVideoCodec, AAudioCodec: string): Boolean;
@ -900,6 +972,56 @@ begin
Result := Concat(Result, [ADst]);
end;
{ Приёмник: один ffmpeg, который читает поток MPEG-TS из трубы и пишет
готовый файл.
-fflags +igndts здесь был и оказался вреден. С ним ffmpeg выбрасывает
метки декодирования, пришедшие с кусками, и считает свои — а материал с
B-кадрами хранится не в том порядке, в каком показывается, и пересчёт
сминает кадры в кучу: замерено, что на стыке появлялись по три кадра с
одной и той же меткой, а картинка расходилась с эталоном (PSNR 18 дБ
при верном числе кадров). Без этого ключа метки на стыке идут ровно,
шаг в шаг, и ни одной жалобы на непоследовательность в журнале.
Прогресс отсюда не берётся: ход работы считается по кускам, а их шлём
мы сами. Лишний поток -progress только мешал бы — его труба заполнялась
бы, пока мы заняты переливом. }
function ArgsStreamMux(const AAudio, ASubFile, ADst: string): TArgs;
var
Next: Integer;
begin
Result := Concat(CommonFfmpegPrefix, [
'-f', 'mpegts',
'-i', 'pipe:0'
]);
Next := 1;
if AAudio <> '' then
Result := Concat(Result, ['-i', AAudio]);
if ASubFile <> '' then
Result := Concat(Result, ['-i', ASubFile]);
Result := Concat(Result, ['-map', '0:v:0']);
if AAudio <> '' then
begin
Result := Concat(Result, ['-map', IntToStr(Next) + ':a:0']);
Inc(Next);
end
else
Result := Concat(Result, ['-map', '0:a:0?']);
if ASubFile <> '' then
Result := Concat(Result, ['-map', IntToStr(Next) + ':s:0', '-c:s', 'ass',
'-metadata:s:s:0', 'title=Надписи',
'-metadata:s:s:0', 'language=rus']);
Result := Concat(Result, ['-c:v', 'copy', '-c:a', 'copy',
'-avoid_negative_ts', 'make_zero', '-nostats']);
if WantsFaststart(ADst) then
Result := Concat(Result, ['-movflags', '+faststart']);
Result := Concat(Result, [ADst]);
end;
function ArgsRemux(const ASrc, ADst: string): TArgs;
begin
Result := Concat(CommonFfmpegPrefix, [

324
src/uProcRunner.pas
View file

@ -34,6 +34,25 @@ type
несколько раз в секунду. }
TProcCancelQuery = function: Boolean of object;
{ Накопитель, который режет поток байтов на строки.
Отдельный класс нужен потому, что ffmpeg заканчивает строки по-разному:
вывод -progress использует перевод строки, а строку состояния в потоке
ошибок он перерисовывает возвратом каретки. Оба символа считаются
концом строки, пустые строки отбрасываются.
Наружу вынесен не для чужого пользования, а потому что его держит
приёмник ниже. }
TLineSplitter = class
private
FBuffer: string;
FOnLine: TProcLineEvent;
public
constructor Create(AOnLine: TProcLineEvent);
procedure Feed(const AData: string);
procedure Flush;
end;
TProcResult = record
Started: Boolean;
Cancelled: Boolean;
@ -42,6 +61,45 @@ type
ErrorText: string;
end;
{ Принимающий процесс: его ввод — труба, в которую мы льём то, что
вышло из процессов-отправителей.
Зачем класс, а не ещё одна функция: приёмник живёт дольше любого
отправителя. Один ffmpeg пишет готовый файл, а куски в него шлёт
десяток других, запускаемых по очереди.
Перелив идёт через нашу память, а не настоящей трубой между двумя
чужими процессами: собственные трубы у дочерних процессов есть в
любой системе, а наследование чужого дескриптора — нет.
Вывод приёмника вычитывается на каждом шаге перелива. Иначе труба
его журнала заполнилась бы, приёмник встал бы на записи в неё, а мы
ждали бы, пока он прочтёт — и оба ждали бы друг друга. }
TProcSink = class
private
FProc: TProcessUTF8;
FOutSplit, FErrSplit: TLineSplitter;
FStarted: Boolean;
FClosed: Boolean;
FError: string;
public
constructor Create(const AExe: string; const AArgs: array of string;
AOnStdOut, AOnStdErr: TProcLineEvent);
destructor Destroy; override;
{ Вычитывает журнал приёмника, не дожидаясь его конца. }
procedure Pump;
{ Отдаёт приёмнику очередной кусок. False — труба оборвалась,
то есть приёмник умер и слать дальше некуда. }
function Feed(const ABuf; ACount: Integer): Boolean;
{ Закрывает ввод: для приёмника это конец материала. }
procedure CloseInput;
{ Ждёт конца работы и отдаёт код возврата. }
function Wait: Integer;
procedure Stop;
property Started: Boolean read FStarted;
property Error: string read FError;
end;
{ Запускает процесс и ждёт его завершения, разбирая вывод на строки.
AOnStdOut получает поток вывода (туда ffmpeg пишет -progress),
@ -50,6 +108,15 @@ type
function RunProcess(const AExe: string; const AArgs: array of string;
AOnStdOut, AOnStdErr: TProcLineEvent; ACancel: TProcCancelQuery): TProcResult;
{ Запускает процесс и переливает его вывод в приёмник.
Вывод в трубу, а не в файл: ASink получает байты, а не строки. Поток
ошибок по-прежнему разбирается построчно — туда ffmpeg пишет и журнал,
и ход работы, если его об этом попросить (-progress pipe:2). }
function RunProcessInto(const AExe: string; const AArgs: array of string;
ASink: TProcSink; AOnStdErr: TProcLineEvent;
ACancel: TProcCancelQuery): TProcResult;
{ Путь к исполняемому файлу по имени. Пустая строка — не найден. }
function FindTool(const AName: string): string;
@ -66,23 +133,6 @@ const
ReadChunk = 16 * 1024;
type
{ Накопитель, который режет поток байтов на строки.
Отдельный класс нужен потому, что ffmpeg заканчивает строки по-разному:
вывод -progress использует перевод строки, а строку состояния в потоке
ошибок он перерисовывает возвратом каретки. Оба символа считаются
концом строки, пустые строки отбрасываются. }
TLineSplitter = class
private
FBuffer: string;
FOnLine: TProcLineEvent;
public
constructor Create(AOnLine: TProcLineEvent);
procedure Feed(const AData: string);
procedure Flush;
end;
constructor TLineSplitter.Create(AOnLine: TProcLineEvent);
begin
inherited Create;
@ -172,6 +222,246 @@ begin
end;
end;
{ --- Приёмник --- }
constructor TProcSink.Create(const AExe: string; const AArgs: array of string;
AOnStdOut, AOnStdErr: TProcLineEvent);
var
I: Integer;
begin
inherited Create;
FOutSplit := TLineSplitter.Create(AOnStdOut);
FErrSplit := TLineSplitter.Create(AOnStdErr);
FProc := TProcessUTF8.Create(nil);
if not FileExists(AExe) then
begin
FError := 'Не найден исполняемый файл: ' + AExe;
Exit;
end;
FProc.Executable := AExe;
for I := 0 to High(AArgs) do
FProc.Parameters.Add(AArgs[I]);
FProc.Options := [poUsePipes, poNoConsole];
FProc.ShowWindow := swoHIDE;
try
FProc.Execute;
FStarted := True;
except
on E: Exception do
FError := 'Не удалось запустить ' + AExe + ': ' + E.Message;
end;
end;
destructor TProcSink.Destroy;
begin
Stop;
FProc.Free;
FErrSplit.Free;
FOutSplit.Free;
inherited Destroy;
end;
procedure TProcSink.Pump;
begin
if not FStarted then
Exit;
DrainPipe(FProc.Output, FOutSplit);
DrainPipe(FProc.Stderr, FErrSplit);
end;
function TProcSink.Feed(const ABuf; ACount: Integer): Boolean;
begin
Result := False;
if (not FStarted) or FClosed or (ACount <= 0) then
Exit;
{ Приёмник мог умереть — на разбитой трубе запись даёт исключение или
сигнал. Молча считаем это концом работы: настоящую причину скажет код
возврата и журнал. }
if not FProc.Running then
Exit;
try
Result := FProc.Input.Write(ABuf, ACount) = ACount;
except
Result := False;
end;
{ Журнал приёмника вычитывается после каждой порции: его труба невелика,
и переполнившись, она остановила бы самого приёмника. }
Pump;
end;
procedure TProcSink.CloseInput;
begin
if (not FStarted) or FClosed then
Exit;
FClosed := True;
try
FProc.CloseInput;
except
{ Труба уже разбита — значит приёмника нет, и закрывать нечего. }
end;
end;
function TProcSink.Wait: Integer;
begin
if not FStarted then
Exit(-1);
CloseInput;
while FProc.Running do
begin
Pump;
Sleep(IdleSleepMs);
end;
while DrainPipe(FProc.Output, FOutSplit) +
DrainPipe(FProc.Stderr, FErrSplit) > 0 do
;
FOutSplit.Flush;
FErrSplit.Flush;
Result := FProc.ExitStatus;
end;
procedure TProcSink.Stop;
begin
if not FStarted then
Exit;
CloseInput;
if FProc.Running then
try
FProc.Terminate(1);
except
{ Уже завершился сам. }
end;
end;
{ Перелив идёт порциями: прочитали у отправителя — отдали приёмнику.
Порция небольшая по той же причине, по которой мал буфер трубы: между
записями надо успевать вычитывать журналы обоих процессов и смотреть,
не просят ли нас остановиться. }
function RunProcessInto(const AExe: string; const AArgs: array of string;
ASink: TProcSink; AOnStdErr: TProcLineEvent;
ACancel: TProcCancelQuery): TProcResult;
var
P: TProcessUTF8;
ErrSplit: TLineSplitter;
I, Avail, Got: Integer;
Terminated, Broken: Boolean;
Buf: array[0..ReadChunk - 1] of Byte;
{ Забирает у отправителя всё, что уже готово, и отдаёт приёмнику.
Возвращает число перелитых байт. }
function MoveData: Integer;
begin
Result := 0;
if P.Output = nil then
Exit;
Avail := P.Output.NumBytesAvailable;
while Avail > 0 do
begin
if Avail > SizeOf(Buf) then
Avail := SizeOf(Buf);
Got := P.Output.Read(Buf, Avail);
if Got <= 0 then
Break;
if not ASink.Feed(Buf, Got) then
begin
Broken := True;
Break;
end;
Inc(Result, Got);
Avail := P.Output.NumBytesAvailable;
end;
end;
begin
Result.Started := False;
Result.Cancelled := False;
Result.ExitCode := -1;
Result.ErrorText := '';
if ASink = nil then
begin
Result.ErrorText := 'Некуда переливать: приёмник не задан.';
Exit;
end;
if not ASink.Started then
begin
Result.ErrorText := ASink.Error;
if Result.ErrorText = '' then
Result.ErrorText := 'Приёмник не запущен.';
Exit;
end;
if not FileExists(AExe) then
begin
Result.ErrorText := 'Не найден исполняемый файл: ' + AExe;
Exit;
end;
P := TProcessUTF8.Create(nil);
ErrSplit := TLineSplitter.Create(AOnStdErr);
Broken := False;
try
P.Executable := AExe;
for I := 0 to High(AArgs) do
P.Parameters.Add(AArgs[I]);
P.Options := [poUsePipes, poNoConsole];
P.ShowWindow := swoHIDE;
try
P.Execute;
except
on E: Exception do
begin
Result.ErrorText := 'Не удалось запустить ' + AExe + ': ' + E.Message;
Exit;
end;
end;
Result.Started := True;
Terminated := False;
while P.Running do
begin
I := MoveData + DrainPipe(P.Stderr, ErrSplit);
if Broken then
begin
{ Приёмник кончился — отправителю работать не для кого. }
if not Terminated then
begin
Terminated := True;
P.Terminate(1);
end;
Break;
end;
if (not Terminated) and Assigned(ACancel) and ACancel() then
begin
Result.Cancelled := True;
Terminated := True;
P.Terminate(1);
end;
if I = 0 then
Sleep(IdleSleepMs);
end;
{ Хвост: после завершения в трубах обычно остаётся непрочитанное. }
if not Broken then
while MoveData + DrainPipe(P.Stderr, ErrSplit) > 0 do
;
ErrSplit.Flush;
Result.ExitCode := P.ExitStatus;
if Broken and (Result.ExitCode = 0) then
Result.ExitCode := -1;
finally
ErrSplit.Free;
P.Free;
end;
end;
function RunProcess(const AExe: string; const AArgs: array of string;
AOnStdOut, AOnStdErr: TProcLineEvent; ACancel: TProcCancelQuery): TProcResult;
var

9
tests/nlvetool.lpr
View file

@ -20,9 +20,10 @@
build <проект.nlve> <видео> [<картинка>]
собрать проект-образец: видео внизу, картинка
сверху посередине, дыра в начале
render <проект.nlve> <выход>
render <проект.nlve> <выход> [burn|keep|resume|cache]
уплотить проект, создать вставки, собрать ролик
и сверить число кадров
и сверить число кадров; cache — собрать
по-старому, через кэш кусков
subs <проект.nlve>
собрать разметку субтитров из текстовых клипов
и напечатать её
@ -1601,6 +1602,10 @@ begin
{ Словом resume просят продолжить прерванную сборку: готовые куски
берутся с диска, а не считаются заново. }
Thread.Resume := (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'resume');
{ Словом cache просят собрать по-старому, через кэш кусков: так два
способа сверяются между собой на одном и том же монтаже. }
Thread.AllowStream := not ((ParamCount >= 4) and
(LowerCase(ParamStr(4)) = 'cache'));
Watcher := TExportWatcher.Create(Thread);
try
Thread.OnProgress := @Watcher.Progress;