|
Antwort |
Registriert seit: 11. Okt 2003 Ort: Elbflorenz 44.184 Beiträge Delphi 12 Athens |
#1
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, TerminateProcess 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)
$2B or not $2B
|
Zitat |
Registriert seit: 16. Jan 2004 Ort: Bendorf 5.219 Beiträge Delphi 10.2 Tokyo Professional |
#2
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." |
Zitat |
Neutral General |
Öffentliches Profil ansehen |
Mehr Beiträge von Neutral General finden |
Registriert seit: 26. Aug 2015 11 Beiträge |
#3
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).
|
Zitat |
Registriert seit: 11. Okt 2003 Ort: Elbflorenz 44.184 Beiträge Delphi 12 Athens |
#4
"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;
$2B or not $2B
Geändert von himitsu (21. Mär 2016 um 08:38 Uhr) |
Zitat |
Registriert seit: 11. Okt 2003 Ort: Elbflorenz 44.184 Beiträge Delphi 12 Athens |
#5
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.
$2B or not $2B
|
Zitat |
Registriert seit: 8. Okt 2010 Ort: Frankfurt am Main 1.234 Beiträge |
#6
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 AllocConsole 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) |
Zitat |
Registriert seit: 16. Jan 2004 Ort: Bendorf 5.219 Beiträge Delphi 10.2 Tokyo Professional |
#7
Aus meiner Erinnerung würde ich sagen, daß es in Delphi etwas aufwendiger sein könnte WriteLn usw. umzubiegen.
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." |
Zitat |
Neutral General |
Öffentliches Profil ansehen |
Mehr Beiträge von Neutral General finden |
Registriert seit: 24. Sep 2010 737 Beiträge |
#8
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) 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
|
Zitat |
Registriert seit: 11. Okt 2003 Ort: Elbflorenz 44.184 Beiträge Delphi 12 Athens |
#9
Also in diesem Fall ging es eher darum, dass es keine GUI gibt,
bzw. ob der Code mit WaitForInputIdle 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 AllocConsole aufrufen und dort hineinschreiben.
Bei meinem FileSplitter 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
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 ?
Es gibt halt EXEn, die reagieren darauf, wie sie gestartet wurden. (eine EXE für GUI und Console, statt zwei Getrennter)
$2B or not $2B
Geändert von himitsu ( 6. Sep 2016 um 12:22 Uhr) |
Zitat |
Registriert seit: 9. Apr 2006 1.682 Beiträge Delphi 5 Professional |
#10
Zitat:
wartet die CMD nicht automatisch auf das beenden einer GUI anwendung
Zitat:
Gewarter wird doch immer, außer man sagt CMD/START, dass es nicht warten soll.
Grüße Dalai |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs 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
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |