doublecmd/src/un_process.pas

unit un_process;

{$mode delphi}{$H+}

interface

uses
  Process, SysUtils;
 
type

  TOnReadLn = procedure (str: String) of object;
  TOnOperationProgress = procedure of object;
  
  { TExProcess }

  TExProcess = class
  protected
    FProcess: TProcess;
    FOutputLine: String;
    FStop: Boolean;
    FQueryString: String;
    FOnReadLn,
    FOnQueryString: TOnReadLn;
    FOnOperationProgress: TOnOperationProgress;
    function _GetExitStatus(): Integer;
  public
    constructor Create(CommandLine: String = '');
    procedure Execute;
    procedure Stop;
    procedure SetCmdLine(CommandLine: String);
    destructor Destroy; override;

    property Process: TProcess read FProcess;
    property ExitStatus: Integer read _GetExitStatus;
    property QueryString: String read FQueryString write FQueryString;
    property OnReadLn: TOnReadLn read FOnReadLn write FOnReadLn;
    property OnQueryString: TOnReadLn read FOnQueryString write FOnQueryString;
    property OnOperationProgress: TOnOperationProgress read FOnOperationProgress write FOnOperationProgress;
  end;

implementation

const
  BufferSize = 3000;

function GetNextLine(const Value: String; var S: String; var N: Integer): Boolean;
var
  PS: PChar;
  IP, L, P, K: Integer;
begin
  P:= N;
  S:= '';
  Result:= False;
  L:= Length(Value);
  if ((L - P) < 0) then Exit;
  if ((L - P) = 0) and (not (Value[P] in [#10, #13])) then Exit;
  PS:= PChar(Value) + P - 1;
  IP:= P;
  while ((L - P) >= 0) and (not (PS^ in [#10, #13])) do
  begin
    P:= P + 1;
    Inc(PS);
  end;
  K:= P;
  // Point to character after #13
  if (P <= L) and (Value[P] = #13) then
  begin
    Inc(P);
    Result:= True;
  end;
  // Point to character after #10
  if (P <= L) and (Value[P] = #10) then
  begin
    Inc(P);
    Result:= True;
  end;
  if Result then
  begin
    N:= P;
    SetLength(S, K - IP);
    System.Move(Value[IP], Pointer(S)^, K - IP);
  end;
end;

{ TExProcess }

function TExProcess._GetExitStatus(): Integer;
begin
  Result:= FProcess.ExitStatus;
end;

constructor TExProcess.Create(CommandLine: String = '');
begin
  FOutputLine:= EmptyStr;
  FProcess:= TProcess.Create(nil);
  FProcess.CommandLine:= CommandLine;
  FProcess.Options:= [poUsePipes, poNoConsole];
end;

procedure TExProcess.Execute;
var
  P: Integer;
  S, OutputBuffer: String;
begin
  S:= EmptyStr;
  FProcess.Execute;
  repeat
    if Assigned(FOnOperationProgress) then
      FOnOperationProgress();
    if FStop then Exit;
    // If no output yet
    if FProcess.Output.NumBytesAvailable = 0 then
    begin
      if not FProcess.Running then
        Break
      else
        begin
          Sleep(1);
          if Assigned(FOnQueryString) and (FProcess.Stderr.NumBytesAvailable > 0) then
          begin
            SetLength(OutputBuffer, BufferSize);
            // Waits for the process output
            SetLength(OutputBuffer, FProcess.Stderr.Read(OutputBuffer[1], Length(OutputBuffer)));
            if (Pos(FQueryString, OutputBuffer) > 0) then FOnQueryString(OutputBuffer);
            OutputBuffer:= EmptyStr;
          end;
          Continue;
        end
    end;
    SetLength(OutputBuffer, BufferSize);
    // Waits for the process output
    SetLength(OutputBuffer, FProcess.Output.Read(OutputBuffer[1], Length(OutputBuffer)));
    // Cut the incoming stream to lines:
    FOutputLine:= FOutputLine + OutputBuffer; // Add to the accumulator
    P:= 1;
    while GetNextLine(FOutputLine, S, P) do
    begin
      if FStop then Exit;
      // Return the line without the CR/LF characters
      if Assigned(FOnReadLn) then FOnReadLn(S);
      // Update progress
      if Assigned(FOnOperationProgress) then FOnOperationProgress();
    end;
    // Remove the processed lines from accumulator
    Delete(FOutputLine, 1, P - 1);
    // Check query string
    if Length(FOutputLine) > 0 then
    begin
      if Assigned(FOnQueryString) and (Pos(FQueryString, FOutputLine) <> 0) then
      begin
        FOnQueryString(FOutputLine);
        FOutputLine:= EmptyStr;
      end;
    end;
    // No more data, break
    if Length(OutputBuffer) = 0 then Break;
  until False;
  if FStop then Exit;
  if (Length(FOutputLine) <> 0) and Assigned(FOnReadLn) then
    FOnReadLn(FOutputLine);
  OutputBuffer:= EmptyStr;
  if Assigned(FOnReadLn) then
    FOnReadLn(OutputBuffer); // Empty line to notify DC about process finish
end;

procedure TExProcess.Stop;
begin
  FStop:= True;
  FProcess.Terminate(-1);
end;

procedure TExProcess.SetCmdLine(CommandLine: String);
begin
  FProcess.CommandLine:= CommandLine;
end;

destructor TExProcess.Destroy;
begin
  FreeAndNil(FProcess);
end;

end.