Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: UnitRedirect.pas Sprache: Delphi

unit UnitRedirect;
// This is an example application to demonstrate the use of pipes
// to redirect the input/output of a console application.
// The function "Sto_RedirectedExecute" was written by Martin Stoeckli
// and is part of the site:
//   http://www.martinstoeckli.ch/delphi/
//

interface
uses Windows, Classes;

  /// <summary>
  ///   Runs a console application and captures the stdoutput and
  ///   stderror.</summary>
  /// <param name="CmdLine">The commandline contains the full path to
  ///   the executable and the necessary parameters. Don't forget to
  ///   quote filenames with "" if the path contains spaces.</param>
  /// <param name="Output">Receives the console stdoutput.</param>
  /// <param name="Error">Receives the console stderror.</param>
  /// <param name="Input">Send to stdinput of the process.</param>
  /// <param name="Wait">[milliseconds] Maximum of time to wait,
  ///   until application has finished. After reaching this timeout,
  ///   the application will be terminated and False is returned as
  ///   result.</param>
  /// <returns>True if process could be started and did not reach the
  ///   timeout.</returns>
  function Sto_RedirectedExecute(const CmdLine: String;
    var Output, Error: String; const Input: String = '';
    const Wait: DWORD = 3600000): Boolean;

implementation

type
  TStoReadPipeThread = class(TThread)
  protected
    FPipe: THandle;
    FContent: TStringStream;
    function Get_Content: String;
    procedure Execute; override;
  public
    constructor Create(const Pipe: THandle);
    destructor Destroy; override;
    property Content: String read Get_Content;
  end;

  TStoWritePipeThread = class(TThread)
  protected
    FPipe: THandle;
    FContent: TStringStream;
    procedure Execute; override;
  public
    constructor Create(const Pipe: THandle; const Content: String);
    destructor Destroy; override;
  end;

constructor TStoReadPipeThread.Create(const Pipe: THandle);
begin
  FPipe := Pipe;
  FContent := TStringStream.Create('');
  inherited Create(True);
end;

destructor TStoReadPipeThread.Destroy;
begin
  FContent.Free;
  inherited Destroy;
end;

procedure TStoReadPipeThread.Execute;
const
  BLOCK_SIZE = 4096;
var
  iBytesRead: DWORD;
  myBuffer: array[0..BLOCK_SIZE-1] of Byte;
begin
  repeat
    // try to read from pipe
    if ReadFile(FPipe, myBuffer, BLOCK_SIZE, iBytesRead, nil) then
      FContent.Write(myBuffer, iBytesRead);
  // a process may write less than BLOCK_SIZE, even if not at the end
  // of the output, so checking for < BLOCK_SIZE would block the pipe.
  until (iBytesRead = 0);
end;

function TStoReadPipeThread.Get_Content: String;
begin
  Result := FContent.DataString;
end;

{ TStoWritePipeThread }

constructor TStoWritePipeThread.Create(const Pipe: THandle;
  const Content: String);
begin
  FPipe := Pipe;
  FContent := TStringStream.Create(Content);
  inherited Create(True);
end;

destructor TStoWritePipeThread.Destroy;
begin
  if (FPipe <> 0) then
    CloseHandle(FPipe);
  FContent.Free;
  inherited Destroy;
end;

procedure TStoWritePipeThread.Execute;
const
  BLOCK_SIZE = 4096;
var
  iBytesToWrite: DWORD;
  iBytesWritten: DWORD;
  myBuffer: array[0..BLOCK_SIZE-1] of Byte;
begin
  iBytesToWrite := FContent.Read(myBuffer, BLOCK_SIZE);
  while (iBytesToWrite > 0) do
  begin
    WriteFile(FPipe, myBuffer, iBytesToWrite, iBytesWritten, nil);
    iBytesToWrite := FContent.Read(myBuffer, BLOCK_SIZE);
  end;
  // close our handle to let the other process know, that
  // there won't be any more data.
  CloseHandle(FPipe);
  FPipe := 0;
end;

function Sto_RedirectedExecute(const CmdLine: String;
  var Output, Error: String; const Input: String = '';
  const Wait: DWORD = 3600000): Boolean;
var
  mySecurityAttributes: SECURITY_ATTRIBUTES;
  myStartupInfo: STARTUPINFO;
  myProcessInfo: PROCESS_INFORMATION;
  hPipeInputRead, hPipeInputWrite: THandle;
  hPipeOutputRead, hPipeOutputWrite: THandle;
  hPipeErrorRead, hPipeErrorWrite: THandle;
  myWriteInputThread: TStoWritePipeThread;
  myReadOutputThread: TStoReadPipeThread;
  myReadErrorThread: TStoReadPipeThread;
  iWaitRes: Integer;
  sCmdLine: String;
begin
  // prepare security structure
  ZeroMemory(@mySecurityAttributes, SizeOf(SECURITY_ATTRIBUTES));
  mySecurityAttributes.nLength := SizeOf(SECURITY_ATTRIBUTES);
  mySecurityAttributes.bInheritHandle := TRUE;
  // create pipe to set stdinput
  hPipeInputRead := 0;
  hPipeInputWrite := 0;
  if (Input <> '') then
    CreatePipe(hPipeInputRead, hPipeInputWrite, @mySecurityAttributes, 0);
  // create pipes to get stdoutput and stderror
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @mySecurityAttributes, 0);
  CreatePipe(hPipeErrorRead, hPipeErrorWrite, @mySecurityAttributes, 0);

  // prepare startupinfo structure
  ZeroMemory(@myStartupInfo, SizeOf(STARTUPINFO));
  myStartupInfo.cb := Sizeof(STARTUPINFO);
  // hide application
  myStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  myStartupInfo.wShowWindow := SW_HIDE;
  // assign pipes
  myStartupInfo.dwFlags := myStartupInfo.dwFlags or STARTF_USESTDHANDLES;
  myStartupInfo.hStdInput := hPipeInputRead;
  myStartupInfo.hStdOutput := hPipeOutputWrite;
  myStartupInfo.hStdError := hPipeErrorWrite;

  // since CreateProcess can map to the unicode version
  // "CreateProcessW" we cannot pass a literal string anymore.
  sCmdLine := CmdLine;
  UniqueString(sCmdLine);
  // start the process
  Result := CreateProcess(nil, PChar(sCmdLine), nil, nil, True,
    CREATE_NEW_CONSOLE, nil, nil, myStartupInfo, myProcessInfo);
  // close the ends of the pipes, now used by the process
  CloseHandle(hPipeInputRead);
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeErrorWrite);

  // could process be started ?
  if Result then
  begin
    myWriteInputThread := nil;
    if (hPipeInputWrite <> 0) then
      myWriteInputThread := TStoWritePipeThread.Create(hPipeInputWrite, Input);
    myReadOutputThread := TStoReadPipeThread.Create(hPipeOutputRead);
    myReadErrorThread := TStoReadPipeThread.Create(hPipeErrorRead);
    try
    // start threads for reading the output pipes
    if (myWriteInputThread <> nil) then
      myWriteInputThread.Execute;
    myReadOutputThread.Execute;
    myReadErrorThread.Execute;
    // wait unitl there is no more data to receive, or the timeout is reached
    iWaitRes := WaitForSingleObject(myProcessInfo.hProcess, Wait);
    // timeout reached ?
    if (iWaitRes = WAIT_TIMEOUT) then
    begin
      Result := False;
      TerminateProcess(myProcessInfo.hProcess, UINT(ERROR_CANCELLED));
    end;
    // return output
    Output := myReadOutputThread.Content;
    Error := myReadErrorThread.Content;
    finally
      myWriteInputThread.Free;
      myReadOutputThread.Free;
      myReadErrorThread.Free;
      CloseHandle(myProcessInfo.hThread);
      CloseHandle(myProcessInfo.hProcess);
    end;
  end;
  // close our ends of the pipes
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorRead);
end;

end.

¤ Dauer der Verarbeitung: 0.1 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.