From 38f4b295b989c690d9db42ad4945fa7f7041595c Mon Sep 17 00:00:00 2001 From: 4aiman Date: Wed, 30 Sep 2026 16:12:00 +0300 Subject: [PATCH] =?UTF-8?q?=D0=A1=D0=B1=D0=BE=D1=80=D0=BA=D0=B0=20=D0=BF?= =?UTF-8?q?=D0=BE=D1=82=D0=BE=D0=BA=D0=BE=D0=BC:=20=D0=BA=D1=83=D1=81?= =?UTF-8?q?=D0=BA=D0=B8=20=D0=B8=D0=B4=D1=83=D1=82=20=D1=81=D1=80=D0=B0?= =?UTF-8?q?=D0=B7=D1=83=20=D0=B2=20=D0=B3=D0=BE=D1=82=D0=BE=D0=B2=D1=8B?= =?UTF-8?q?=D0=B9=20=D1=84=D0=B0=D0=B9=D0=BB,=20=D0=B1=D0=B5=D0=B7=20?= =?UTF-8?q?=D0=BA=D1=8D=D1=88=D0=B0?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Раньше каждый кусок монтажа вырезался в отдельный файл, и только потом список этих файлов шёл на склейку. Кэш весил столько же, сколько готовый фильм — замерено 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 у приёмника сминает кадры на стыках. --- README.md | 44 ++++-- src/uExport.pas | 343 ++++++++++++++++++++++++++++++++++++++------ src/uFfmpegCmd.pas | 170 ++++++++++++++++++---- src/uProcRunner.pas | 324 ++++++++++++++++++++++++++++++++++++++--- tests/nlvetool.lpr | 9 +- 5 files changed, 794 insertions(+), 96 deletions(-) diff --git a/README.md b/README.md index 57157ab..ecf2ae2 100644 --- a/README.md +++ b/README.md @@ -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`, и обработчик кнопки его не видит: человек щёлкает три раза, diff --git a/src/uExport.pas b/src/uExport.pas index 3fd14b7..cd00d03 100644 --- a/src/uExport.pas +++ b/src/uExport.pas @@ -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; diff --git a/src/uFfmpegCmd.pas b/src/uFfmpegCmd.pas index 617a290..f728829 100644 --- a/src/uFfmpegCmd.pas +++ b/src/uFfmpegCmd.pas @@ -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, [ diff --git a/src/uProcRunner.pas b/src/uProcRunner.pas index 6a3dde2..f7fb8b0 100644 --- a/src/uProcRunner.pas +++ b/src/uProcRunner.pas @@ -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 diff --git a/tests/nlvetool.lpr b/tests/nlvetool.lpr index fa98659..d4af14f 100644 --- a/tests/nlvetool.lpr +++ b/tests/nlvetool.lpr @@ -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;