Quelle Command.pas Sprache: Delphi

unit Command;

interface

uses
//----------------------------------------------------------------------------
//   global
//----------------------------------------------------------------------------
Windows, Classes;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
function Sto_RedirectedExecute(const CmdLine: String;
  var Output, Error: 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;

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

destructor TStoReadPipeThread.Destroy;
begin
  FContent.Free;
  inherited Free;
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;

/// <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="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 Wait: DWORD = 3600000): Boolean;
var
  mySecurityAttributes: SECURITY_ATTRIBUTES;
  myStartupInfo: STARTUPINFO;
  myProcessInfo: PROCESS_INFORMATION;
  hPipeOutputRead, hPipeOutputWrite: THandle;
  hPipeErrorRead, hPipeErrorWrite: THandle;
  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 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 := 0;
  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(hPipeOutputWrite);
  CloseHandle(hPipeErrorWrite);

  // could process be started ?
  if Result then
  begin
    myReadOutputThread := TStoReadPipeThread.Create(hPipeOutputRead);
    myReadErrorThread := TStoReadPipeThread.Create(hPipeErrorRead);
    try
    // start threads for reading the output pipes
    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
      myReadOutputThread.Free;
      myReadErrorThread.Free;
      CloseHandle(myProcessInfo.hThread);
      CloseHandle(myProcessInfo.hProcess);
    end;
  end;
  // close our ends of the pipes
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorRead);
end;

end.

quality93%

¤ Dauer der Verarbeitung: 0.1 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

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.