Tommi Prami 131 Posted February 6, 2020 Below is partial code that does actual running and capturing. It runs just fine but does not always capture the output of app. THere might be something very trivial that I just don't see, and Application.ProcessMessages calls Are not smart for start. Any ideas?? .Tee. const ExecutionTimeout = 60 * 1000; procedure TCommandLineApp.WaitforApp(const AProcessHandle: THandle; const ARaiseTimeoutException: Boolean; const AExplicitTimeOut: Integer = 0); var LApprunning: Cardinal; LStartTick: UInt64; LTimeout: Integer; LExecuteTimeOutExeeded: Boolean; LElapsedTime: UInt64; begin if AExplicitTimeOut <> 0 then LTimeout := AExplicitTimeOut else LTimeout := ExecutionTimeout; LStartTick := GetTickCount64; repeat LApprunning := WaitForSingleObject(AProcessHandle, Min(LTimeout, 100)); // TODO: This is not too smart, I think Application.ProcessMessages; LElapsedTime := Abs(GetTickCount64 - LStartTick); LExecuteTimeOutExeeded := LElapsedTime > LTimeout; until (LApprunning <> WAIT_TIMEOUT) or LExecuteTimeOutExeeded; if LExecuteTimeOutExeeded and ARaiseTimeoutException then raise Exception.Create('Commandline process timeout exeeded'); // TODO: This is not too smart, I think Application.ProcessMessages; end; function TCommandLineApp.InternalExecute(const AFullCommandLine: string; var AReturnedOutput: string): Boolean; function GetSystemErrorMessage: string; begin Result := CommandlineApplication + ': ' + SysErrorMessage(GetLastError); end; var LSecurityAttributes: TSecurityAttributes; LStartupInfo: TStartupInfo; LProcessInfo: TProcessInformation; LStdOutPipeRead, LStdOutPipeWrite: THandle; LWorkDir: string; LHandle: Boolean; LExitCode: DWord; begin Result := False; LSecurityAttributes := InitSecurityAtttributes; if CreatePipe(LStdOutPipeRead, LStdOutPipeWrite, @LSecurityAttributes, 0) then begin try LStartupInfo := InitStartupInfo(LStdOutPipeWrite); LWorkDir := GetCurrentDir; LHandle := CreateProcess(nil, PChar(AFullCommandLine), nil, nil, True, 0, nil, PChar(LWorkDir), LStartupInfo, LProcessInfo); if LHandle then begin try // Give app little bit time to start up (Not sure if needed) WaitforApp(LProcessInfo.hProcess, False, 500); ReadProcessStdOut(AReturnedOutput, LStdOutPipeRead); // If app does wait app hangs "for ever", exception is raised WaitforApp(LProcessInfo.hProcess, True); {TODO : Probaply should handle STILL_ACTIVE, Check out: https://msdn.microsoft.com/en-us/library/windows/desktop/ms683189(v=vs.85).aspx } if GetExitCodeProcess(LProcessInfo.hProcess, LExitCode) then FExitCode := LExitCode else FExitCode := -1; // Don't have rights to check for the exit code Result := (FExitCode = -1) or (FExitCode = 0); if not Result then FLastError := AReturnedOutput; finally CloseHandle(LProcessInfo.hThread); CloseHandle(LProcessInfo.hProcess); end; end else FLastError := GetSystemErrorMessage; finally CloseHandle(LStdOutPipeWrite); CloseHandle(LStdOutPipeRead); end end else FLastError := GetSystemErrorMessage; end; Share this post Link to post
Lars Fosdal 1792 Posted February 6, 2020 Is the behavior erratic across multiple executions of the same application - or is it specific applications that do not let you capture? Share this post Link to post
Tommi Prami 131 Posted February 10, 2020 What I've tested, same app mich or might not get captured, earlier used this code to fire up OpenSSL, bow in house internal App. Now if I run 30 times same app, maybe none get captured, maybe all get captured, or anything in between. -Tee- Share this post Link to post
Angus Robertson 575 Posted February 10, 2020 This is a function I've been using for 15 years, including with OpenSSL command lines, not looked at your code to see how they differ, but might be worth trying it. Angus procedure GetConsoleOutput (const CommandLine : string; var Output : TStringList); var SA: TSecurityAttributes; SI: TStartupInfo; PI: TProcessInformation; StdOutFile, AppProcess, AppThread : THandle; RootDir, WorkDir, StdOutFileName:string; const FUNC_NAME = 'GetConsoleOuput'; begin StdOutFile:=0; AppProcess:=0; AppThread:=0; try // Initialize dirs RootDir:=ExtractFilePath(ParamStr(0)); WorkDir:=ExtractFilePath(CommandLine); // Check WorkDir if not (FileSearch(ExtractFileName(CommandLine),WorkDir)<>'') then WorkDir:=RootDir; // Initialize output file security attributes FillChar(SA,SizeOf(SA),#0); SA.nLength:=SizeOf(SA); SA.lpSecurityDescriptor:=nil; SA.bInheritHandle:=True; // Create Output File StdOutFileName:=RootDir+'output.tmp'; StdOutFile:=CreateFile(PChar(StdOutFileName), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, @SA, CREATE_ALWAYS, // Always create it FILE_ATTRIBUTE_TEMPORARY or // Will cache in memory // if possible FILE_FLAG_WRITE_THROUGH, 0); // Check Output Handle if StdOutFile = INVALID_HANDLE_VALUE then raise Exception.CreateFmt('Function %s() failed!' + #10#13 + 'Command line = %s',[FUNC_NAME,CommandLine]); // Initialize Startup Info FillChar(SI,SizeOf(SI),#0); with SI do begin cb:=SizeOf(SI); dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; wShowWindow:=SW_HIDE; hStdInput:=GetStdHandle(STD_INPUT_HANDLE); hStdError:=StdOutFile; hStdOutput:=StdOutFile; end; // Create the process if CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, PChar(WorkDir), SI, PI) then begin WaitForSingleObject(PI.hProcess,INFINITE); AppProcess:=PI.hProcess; AppThread:=PI.hThread; end else raise Exception.CreateFmt('CreateProcess() in function %s() failed!' + #10#13 + 'Command line = %s',[FUNC_NAME,CommandLine]); CloseHandle(StdOutFile); StdOutFile:=0; Output.Clear; Output.LoadFromFile (StdOutFileName); finally // Close handles if StdOutFile <> 0 then CloseHandle(StdOutFile); if AppProcess <> 0 then CloseHandle(AppProcess); if AppThread <> 0 then CloseHandle(AppThread); // Delete Output file if FileExists(StdOutFileName) then SysUtils.DeleteFile(StdOutFileName); end; end; 1 Share this post Link to post
Tommi Prami 131 Posted February 11, 2020 Angus Robertson, thanks for code, I think this should work without using temp file. Also as it is now can't work if same process is fired multiple times at same time, as I woulöd need to do (easy to fix tough)... -Tee- Share this post Link to post
Tommi Prami 131 Posted February 11, 2020 @Angus Robertson but anyhow, seems that I coudöl fix problems with your code. Need to tinker adound with my current contraption, it is not very clean API-vise. Thanks!! -Tee- Share this post Link to post
Angus Robertson 575 Posted February 11, 2020 Thought you ran it 30 times sequentially, not concurrently, you are probably hitting some Windows problem. Are you trying to run 30 parallel instances of openssl.exe? Why? Angus Share this post Link to post
Tommi Prami 131 Posted February 11, 2020 1 hour ago, Angus Robertson said: Thought you ran it 30 times sequentially, not concurrently, you are probably hitting some Windows problem. Are you trying to run 30 parallel instances of openssl.exe? Why? Angus No, not going to run OpenSSL, Have used this code with OpenSSL previously. That was just an example. I am going to run internal company commandline tool. Which does some file processing, and I have x number of files, which I would like to run in parallel. Which going to work. Currently it is totally OK; parallel running would be faster. -Tee- Share this post Link to post
HolgerX 7 Posted February 11, 2020 Hmm.. I have a code here that uses pipes instead of tmp files for the output: function GetConsoleOutput2(const Command : WideString; Output, Errors : TStrings) : Boolean; var Buffer : array[0..2400] of AnsiChar; BufferStrOutput : AnsiString; BufferStrErrors : AnsiString; CreationFlags : DWORD; NumberOfBytesRead : DWORD; PipeErrorsRead : THandle; PipeErrorsWrite : THandle; PipeOutputRead : THandle; PipeOutputWrite : THandle; ProcessInfo : TProcessInformation; SecurityAttr : TSecurityAttributes; StartupInfo : TStartupInfo; tmpWaitR : DWORD; procedure AddLine(var AString : string; ALines : TStrings); var i : integer; begin i := pos(#13#10, AString); while i > 0 do begin ALines.Add(copy(AString,1,i-1)); Delete(AString,1,i+1); i := pos(#13#10, AString); end; end; begin //Initialisierung ProcessInfo FillChar(ProcessInfo, SizeOf(TProcessInformation), 0); //Initialisierung SecurityAttr FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0); SecurityAttr.nLength := SizeOf(TSecurityAttributes); SecurityAttr.bInheritHandle := True; SecurityAttr.lpSecurityDescriptor := nil; //Pipes erzeugen CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0); CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0); //Initialisierung StartupInfo FillChar(StartupInfo, SizeOf(TStartupInfo), 0); StartupInfo.cb := SizeOf(TStartupInfo); StartupInfo.hStdInput := 0; StartupInfo.hStdOutput := PipeOutputWrite; StartupInfo.hStdError := PipeErrorsWrite; StartupInfo.wShowWindow := SW_HIDE; StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; CreationFlags := CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS; result := CreateProcessW(nil, (PWideChar(Command)), nil, nil, True, CreationFlags, nil, nil, StartupInfo, ProcessInfo); if result then begin //Write-Pipes schließen CloseHandle(PipeOutputWrite); CloseHandle(PipeErrorsWrite); BufferStrOutput := ''; BufferStrErrors := ''; repeat tmpWaitR := WaitForSingleObject(ProcessInfo.hProcess, 100); NumberOfBytesRead := 0; //Ausgabe Read-Pipe auslesen if PeekNamedPipe(PipeOutputRead, nil, 0, nil, @NumberOfBytesRead, nil) and (NumberOfBytesRead > 0) then begin while ReadFile(PipeOutputRead, Buffer, Length(Buffer)-1, NumberOfBytesRead, nil) do begin Buffer[NumberOfBytesRead] := #0; OemToAnsi(Buffer, Buffer); BufferStrOutput := BufferStrOutput + Buffer; AddLine(BufferStrOutput,Output); Application.ProcessMessages(); end; end; NumberOfBytesRead := 0; if PeekNamedPipe(PipeErrorsRead, nil, 0, nil, @NumberOfBytesRead, nil) and (NumberOfBytesRead > 0) then begin while ReadFile(PipeErrorsRead, Buffer, Length(Buffer)-1, NumberOfBytesRead, nil) do begin Buffer[NumberOfBytesRead] := #0; OemToAnsi(Buffer, Buffer); BufferStrErrors := BufferStrErrors + Buffer; AddLine(BufferStrErrors,Errors); Application.ProcessMessages(); end; end; Application.ProcessMessages(); until (tmpWaitR <> WAIT_TIMEOUT); if BufferStrOutput <> '' then Output.Add(BufferStrOutput); if BufferStrErrors <> '' then Errors.Add(BufferStrErrors); CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); CloseHandle(PipeOutputRead); CloseHandle(PipeErrorsRead); end else begin //Pipes schließen CloseHandle(PipeOutputRead); CloseHandle(PipeOutputWrite); CloseHandle(PipeErrorsRead); CloseHandle(PipeErrorsWrite); end; end; Keep in mind that some DOS commands only work within the CMD or give a return. So just put 'cmd.exe /A /C' before you actually call it. The Application.ProcessMessages(); are only needed when you ausing Memos for Output, Errors... Share this post Link to post
Fr0sT.Brutal 900 Posted February 11, 2020 6 minutes ago, HolgerX said: if PeekNamedPipe(PipeOutputRead, nil, 0, nil, @NumberOfBytesRead, nil) and (NumberOfBytesRead > 0) then begin while ReadFile(PipeOutputRead, Buffer, Length(Buffer)-1, NumberOfBytesRead, nil) do begin Buffer[NumberOfBytesRead] := #0; OemToAnsi(Buffer, Buffer); BufferStrOutput := BufferStrOutput + Buffer; AddLine(BufferStrOutput,Output); Application.ProcessMessages(); end; end; Wouldn't this block at 2nd iteration ? Share this post Link to post