Running commandline app and capturing output

[Tommi Prami 130]

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;
 

[Lars Fosdal 1792]

Is the behavior erratic across multiple executions of the same application - or is it specific applications that do not let you capture?

[Tommi Prami 130]

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-

[Angus Robertson 574]

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;

[Tommi Prami 130]

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-

[Tommi Prami 130]

@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-

[Angus Robertson 574]

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

 

[Tommi Prami 130]

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-

[HolgerX 7]

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...

[Fr0sT.Brutal 900]

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 ?