AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

IsConsole?

Ein Thema von himitsu · begonnen am 20. Mär 2016 · letzter Beitrag vom 6. Sep 2016
Antwort Antwort
Seite 1 von 2  1 2   
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
40.460 Beiträge
 
Delphi 11 Alexandria
 
#1

IsConsole?

  Alt 20. Mär 2016, 22:49
Moin, gibt es eigentlich ein einfaches Zeichen, oder gar eine API, mit der man prüfen kann, ob ein aktiver Prozess eine Konsolenanwendung ist?
Vorgehen: CreateProcess WaitForInputIdle WaitForSingleObject CloseHandle

WaitForInputIdle meint WAIT_FAILED, aber passiert das nur, wenn es keine GUI-Anwendung ist, es also kein "INPUT", bzw. keine MessageQueue gibt?

Der FileHeader sagt ja auch nichts aus, also ob nicht doch eine GUI erzeugt wird,
oder ob das einfach nur eine "unsichtbare" Konsolenanwendung ist. (als GUI markiert, damit kein Konsolenfenster auf geht, aber dennoch ohne GUI)



Auch das Problem den Prozess zu beenden, wäre hier zu lösen, denn je nach Typ wäre das Vorgehen ja etwas Anders.
OK, MSDN-Library durchsuchenTerminateProcess geht immer, aber man muß es ja nicht übertreiben.
Also einfach nur ein WM_QUIT/WM_CLOSE für GUI, bzw. Ctrl+C/Ctrl+Break bei der Console, aber das Problem hab ich wohl gelöst. (noch ungetestet)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.197 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#2

AW: IsConsole?

  Alt 21. Mär 2016, 00:03
Was wahrscheinlich klappen könnte wäre ein GetConsoleWindow in einem Remote-Thread.
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat
null33

Registriert seit: 26. Aug 2015
11 Beiträge
 
#3

AW: IsConsole?

  Alt 21. Mär 2016, 07:55
Von Stackoverflow:
Delphi-Quellcode:
function IAmAConsoleApp: Boolean;
var
  Stdout: THandle;
begin
  Stdout := GetStdHandle(Std_Output_Handle);
  Win32Check(Stdout <> Invalid_Handle_Value);
  Result := Stdout <> 0;
end;
Zitat:
Call GetStdHandle(Std_Output_Handle). If it succeeds and returns zero, then there is no console to write to. Other return values indicate that a console is attached to the process, so you can write to it (although the console may not be the most desirable place to log messages in a console program since they'll interfere with the normal output).
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
40.460 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
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
40.460 Beiträge
 
Delphi 11 Alexandria
 
#5

AW: IsConsole?

  Alt 7. Apr 2016, 13:20
Sooo, hier erstmal das vorläufige Endergebnis, samt einer IsConsoleEXE-Funktion. (siehe h5u.Executable.pas)

Bin noch am überlegen ob und wie ich das in eine Klassenstruktur bekomme.
Und bezüglich 64 Bit hab ich noch nichts geprüft.
Angehängte Dateien
Dateityp: 7z ExecuteProcess.7z (3,19 MB, 29x aufgerufen)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list
  Mit Zitat antworten Zitat
Benutzerbild von Assarbad
Assarbad

Registriert seit: 8. Okt 2010
Ort: Frankfurt am Main
1.234 Beiträge
 
#6

AW: IsConsole?

  Alt 6. Sep 2016, 11:10
Himitsu, wie definierst du denn eine Konsolenanwendung? Geht es dir um das Subsystem im PE-Header oder eher darum, ob die Anwendung ein Konsolenfenster hat? Immerhin kann eine GUI-Anwendung ohne weiteres MSDN-Library durchsuchenAllocConsole aufrufen und dort hineinschreiben. Das habe ich selbst schon mehrfach für Debugausgaben verwendet, indem ich die Dateinummern für stdout, stdin und stderr aus stdio.h (C/C++) einfach umgebogen habe. Aus meiner Erinnerung würde ich sagen, daß es in Delphi etwas aufwendiger sein könnte WriteLn usw. umzubiegen.
Oliver
"... aber vertrauen Sie uns, die Physik stimmt." (Prof. Harald Lesch)
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.197 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#7

AW: IsConsole?

  Alt 6. Sep 2016, 11:50
Aus meiner Erinnerung würde ich sagen, daß es in Delphi etwas aufwendiger sein könnte WriteLn usw. umzubiegen.
Man kann ja alternativ einfach WriteFile benutzen
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat
Benutzerbild von Memnarch
Memnarch

Registriert seit: 24. Sep 2010
737 Beiträge
 
#8

AW: IsConsole?

  Alt 6. Sep 2016, 11:59
Der FileHeader sagt ja auch nichts aus, also ob nicht doch eine GUI erzeugt wird,
oder ob das einfach nur eine "unsichtbare" Konsolenanwendung ist. (als GUI markiert, damit kein Konsolenfenster auf geht, aber dennoch ohne GUI)
Wenn eine Applikation als GUI markiert ist, verhält sie sich anders. Z.B. wartet die CMD nicht automatisch auf das beenden einer GUI anwendung, währned auf eine markierte Konsolenanwendung immer gewartet wird. Wenn jemand solches schindluder treibt gibts da ganz andere probleme^^.

EDIT: und warum soll eine Konsolenanwendung eine GUI erzeugen dürfen ?
Da man Trunc nicht auf einen Integer anwenden kann, muss dieser zuerst in eine Float kopiert werden
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
40.460 Beiträge
 
Delphi 11 Alexandria
 
#9

AW: IsConsole?

  Alt 6. Sep 2016, 12:02
Also in diesem Fall ging es eher darum, dass es keine GUI gibt,
bzw. ob der Code mit MSDN-Library durchsuchenWaitForInputIdle warten kann,
oder genauer ob und wie ich dessen Fehlermeldung behandeln sollte. (wenn GUI, dann ist der Timeout böse, aber wenn Console, dann ist das schon richtig so, dass es nicht geht :supid

Immerhin kann eine GUI-Anwendung ohne weiteres MSDN-Library durchsuchenAllocConsole aufrufen und dort hineinschreiben.
Andersrum geht auch. Eine "Konsolenanwendung" kann ebenso ein Fenster/GUI anzeigen.

Bei meinem Hier im Forum suchenFileSplitter hatte ich das damals gemacht.
Das Programm war nicht als "CONSOLE" kompiliert und eim Programmstart wurde dann geschaut, ob ein Konsolenfenster vorhanden ist,
wenn ja, dann damit vebinden (AttachConsole) oder wenn per Parameter verlangt aber nicht vorhanden, dann erzeugen (AllocConsole)
und wenn nein, dann wird die GUI erzeugt und die Messages in 'ner Schleife abgearbeitet.


Zitat:
wartet die CMD nicht automatisch auf das beenden einer GUI anwendung
Seit wann das?
Gewarter wird doch immer, außer man sagt CMD/START, dass es nicht warten soll.

Zitat:
EDIT: und warum soll eine Konsolenanwendung eine GUI erzeugen dürfen ?
Warum sollte sie nicht dürfen?

Es gibt halt EXEn, die reagieren darauf, wie sie gestartet wurden. (eine EXE für GUI und Console, statt zwei Getrennter)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list

Geändert von himitsu ( 6. Sep 2016 um 12:22 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Dalai
Dalai

Registriert seit: 9. Apr 2006
1.637 Beiträge
 
Delphi 5 Professional
 
#10

AW: IsConsole?

  Alt 6. Sep 2016, 14:27
Zitat:
wartet die CMD nicht automatisch auf das beenden einer GUI anwendung
Seit wann das?
Schon immer.

Zitat:
Gewarter wird doch immer, außer man sagt CMD/START, dass es nicht warten soll.
Nope. Einfach mal ausprobieren: CMD öffnen, notepad eingeben, ENTER - Was passiert? Notepad startet, und der Prompt der CMD kommt sofort zurück, nicht erst, wenn Notepad beendet wird. Daher gibt's auch den Schalter /wait, mit dem man dem start-Kommando sagen kann, es soll warten.

Grüße
Dalai
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2   

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:48 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf