ttw_fmx_v10/utils/uTTS.pas

unit uTTS;

interface

uses
  winapi.Windows, System.SysUtils, System.Classes, winapi.MMSystem;

type
  TPlayFinishedEvent = procedure(Sender: TObject) of object;

type
  TTTS = class
  private
    FPiperExePath: string;
    FVoicesFolder: string;
    FCurrentModel: string;
    FOnPlayFinished: TPlayFinishedEvent;
    procedure DoPlayFinished;
    function RunProcessCaptureOutput(const Exe, Args, InputText: string; out OutputText: string): Boolean;
  public
    constructor Create(const APiperExePath, AVoicesFolder: string);
    /// <summary>Ñïèñîê ìîäåëåé (ôàéëû .onnx) â ïàïêå voices</summary>
    function GetModelsList: TStringList;

    /// <summary>Âûáðàòü ìîäåëü îçâó÷èâàíèÿ (èìÿ ôàéëà .onnx)</summary>
    procedure SetModel(const ModelFileName: string);

    /// <summary>Îçâó÷èòü òåêñò âûáðàííîé ìîäåëüþ</summary>
    procedure TextToSpeech(const aText: string; isDeleteFile: Boolean = False);

    property OnPlayFinished: TPlayFinishedEvent read FOnPlayFinished write FOnPlayFinished;
  end;

implementation

procedure TTTS.DoPlayFinished;
begin
  if Assigned(FOnPlayFinished) then
    FOnPlayFinished(Self);
end;

constructor TTTS.Create(const APiperExePath, AVoicesFolder: string);
begin
  inherited Create;
  FPiperExePath := APiperExePath;
  FVoicesFolder := AVoicesFolder;
  FCurrentModel := ''; // Ïîêà íå âûáðàíà ìîäåëü
end;

function TTTS.GetModelsList: TStringList;
var
  SR: TSearchRec;
begin
  Result := TStringList.Create;
  if not DirectoryExists(FVoicesFolder) then Exit;
  if FindFirst(FVoicesFolder + PathDelim + '*.onnx', faAnyFile, SR) = 0 then
  begin
    repeat
      Result.Add(SR.Name);
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

procedure TTTS.SetModel(const ModelFileName: string);
var
  FullPath: string;
begin
  FullPath := IncludeTrailingPathDelimiter(FVoicesFolder) + ModelFileName;
  if not FileExists(FullPath) then
    raise Exception.CreateFmt('Ìîäåëü íå íàéäåíà: %s', [FullPath]);
  FCurrentModel := FullPath;
end;

function TTTS.RunProcessCaptureOutput(const Exe, Args, InputText: string; out OutputText: string): Boolean;
var
  SecAttr: TSecurityAttributes;
  StdOutRead, StdOutWrite: THandle;
  StdInRead, StdInWrite: THandle;
  StartupInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  Buffer: array [0..4095] of AnsiChar;
  BytesRead: Cardinal;
  ReadOK: BOOL;
  Stream: TStringStream;
  InheritHandles: Boolean;
  BytesWritten: Cardinal;
  Utf8Bytes: TBytes;
begin
  Result := False;
  OutputText := '';
  Stream := TStringStream.Create('', TEncoding.UTF8);
  try
    SecAttr.nLength := SizeOf(SecAttr);
    SecAttr.bInheritHandle := True;
    SecAttr.lpSecurityDescriptor := nil;

    if not CreatePipe(StdOutRead, StdOutWrite, @SecAttr, 0) then Exit;
    try
      if not SetHandleInformation(StdOutRead, HANDLE_FLAG_INHERIT, 0) then Exit;

      if not CreatePipe(StdInRead, StdInWrite, @SecAttr, 0) then Exit;
      try
        if not SetHandleInformation(StdInWrite, HANDLE_FLAG_INHERIT, 0) then Exit;

        ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
        StartupInfo.cb := SizeOf(StartupInfo);
        StartupInfo.hStdOutput := StdOutWrite;
        StartupInfo.hStdError := StdOutWrite;
        StartupInfo.hStdInput := StdInRead;
        StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        StartupInfo.wShowWindow := SW_HIDE;

        InheritHandles := True;

        if not CreateProcess(PChar(Exe), PChar('"' + Exe + '" ' + Args), nil, nil,
          InheritHandles, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcInfo) then Exit;

        CloseHandle(StdOutWrite);
        CloseHandle(StdInRead);

        if InputText <> '' then
        begin
          Utf8Bytes := TEncoding.UTF8.GetBytes(InputText + #10);
          WriteFile(StdInWrite, Utf8Bytes[0], Length(Utf8Bytes), BytesWritten, nil);
        end;
        CloseHandle(StdInWrite);

        repeat
          ReadOK := ReadFile(StdOutRead, Buffer, SizeOf(Buffer), BytesRead, nil);
          if ReadOK and (BytesRead > 0) then
            Stream.Write(Buffer, BytesRead);
        until not ReadOK or (BytesRead = 0);

        WaitForSingleObject(ProcInfo.hProcess, INFINITE);

        CloseHandle(ProcInfo.hThread);
        CloseHandle(ProcInfo.hProcess);

        OutputText := Stream.DataString;
        Result := True;
      finally
        CloseHandle(StdInWrite);
        CloseHandle(StdInRead);
      end;
    finally
      CloseHandle(StdOutRead);
      CloseHandle(StdOutWrite);
    end;
  finally
    Stream.Free;
  end;
end;

procedure TTTS.TextToSpeech(const aText: string; isDeleteFile: Boolean);
var
  Args, Text, Output, WavFile: string;
  Lines: TStringList;
  i: Integer;
begin
  if (FPiperExePath = '') or (FCurrentModel = '') then
    raise Exception.Create('Piper.exe èëè ìîäåëü íå óêàçàíû.');

  Text := Trim(aText);
  if Text = '' then Exit;

  // Ôîðìèðóåì àðãóìåíòû - ïóñòü Piper ñîõðàíÿåò wav â òåêóùóþ ïàïêó ñ óíèêàëüíûì èìåíåì
  Args := '--model "' + FCurrentModel + '" -f o.wav';

  if not RunProcessCaptureOutput(FPiperExePath, Args, Text, Output) then
  begin

    Exit;
  end;

  Lines := TStringList.Create;
  try
    Lines.Text := Output;
    WavFile := '';
    for i := Lines.Count - 1 downto 0 do
      if (Pos('.wav', LowerCase(Lines[i])) > 0) and FileExists(Trim(Lines[i])) then
      begin
        WavFile := Trim(Lines[i]);
        Break;
      end;

    if WavFile <> '' then
    begin
     // Çàïóñêàåì â îòäåëüíîì ïîòîêå, ÷òîáû îòñëåäèòü îêîí÷àíèå
    TThread.CreateAnonymousThread(
      procedure
      begin
        PlaySound(PChar(WavFile), 0, SND_FILENAME); // áåç SND_ASYNC — æä¸ì îêîí÷àíèÿ
        if isDeleteFile then
          DeleteFile(WavFile);
        TThread.Synchronize(nil,
          procedure
          begin
            DoPlayFinished;
          end
        );
      end
    ).Start;
    end;

  finally
    Lines.Free;
  end;
end;

end.