Thema: IsConsole?

Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
40.763 Beiträge
 
Delphi 11 Alexandria
 
#4

AW: IsConsole?

  Alt 21. Mär 2016, 08:22
"IAm" .. Nicht von mir, sondern von dem Anderen, dessen Handle ich habe.
Aber insgesamt wollte ich den Code recht "einfach" halten und externe Hooks sprechen eigentlich dagegen.

Ich bin dabei mal wieder ein paar alte Codes zu überarbeiten/moderniesieren.
Und hab nun meine alte "ShellExecuteAndWait"-Variante nun am Wickel.
Also erstmal in eine neue Funktion verpackt und mit dem Erweitert, was ich inzwischen vermisst hatte.
(eventuell wird es am Ende nochmal umgepackt, so dass man den Code in etwa als ExecuteProcess('böse.exe').Params('-a=666').SetInput('Test').GetOutput(Result).RunAndWait; aufrufen kann)

Vor allem Wait, CloseProcess und ExecuteProcess>WaitForInputIdle muß halt noch verifiziert werden.
Delphi-Quellcode:
type
  TExecuteHandle = (ehInput, ehOutput, ehError);
  TExecuteHandles = (ehNoHandles, ehAllHandles, ehNoErrorHandle, ehOnlyInputHandle);
  PExecuteControl = ^TExecuteControl;
  TExecuteControl = record
    ProcessID: LongWord;
    Process: THandle;
    MainThreadID: LongWord;
    MainThread: THandle;
    /// <summary>Local for Write/WriteLn/WriteBytes</summary>
    InputHandler: THandle;
    /// <summary>External for new Process</summary>
    Input: THandle;
    /// <summary>Local for Read/ReadLn/ReadBytes</summary>
    OutputHandler: THandle;
    /// <summary>External for new Process</summary>
    Output: THandle;
    /// <summary>Cache for Read Functions</summary>
    OutputCache: TBytes;
    /// <summary>Local for ReadError</summary>
    ErrorOutputHandler: THandle;
    /// <summary>External for new Process</summary>
    ErrorOutput: THandle;
    /// <summary>Exit Code or Error Code from Startup</summary>
    ExitCode: LongWord;
    procedure Initialize(Handles: TExecuteHandles=ehNoHandles; InputFile: string=''; OutputFile: string='');
    procedure Write (S: string);
    procedure WriteLn (S: string);
    procedure WriteBytes(B: TBytes);
    function Read (Count: Integer=-1): string;
    function ReadWord: string;
    function ReadLn: string;
    function ReadBytes (Count: Integer=-1): TBytes;
    function ReadError: string;
    function RunTime: TDateTime;
    function RunTimeCPU: TDateTime;
    function RunTimeKernel: TDateTime;
    function IsRunning: Boolean;
    function Wait(Timeout: LongWord=60 {; OtherSignal: THandle=0}): Boolean;
    /// <summary>Close Handles</summary>
    /// <returns>Process Exit Code if Process is terminated</returns>
    function CloseHandles: HRESULT;
    /// <summary>Send WM_QUIT or Ctrl+C to Console</summary>
    procedure CloseProcess(Timeout: LongWord=30);
    /// <summary>Kill the Process</summary>
    procedure TerminateProcess;

    procedure CreateLocalHandle (Handle: TExecuteHandle);
    procedure CreateFileHandle (Handle: TExecuteHandle; Filename: string);
    procedure CreateDuplicateHandle(Handle: TExecuteHandle=ehError);
    procedure SetStandardHandle (Handle: TExecuteHandle);
    procedure FreeHandle (Handle: TExecuteHandle);
    function IsHandleAssigned (Handle: TExecuteHandle; CheckHandler: Boolean=True): Boolean;
  private
    procedure DoRead(var B: TBytes; H: THandle; Name: string);
  end;

/// <summary>Find Process by FileName (without directory)</summary>
function FindProcess (Executable: string): LongWord;
/// <summary>ExecuteAndWait: Execute Process + Wait for Termination and get Output</summary>
function ExecuteProcess(Executable: string; Parameters: string=''; Input: string=''; Output: PString=nil;
  ProcessID: PLongWord=nil; Control: PExecuteControl=nil; Timeout: LongWord=INFINITE;
  HideWindow: Boolean=False; ConsoleTitle: string=''; WindowPosition: PSize=nil; WindowSize: PSize=nil): HRESULT;
Delphi-Quellcode:
function FindProcess(Executable: string): LongWord;
var
  Snapshot: THandle;
  Entry32: TProcessEntry32;
begin
  Result := 0;
  Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  Entry32.dwSize := SizeOf(Entry32);
  if Process32First(Snapshot, Entry32) then
    repeat
      if AnsiSameText(ExtractFileName(Entry32.szExeFile), Executable) then begin
        Result := Entry32.th32ProcessID;
        Break;
      end;
    until not Process32Next(Snapshot, Entry32);
  CloseHandle(Snapshot);
end;

function ExecuteProcess(Executable: string; Parameters, Input: string; Output: PString;
  ProcessID: PLongWord; Control: PExecuteControl; Timeout: LongWord;
  HideWindow: Boolean; ConsoleTitle: string; WindowPosition: PSize; WindowSize: PSize): HRESULT;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  Application: string;
  CommandLine: string;
  CurrControl: TExecuteControl;
begin
  if Assigned(Output) then
    Output^ := '';
  if Assigned(ProcessID) then
    ProcessID^ := 0;
  CurrControl.Initialize;
  try
    if Assigned(Control) then begin
      CurrControl.InputHandler := Control.InputHandler;
      CurrControl.Input := Control.Input;
      CurrControl.OutputHandler := Control.OutputHandler;
      CurrControl.Output := Control.Output;
      CurrControl.ErrorOutputHandler := Control.ErrorOutputHandler;
      CurrControl.ErrorOutput := Control.ErrorOutput;
    end;
    if (Input <> '') and not CurrControl.IsHandleAssigned(ehInput, False) then
      CurrControl.CreateLocalHandle(ehInput);
    if CurrControl.IsHandleAssigned(ehInput, False) or CurrControl.IsHandleAssigned(ehOutput, False) or CurrControl.IsHandleAssigned(ehError, False) then begin
      if not CurrControl.IsHandleAssigned(ehInput, False) then
        CurrControl.SetStandardHandle(ehInput);
      if not CurrControl.IsHandleAssigned(ehOutput, False) then
        CurrControl.SetStandardHandle(ehOutput);
      if not CurrControl.IsHandleAssigned(ehError, False) then
        CurrControl.SetStandardHandle(ehError);
    end;

    FillChar(StartupInfo, SizeOf(StartupInfo), 0);
    StartupInfo.cb := SizeOf(StartupInfo);
    StartupInfo.lpTitle := Pointer(ConsoleTitle);
    if Assigned(WindowPosition) then begin
      StartupInfo.dwX := WindowPosition.cx;
      StartupInfo.dwY := WindowPosition.cy;
    end;
    if Assigned(WindowSize) then begin
      StartupInfo.dwXSize := WindowSize.cx;
      StartupInfo.dwYSize := WindowSize.cy;
    end;
    StartupInfo.wShowWindow := IfThen(HideWindow, SW_SHOWMINIMIZED, SW_SHOWNOACTIVATE);
    if CurrControl.IsHandleAssigned(ehInput, False) then begin
      StartupInfo.hStdInput := CurrControl.Input;
      StartupInfo.hStdOutput := CurrControl.Output;
      StartupInfo.hStdError := CurrControl.ErrorOutput;
    end;
    StartupInfo.dwFlags := STARTF_FORCEONFEEDBACK or STARTF_USESHOWWINDOW or IfThen(Assigned(WindowPosition), STARTF_USEPOSITION, 0)
      or IfThen(Assigned(WindowSize), STARTF_USESIZE, 0) or IfThen(CurrControl.IsHandleAssigned(ehInput, False), STARTF_USESTDHANDLES, 0);

    if Parameters <> 'then
      CommandLine := '"' + Executable + '" ' + Parameters + StringOfChar(#0, 32*1024)
    else
      Application := Executable;
    OutputDebugString(PChar('ExecuteAndWait: ' + CommandLine + Application + IfThen(Input <> '', ' << ' + Input, '')));
    if not CreateProcess(Pointer(Application), Pointer(CommandLine), nil, nil, StartupInfo.dwFlags and STARTF_USESTDHANDLES <> 0,
        CREATE_DEFAULT_ERROR_MODE or NORMAL_PRIORITY_CLASS or IfThen(HideWindow, CREATE_NO_WINDOW, CREATE_NEW_CONSOLE)
        or IfThen(SizeOf(Char) = 2, CREATE_UNICODE_ENVIRONMENT, 0), nil, PChar(ExtractFileDir(Executable)), StartupInfo, ProcessInfo) then
      RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.CreateProcess');

    CloseHandle(CurrControl.Input);
    CloseHandle(CurrControl.Output);
    if CurrControl.ErrorOutput <> CurrControl.Output then
      CloseHandle(CurrControl.ErrorOutput);
    CurrControl.Input := 0;
    CurrControl.Output := 0;
    CurrControl.ErrorOutput := 0;

    CurrControl.ProcessID := ProcessInfo.dwProcessId;
    CurrControl.Process := ProcessInfo.hProcess;
    CurrControl.MainThreadID := ProcessInfo.hThread;
    CurrControl.MainThread := ProcessInfo.dwThreadId;
    CurrControl.ExitCode := S_OK;

    if LongInt(Timeout) < 0 then
      Timeout := INFINITE;
    case WaitForInputIdle(CurrControl.Process, Timeout) of
      0: ;
      WAIT_TIMEOUT: RaiseLastOSError(WAIT_TIMEOUT, '.'#10'ExecuteAndWait.WaitForInputIdle');
      WAIT_FAILED: ;//RaiseLastOSError(554{ERROR_CANT_WAIT}, '.'#10'ExecuteAndWait.WaitForInputIdle');
      else RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.WaitForInputIdle');
    end;
    if Input <> 'then
      CurrControl.WriteLn(Input);
    if (Timeout > 0) and not Assigned(Control) then
      if not CurrControl.Wait(Timeout) then
        RaiseLastOSError(WAIT_TIMEOUT, '.'#10'ExecuteAndWait.Wait');

    if not Assigned(Control) then
      CurrControl.CloseHandles;
  except
    on E: EOSError do begin
      OutputDebugString(PChar('ExecuteAndWait.' + E.ClassName + '(' + E.ErrorCode.ToString + '): ' + E.Message));
      CurrControl.CloseHandles;
      CurrControl.ExitCode := E.ErrorCode;
      if Assigned(Control) then
        Control^ := CurrControl;
      raise;
    end;
    on E: Exception do begin
      OutputDebugString(PChar('ExecuteAndWait.' + E.ClassName + ': ' + E.Message));
      CurrControl.CloseHandles;
      CurrControl.ExitCode := S_FALSE;
      if Assigned(Control) then
        Control^ := CurrControl;
      raise;
    end;
  end;
  Result := CurrControl.ExitCode;
  if Assigned(Control) then
    Control^ := CurrControl;
  if Assigned(ProcessID) then
    ProcessID^ := CurrControl.ProcessID;
  if Assigned(Output) then begin
    Output^ := CurrControl.Read;
    if Assigned(Control) then
      SetLength(Control^.OutputCache, Length(Control^.OutputCache)); // make Unique (Output^ does not clear the Cache)
  end;
end;

{ TExecuteControl }


function TExecuteControl.CloseHandles: HRESULT;
begin
  if Process <> 0 then begin
    if IsHandleAssigned(ehOutput, True) then
      try DoRead(OutputCache, OutputHandler, ''); except end;
    if not GetExitCodeProcess(Process, ExitCode) then // ExitCode=STILL_ACTIVE if process is active
      ExitCode := ERROR_PROCESS_ABORTED;
  end;
  CloseHandle(Process);
  CloseHandle(MainThread);
  ProcessID := 0;
  Process := 0;
  MainThreadID := 0;
  MainThread := 0;
  FreeHandle(ehInput);
  FreeHandle(ehOutput);
  FreeHandle(ehError);
  Result := ExitCode;
end;

procedure TExecuteControl.CloseProcess(Timeout: LongWord);
begin
  if not IsRunning then
    Exit;
  if not PostThreadMessage(MainThreadID, WM_QUIT, 0, 0) then
    if GetLastError = ERROR_NOT_ENOUGH_QUOTA then begin
      if not GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT {CTRL_CLOSE_EVENT CTRL_C_EVENT}, ProcessID) then // for CTRL_C_EVENT use CreateProcess+CREATE_NEW_PROCESS_GROUP
        RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.CloseProcess');
    end else
      RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.CloseProcess');
  Wait(Timeout);
end;

procedure TExecuteControl.CreateDuplicateHandle(Handle: TExecuteHandle);
begin
  if Handle <> ehError then
    RaiseLastOSError(ERROR_INVALID_PARAMETER, '.'#10'ExecuteAndWait.CreateDuplicateHandle');
  FreeHandle(ehError);
  if Output = GetStdHandle(STD_OUTPUT_HANDLE) then
    Exit;
  if not IsHandleAssigned(ehOutput, False) then
    RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.CreateDuplicateHandle');
  if not DuplicateHandle(GetCurrentProcess, Output, GetCurrentProcess, @ErrorOutput, 0, True, DUPLICATE_SAME_ACCESS) then;
    RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.CreateDuplicateHandle');
  ErrorOutputHandler := OutputHandler;
end;

procedure TExecuteControl.CreateFileHandle(Handle: TExecuteHandle; Filename: string);
var
  S: TSecurityAttributes;
  H: THandle;
begin
  if Handle > ehError then
    RaiseLastOSError(ERROR_INVALID_PARAMETER, '.'#10'ExecuteAndWait.CreateFileHandle');
  FreeHandle(Handle);
  S.nLength := SizeOf(S);
  S.lpSecurityDescriptor := nil;
  S.bInheritHandle := True;
  H := CreateFile(PChar(Filename), IfThen(Handle = ehInput, GENERIC_READ, GENERIC_WRITE), FILE_SHARE_READ
    or FILE_SHARE_WRITE, @S, IfThen(Handle = ehInput, OPEN_EXISTING, CREATE_ALWAYS), FILE_ATTRIBUTE_NORMAL, 0);
  if H = INVALID_HANDLE_VALUE then
    RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.CreateFileHandle');
  case Handle of
    ehInput: Input := H;
    ehOutput: Output := H;
    ehError: ErrorOutput := H;
  end;
end;

procedure TExecuteControl.CreateLocalHandle(Handle: TExecuteHandle);
var
  S: TSecurityAttributes;
  B: Boolean;
begin
  if Handle > ehError then
    RaiseLastOSError(ERROR_INVALID_PARAMETER, '.'#10'ExecuteAndWait.CreateLocalHandle');
  FreeHandle(Handle);
  S.nLength := SizeOf(S);
  S.lpSecurityDescriptor := nil;
  S.bInheritHandle := True;
  case Handle of
    ehInput: B := CreatePipe(Input, InputHandler, @S, 0);
    ehOutput: B := CreatePipe(OutputHandler, Output, @S, 0);
    ehError: B := CreatePipe(ErrorOutputHandler, ErrorOutput, @S, 0);
  end;
  if not B then
    RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.CreateLocalHandle');
end;

procedure TExecuteControl.DoRead(var B: TBytes; H: THandle; Name: string);
var
  L: Integer;
  E, R: LongWord;
begin
  if (H = 0) or (H = INVALID_HANDLE_VALUE) then
    Exit;
  if PeekNamedPipe(H, nil, 0, nil, @R, nil) then begin
    if L > 0 then begin
      L := Length(B);
      SetLength(B, L + R);
      if not ReadFile(H, B[L], 1024, R, nil) then begin
        E := GetLastError;
        SetLength(B, L);
        RaiseLastOSError(E, Name);
      end;
      SetLength(B, L + R);
    end;
  end else
    repeat
      L := Length(B);
      SetLength(B, L + 1024);
      if not ReadFile(H, B[L], 1024, R, nil) then begin
        E := GetLastError;
        SetLength(B, L);
        RaiseLastOSError(E, Name);
      end;
      Inc(L, R);
      SetLength(B, L);
    until L <> 0;
end;

procedure TExecuteControl.FreeHandle(Handle: TExecuteHandle);
begin
  case Handle of
    ehInput: begin
      if IsHandleAssigned(ehInput, True) then
        CloseHandle(InputHandler);
      if IsHandleAssigned(ehInput, False) then
        CloseHandle(Input);
      InputHandler := 0;
      Input := 0;
    end;
    ehOutput: begin
      if (ErrorOutputHandler = OutputHandler) and IsHandleAssigned(ehError, True) then
        FreeHandle(ehError);
      if IsHandleAssigned(ehOutput, True) then
        CloseHandle(OutputHandler);
      if IsHandleAssigned(ehOutput, False) then
        CloseHandle(Output);
      OutputHandler := 0;
      Output := 0;
    end;
    ehError: begin
      if IsHandleAssigned(ehError, True) and (ErrorOutputHandler <> OutputHandler) then
        CloseHandle(ErrorOutputHandler);
      if IsHandleAssigned(ehError, False) then
        CloseHandle(ErrorOutput);
      ErrorOutputHandler := 0;
      ErrorOutput := 0;
    end;
    else
      RaiseLastOSError(ERROR_INVALID_PARAMETER, '.'#10'ExecuteAndWait.FreeHandle');
  end;
end;

procedure TExecuteControl.Initialize(Handles: TExecuteHandles; InputFile, OutputFile: string);
begin
  Finalize(Self);
  FillChar(Self, SizeOf(Self), 0);
  if Handles in [ehAllHandles, ehNoErrorHandle, ehOnlyInputHandle] then
    if InputFile <> 'then
      CreateFileHandle(ehInput, InputFile)
    else
      CreateLocalHandle(ehInput);
  if Handles in [ehAllHandles, ehNoErrorHandle] then
    if OutputFile <> 'then
      CreateFileHandle(ehOutput, OutputFile)
    else
      CreateLocalHandle(ehOutput);
  if Handles in [ehAllHandles] then
    if OutputFile <> 'then
      CreateDuplicateHandle(ehError)
    else
      CreateLocalHandle(ehError);
  ExitCode := S_FALSE;
end;

function TExecuteControl.IsHandleAssigned(Handle: TExecuteHandle; CheckHandler: Boolean): Boolean;
begin
  Result := ((Handle = ehInput) and CheckHandler and (InputHandler <> 0) and (InputHandler <> INVALID_HANDLE_VALUE))
         or ((Handle = ehInput) and not CheckHandler and (Input <> 0) and (Input <> INVALID_HANDLE_VALUE) and (Input <> GetStdHandle(STD_INPUT_HANDLE)))
         or ((Handle = ehOutput) and CheckHandler and (OutputHandler <> 0) and (OutputHandler <> INVALID_HANDLE_VALUE))
         or ((Handle = ehOutput) and not CheckHandler and (Output <> 0) and (Output <> INVALID_HANDLE_VALUE) and (Output <> GetStdHandle(STD_OUTPUT_HANDLE)))
         or ((Handle = ehError) and CheckHandler and (ErrorOutputHandler <> 0) and (ErrorOutputHandler <> INVALID_HANDLE_VALUE))
         or ((Handle = ehError) and not CheckHandler and (ErrorOutput <> 0) and (ErrorOutput <> INVALID_HANDLE_VALUE) and (ErrorOutput <> GetStdHandle(STD_ERROR_HANDLE)))
end;

function TExecuteControl.IsRunning: Boolean;
var
  C: LongWord;
begin
  Result := (Process <> 0) and GetExitCodeProcess(Process, C) and (C = STILL_ACTIVE);
end;

function TExecuteControl.Read(Count: Integer): string;
begin
  //if not IsHandleAssigned(ehOutput, True) then
  // RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Read');
  DoRead(OutputCache, OutputHandler, '.'#10'ExecuteAndWait.Read');
  with TEncoding.GetEncoding(CP_OEMCP) do
    try
      if Count < 0 then begin
        Result := GetString(OutputCache);
        OutputCache := nil;
      end else begin
        Result := GetString(OutputCache, 0, Min(Count, Length(OutputCache)));
        TArray.Copy<Byte>(OutputCache, OutputCache, Length(Result), 0, Length(OutputCache) - Length(Result));
        SetLength(OutputCache, Length(OutputCache) - Length(Result));
      end;
    finally
      Free;
    end;
end;

function TExecuteControl.ReadBytes(Count: Integer): TBytes;
begin
  //if not IsHandleAssigned(ehOutput, True) then
  // RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Read');
  DoRead(OutputCache, OutputHandler, '.'#10'ExecuteAndWait.Read');
  if Count < 0 then begin
    Result := OutputCache;
    OutputCache := nil;
  end else begin
    SetLength(Result, Min(Count, Length(OutputCache)));
    TArray.Copy<Byte>(OutputCache, Result, Length(Result));
    TArray.Copy<Byte>(OutputCache, OutputCache, Length(Result), 0, Length(OutputCache) - Length(Result));
    SetLength(OutputCache, Length(OutputCache) - Length(Result));
  end;
end;

function TExecuteControl.ReadError: string;
var
  B: TBytes;
  L, R: Integer;
begin
  if (ErrorOutputHandler = OutputHandler) or not IsHandleAssigned(ehError, True) then
    RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.ReadError');
  DoRead(B, ErrorOutputHandler, '.'#10'ExecuteAndWait.ReadError');
  with TEncoding.GetEncoding(CP_OEMCP) do
    try
      Result := GetString(B);
    finally
      Free;
    end;
end;

function TExecuteControl.ReadLn: string;
var
  L, i: Integer;
begin
  //if not IsHandleAssigned(ehOutput, True) then
  // RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Read');
  repeat
    DoRead(OutputCache, OutputHandler, '.'#10'ExecuteAndWait.Read');
    L := Length(OutputCache);
    i := 0;
    while (i < L) and not (OutputCache[i] in [0, 10, VK_RETURN]) do
      Inc(i);
    if ((i < L) and (OutputCache[i] in [0, 10, VK_RETURN])) or not IsRunning then begin
      Result := Read(i);
      L := Length(OutputCache);
      i := 0;
      if (i < L) and (OutputCache[i] = VK_RETURN) then
        Inc(i);
      if (i < L) and (OutputCache[i] = 10) then
        Inc(i);
      TArray.Copy<Byte>(OutputCache, OutputCache, i, 0, Length(OutputCache) - i);
      SetLength(OutputCache, Length(OutputCache) - i);
      Break;
    end;
    Sleep(100);
  until False;
end;

function TExecuteControl.ReadWord: string;
var
  L, i, i2: Integer;
begin
  //if not IsHandleAssigned(ehOutput, True) then
  // RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Read');
  repeat
    DoRead(OutputCache, OutputHandler, '.'#10'ExecuteAndWait.Read');
    L := Length(OutputCache);
    i := 0;
    while (i < L) and not (OutputCache[i] in [0, VK_TAB, 10, VK_RETURN, VK_SPACE]) do
      Inc(i);
    i2 := i;
    while (i2 < L) and (OutputCache[i2] in [VK_TAB, VK_SPACE]) do
      Inc(i2);
    if ((i2 < L) and (OutputCache[i2] in [0, 10, VK_RETURN])) or not IsRunning then begin
      Result := TrimRight(Read(i2));
      Break;
    end;
    Sleep(100);
  until False;
end;

function TExecuteControl.RunTime: TDateTime;
var
  CreationTime, ExitTime, KernelTime, UserTime, CurrentTime: TFileTime;
begin
  if Process = 0 then
    Exit(0);
  if not GetProcessTimes(Process, CreationTime, ExitTime, KernelTime, UserTime) then
    RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.RunTime');
  if IsRunning then begin
    GetSystemTimeAsFileTime(CurrentTime);
    Result := (UInt64(CurrentTime) - UInt64(CreationTime)) div 10000;
  end else
    Result := (UInt64(ExitTime) - UInt64(CreationTime)) div 10000;
end;

function TExecuteControl.RunTimeCPU: TDateTime;
var
  CreationTime, ExitTime, KernelTime, UserTime: TFileTime;
begin
  if Process = 0 then
    Exit(0);
  if not GetProcessTimes(Process, CreationTime, ExitTime, KernelTime, UserTime) then
    RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.RunTime');
  Result := (UInt64(KernelTime) + UInt64(UserTime)) div 10000;
end;

function TExecuteControl.RunTimeKernel: TDateTime;
var
  CreationTime, ExitTime, KernelTime, UserTime: TFileTime;
begin
  if Process = 0 then
    Exit(0);
  if not GetProcessTimes(Process, CreationTime, ExitTime, KernelTime, UserTime) then
    RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.RunTime');
  Result := UInt64(KernelTime) div 10000;
end;

procedure TExecuteControl.SetStandardHandle(Handle: TExecuteHandle);
begin
  if Handle > ehError then
    RaiseLastOSError(ERROR_INVALID_PARAMETER, '.'#10'ExecuteAndWait.CreateDuplicateHandle');
  FreeHandle(Handle);
  case Handle of
    ehInput: Input := GetStdHandle(STD_INPUT_HANDLE);
    ehOutput: Output := GetStdHandle(STD_OUTPUT_HANDLE);
    ehError: ErrorOutput := GetStdHandle(STD_ERROR_HANDLE);
  end;
end;

procedure TExecuteControl.TerminateProcess;
var
  DoAbort: Boolean;
begin
  DoAbort := IsRunning;
  try
    if DoAbort and not Winapi.Windows.TerminateProcess(Process, ERROR_PROCESS_ABORTED) then
      RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.Terminate');
  finally
    CloseHandles;
    if DoAbort then
      ExitCode := ERROR_PROCESS_ABORTED;
  end;
end;

function TExecuteControl.Wait(Timeout: LongWord {; OtherSignal: THandle}): Boolean;
begin
  if Process = 0 then
    Exit(True);
  case WaitForSingleObject(Process, Timeout) of
    WAIT_OBJECT_0, WAIT_ABANDONED:
      Result := True;
    WAIT_TIMEOUT:
      Result := False;
    WAIT_FAILED:
      RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.WriteEOF');
    else
      RaiseLastOSError(ERROR_INVALID_FUNCTION, '.'#10'ExecuteAndWait.WriteEOF');
  end;
end;

procedure TExecuteControl.Write(S: string);
begin
  with TEncoding.GetEncoding(CP_OEMCP) do
    try
      WriteBytes(GetBytes(S));
    finally
      Free;
    end;
end;

procedure TExecuteControl.WriteBytes(B: TBytes);
var
  L: LongWord;
begin
  if not IsHandleAssigned(ehInput, True) then
    RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Write');
  if Assigned(B) and not WriteFile(InputHandler, B[0], Length(B), L, nil) then
    RaiseLastOSError(GetLastError, '.'#10'ExecuteAndWait.Write');
  if Length(B) <> L then
    RaiseLastOSError(ERROR_WRITE_FAULT, '.'#10'ExecuteAndWait.WriteEOF');
end;

procedure TExecuteControl.WriteLn(S: string);
begin
  Write(S + #13);
end;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list

Geändert von himitsu (21. Mär 2016 um 08:38 Uhr)
  Mit Zitat antworten Zitat