textprocessunit.pas

CVS IDE plugin for Borland Delphi this is a good program,i like this kind of practise

(* $Id: TExtProcessunit.pas,v 1.3 2002/12/24 09:15:54 turbo Exp $
 *
 * Class for executing an external process, with support for accessing
 * stdout and stderr from that process
 *
 * Copyright 2001 by Thomas Bleier
 * For license details see LICENSE.txt
 *)

unit TExtProcessunit;
{$I BORCVS.inc}
interface
uses
  windows,
  Classes;

type
  TExtProcessMode = (epmSeparate, epmPlainText, epmRichText);
type
  PFoundStringFlag = ^TFoundStringFlag;
  TFoundStringFlag = (fsfNone, fsfPassword);

type
  TOutPipeThread = class(TThread)
  private
  protected
    FData: string;
    FPipeHandle: THANDLE;
    FOutCtrlHandle: HWND;
    FPFoundStringFlag: PFoundStringFlag;
    procedure Execute; override;
  public
    constructor create(ahandle: THANDLE; found_string_flag: PFoundStringFlag; outctrlhandle: HWND);
    property GetData: string read FData;
  end;

type
  TExtProcess = class(TThread)
  protected
    FOutThread, FErrThread: TOutPipeThread;
    FStdOutputResult, FStdErrorResult: string;
    FAppname, FCmdline, FWorkdir: string;
    FExceptionText: string;
    FMode: TExtProcessMode;
    FDone, FExecuted, FNtCvs: boolean;
    FExitCode: DWORD;
    FStdinHandle: THANDLE;
    FOutCtrlHandle: HWND;
    FFoundStringFlag: TFoundStringFlag;
    procedure Execute; override;
    procedure QueryUserInput;
    function GetStdOutput: string;
    function GetStdError: string;
    procedure ShowExceptionText;
  public
  (* appname: the path to the executable to be executed
   * cmdline: the command-line to be executed
   * workdir: the directory where the application should be started
   * mode: mode for standard output and error. epmSeparate give two separate
   *   Strings, epmPlainText gives one String with both results and
   *   epmRichText gives one String with RichText format, where stderr is
   *   colored red
   *)
    constructor create(appname: string; cmdline: string; workdir: string;
      mode: TExtProcessMode; isNtCvs: boolean; outctrlhandle: HWND);
    destructor destroy; override;
    property StdOutput: string read GetStdOutput;
    property StdError: string read GetStdError;
    property ExitCode: DWORD read FExitCode;
    property Executed: boolean read FExecuted;
    property Done: boolean read FDone;
  end;

implementation
uses
  messages,
  forms,
  dialogs,
  Sysutils,
//  PELDebugit,
  UtilityUnit;
// assert.h>

//---------------------------------------------------------------------------
// TOutPipeThread
//---------------------------------------------------------------------------
// check if all Win32 function results are checked, use RaiseLastWin32Error...
// Mode epmRichText not supported yet
const
  DPIPEBUFFERSIZE = 1024;
////---------------------------------------------------------------------------
//

constructor TExtProcess.create(appname, cmdline, workdir: string;
  mode: TExtProcessMode; isNtCvs: boolean; outctrlhandle: HWND);
begin
  inherited create(false);
  FreeOnTerminate := true;
  FDone := false;
  FExecuted := false;
  FExitCode := $FFFF;
  FStdinHandle := 0;
  FOutCtrlHandle := outctrlhandle;
  FAppname := appname;
  FCmdline := cmdline;
  FWorkdir := workdir;
  FMode := mode;
  FNtCvs := isNtCvs;
  FOutThread := nil;
  FErrThread := nil;
  Resume;
end;

destructor TExtProcess.destroy;
begin
  inherited Destroy;
end;

procedure TExtProcess.Execute;
var
  si: STARTUPINFO;
  pi: PROCESS_INFORMATION;
  sa: SECURITY_ATTRIBUTES;
  hOutRd, hOutWr, hErrRd, hErrWr, hInRd, hInWr: THANDLE;
  command: string;
  ap, wd, cmd: pchar;
begin
  try
    hOutRd := 0;
    hOutWr := 0;
    hErrRd := 0;
    hErrWr := 0;
    hInRd := 0;
    hInWr := 0;
    FFoundStringFlag := fsfNone;
    ZeroMemory(@si, sizeof(si));
    ZeroMemory(@pi, sizeof(pi));
    ZeroMemory(@sa, sizeof(sa));
    FStdinHandle := 0;
    try
      // initialize security attributes for creating pipes
      sa.nLength := sizeof(sa);
      sa.bInheritHandle := true;
      sa.lpSecurityDescriptor := nil;
      if (not CreatePipe(hOutRd, hOutWr, @sa, DPIPEBUFFERSIZE)) then
      begin
        raise Exception.Create('Error creating pipe(stdout)!');
      end;
      if (not CreatePipe(hErrRd, hErrWr, @sa, DPIPEBUFFERSIZE)) then
      begin
        raise Exception.Create('Error creating pipe(stderr)!');
      end;
      if (not CreatePipe(hInRd, hInWr, @sa, DPIPEBUFFERSIZE)) then
      begin
        raise Exception.Create('Error creating pipe(stdin)!');
      end;
      si.cb := sizeof(si);
      si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      si.wShowWindow := SW_HIDE;
      si.hStdInput := hInRd;
      si.hStdOutput := hOutWr;
      if (FMode = epmSeparate) then
      begin
        si.hStdError := hErrWr;
      end
      else
      begin
        si.hStdError := hOutWr;
      end;
      // Duplicate the stdin handle for the child, to get a non-inherited handle
      if (not DuplicateHandle(GetCurrentProcess, hInWr, GetCurrentProcess,
        @FStdinHandle, 0, false, DUPLICATE_SAME_ACCESS)) then
      begin
        RaiseLastOSError;
      end;
      // close the inheritable write end of the stdin handle
      CloseHandle(hInWr);
      hInWr := 0;
      // create the threads for stdout/stderr processing
      FOutThread := TOutPipeThread.create(hOutRd, @FFoundStringFlag,
        FOutCtrlHandle);
      if (FMode = epmSeparate) then
      begin
        FErrThread := TOutPipeThread.create(hErrRd, @FFoundStringFlag,
          FOutCtrlHandle);
      end;
      try
        ap := nil;
        command := trim(FAppname + ' ' + FCmdline);
        cmd := pchar(command);
        wd := pchar(FWorkdir);
        if (CreateProcess(ap, cmd, nil, nil, true,
          CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or
          CREATE_NO_WINDOW or
          NORMAL_PRIORITY_CLASS, nil, wd, si, pi)) then
        begin
          // After the thread is created, close all unnecessary handles
          CloseHandle(pi.hThread);
          CloseHandle(hOutWr);
          hOutWr := 0;
          CloseHandle(hErrWr);
          hErrWr := 0;
          CloseHandle(hInRd);
          hInRd := 0;
          WaitForInputIdle(pi.hProcess, INFINITE);
          // Now wait until the process terminates or the user terminated us
          while (not Terminated) and
            (WaitForSingleObject(pi.hProcess, 200) = WAIT_TIMEOUT) do
          begin
            if ((FFoundStringFlag <> fsfNone) and FNtCvs) then
            begin
              Synchronize(QueryUserInput);
              FFoundStringFlag := fsfNone;
            end;
          end;
          // If the user terminated, kill the process
          if (Terminated) then
          begin
            TerminateProcess(pi.hProcess, $FFFE);
          end;
          if (not GetExitCodeProcess(pi.hProcess, FExitCode)) then
          begin
            FExitCode := $FFFD;
          end;
          CloseHandle(pi.hProcess);
          FExecuted := true;
        end
        else
        begin
          RaiseLastOSError;
        end;
      finally
        FOutThread.WaitFor;
        FStdOutputResult := FOutThread.GetData;
        FOutThread.Free;
        FOutThread := nil;
        if assigned(FErrThread) then
        begin
          FErrThread.WaitFor;
          FStdErrorResult := FErrThread.GetData;
          FErrThread.Free;
          FErrThread := nil;
        end;
      end;
    finally
      if (hOutRd) <> 0 then
        CloseHandle(hOutRd);
      if (hOutWr) <> 0 then
        CloseHandle(hOutWr);
      if (hErrRd) <> 0 then
        CloseHandle(hErrRd);
      if (hErrWr) <> 0 then
        CloseHandle(hErrWr);
      if (hInRd) <> 0 then
        CloseHandle(hInRd);
      if (hInWr) <> 0 then
        CloseHandle(hInWr);
      if (FStdinHandle) <> 0 then
        CloseHandle(FStdinHandle);
      FDone := true;
    end;
  except
    on e: Exception do
    begin
      FExceptionText := e.Message;
      Synchronize(ShowExceptionText);
      FDone := true;
    end;
  end;
end;

function TExtProcess.GetStdError: string;
begin
  if assigned(FErrThread) then
  begin
    result := FErrThread.GetData;
  end
  else
  begin
    result := FStdErrorResult;
  end;
end;

function TExtProcess.GetStdOutput: string;
begin
  if assigned(FOutThread) then
  begin
    result := FOutThread.GetData;
  end
  else
  begin
    result := FStdOutputResult;
  end;
end;

procedure TExtProcess.QueryUserInput;
var
  inputstr: string;
  written, len: DWORD;

begin
  try
    case FFoundStringFlag of
      fsfPassword:
        begin
          inputstr := InputBox('CVS password', 'Enter password: ', '');
        end;
    else
      assert(false);
    end;
    inputstr := inputstr + '\r';
    written := 0;
    len := Length(inputstr);
    if WriteFile(FStdinHandle, inputstr[1], len, written, nil) or
      (written <> len) then
    begin
      RaiseLastOSError;
    end;
    if (not FlushFileBuffers(FStdinHandle)) then
    begin
      RaiseLastOSError;
    end;
  except
    on e: Exception do
      Application.ShowException(e);
  end;
end;

procedure TExtProcess.ShowExceptionText;
begin
  ShowMessage(FExceptionText);
end;

{ TOutPipeThread }

constructor TOutPipeThread.create(ahandle: THANDLE;
  found_string_flag: PFoundStringFlag; outctrlhandle: HWND);
begin
  inherited create(false);
  FPipeHandle := ahandle;
  FOutCtrlHandle := outctrlhandle;
  FPFoundStringFlag := found_string_flag;
  FreeOnTerminate := false;
  Priority := tpHighest;
  Resume;
end;

procedure TOutPipeThread.Execute;
var
  FBytesRead: DWORD;
  FBuffer: array[0..DPIPEBUFFERSIZE - 1] of char;
  Newst: string;
begin
  while (not Terminated) do
  begin
    if (ReadFile(FPipeHandle, FBuffer, DPIPEBUFFERSIZE, FBytesRead, nil)) then
    begin
      NewSt := Copy(string(FBuffer), 1, FBytesRead);
      FData := FData + Newst;
      if (FOutCtrlHandle <> 0) then
      begin
        SendMessage(FOutCtrlHandle, EM_SETSEL, -1, 0);
        SendMessage(FOutCtrlHandle, EM_REPLACESEL, 0, longint(pchar(Newst)));
        SendMessage(FOutCtrlHandle, EM_SCROLLCARET, 0, 0);
      end;
      // find better method for detecting when CVS wants input...
      if (Newst = 'CVS password: ') then
      begin
        FPFoundStringFlag^ := fsfPassword;
      end;
    end
    else
    begin
      Terminate;
    end;
  end;
end;

end.