Execute DOS program and get output dynamically


I need to execute a 'DOS' program (console app) and to retrieve its output dynamically (it will be also nice to be able to end the DOS program whenever I want because the DOS program may run for hours).

I have this this function, but it sometimes (rarely) freezes. I need a new function or to fix the one below.

procedure ExecuteAndGetOutDyn(CONST ACommand, AParameters: String; AMemo: TMemo); CONST CReadBuffer = 128*KB; //original was 2400bytes VAR SecurityAttrib: TSecurityAttributes; hRead: THandle; hWrite: THandle; StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; pBuffer: array[0..CReadBuffer] of AnsiChar; dRead: DWord; dRunning: DWord; WasOK: Boolean; begin SecurityAttrib.nLength := SizeOf(TSecurityAttributes); SecurityAttrib.bInheritHandle := True; SecurityAttrib.lpSecurityDescriptor := nil; if CreatePipe(hRead, hWrite, @SecurityAttrib, 0) then begin FillChar(StartupInfo, SizeOf(TStartupInfo), #0); StartupInfo.cb := SizeOf(TStartupInfo); StartupInfo.hStdInput := hRead; StartupInfo.hStdOutput := hWrite; StartupInfo.hStdError := hWrite; StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; StartupInfo.wShowWindow:= SW_HIDE; if CreateProcess(NIL, PChar(ACommand + ' ' + AParameters), @SecurityAttrib, @SecurityAttrib, True, NORMAL_PRIORITY_CLASS, NIL, NIL, StartupInfo, ProcessInfo) then begin REPEAT dRunning:= WaitForSingleObject(ProcessInfo.hProcess, 100); Application.ProcessMessages; REPEAT dRead := 0; WasOK := Windows.ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, NIL); if NOT WasOK then mesajerror('Cannot read console output.'); pBuffer[dRead] := #0; OemToAnsi(pBuffer, (pBuffer)); AMemo.Lines.Add(String(pBuffer)); UNTIL (dRead < CReadBuffer) OR NOT WasOK; UNTIL (dRunning <> WAIT_TIMEOUT) { OR Abort}; CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); end; CloseHandle(hRead); CloseHandle(hWrite); end; end; <hr />

The big problem is that there are no certain conditions under which the procedure freezes. I just call the ExecuteAndGetOutDyn and SOMETIMES it freezes after the 'DOS' program finishes. I will post the conditions in which the freeze appears as soon as I discover them.


One obvious problem is your pipe. You have a single pipe and you arrange that the child process stdout writes to one end, and the child process stdin reads from the other. That's no good. Why would you want the process to read its input from its own output? And at the same time the parent process reads from the pipe. You've got two processes trying to read this pipe. I can't imagine that ends well.

You need two pipes. One for the child's stdin. The parent writes to it, the child reads from it. And the other pipe for the child's stdout. The child writes to it, the parent reads.

Or if you don't want the child process to have any stdin, then create a single pipe, connect write end to child process stdout and let the parent process read from the read end.

Another problem is that if the process has terminated, and you've already read all of its contents, the call to ReadFile will block indefinitely. You need to make sure that the pipe contains something before attempting to read from it. I'd use GetFileSizeEx for that.

Personally I'd be inclined to do all of this inside a thread to avoid the call to ProcessMessages.

You should also always check API return values for errors. That is not done for the calls to WaitForSingleObject and ReadFile.

I propose something along these lines:

program DynamicStdOutCapture; {$APPTYPE CONSOLE} uses System.SysUtils, System.Math, Winapi.Windows; function GetFileSizeEx(hFile: THandle; var FileSize: Int64): BOOL; stdcall; external kernel32; procedure Execute(const Command: string; const Parameters: string; const Timeout: DWORD; const Output: TProc<string>); const InheritHandleSecurityAttributes: TSecurityAttributes = (nLength: SizeOf(TSecurityAttributes); bInheritHandle: True); var hReadStdout, hWriteStdout: THandle; si: TStartupInfo; pi: TProcessInformation; WaitRes, BytesRead: DWORD; FileSize: Int64; AnsiBuffer: array [0 .. 1024 - 1] of AnsiChar; begin Win32Check(CreatePipe(hReadStdout, hWriteStdout, @InheritHandleSecurityAttributes, 0)); try si := Default (TStartupInfo); si.cb := SizeOf(TStartupInfo); si.dwFlags := STARTF_USESTDHANDLES; si.hStdOutput := hWriteStdout; si.hStdError := hWriteStdout; Win32Check(CreateProcess(nil, PChar(Command + ' ' + Parameters), nil, nil, True, CREATE_NO_WINDOW, nil, nil, si, pi)); try while True do begin WaitRes := WaitForSingleObject(pi.hProcess, Timeout); Win32Check(WaitRes <> WAIT_FAILED); while True do begin Win32Check(GetFileSizeEx(hReadStdout, FileSize)); if FileSize = 0 then begin break; end; Win32Check(ReadFile(hReadStdout, AnsiBuffer, SizeOf(AnsiBuffer) - 1, BytesRead, nil)); if BytesRead = 0 then begin break; end; AnsiBuffer[BytesRead] := #0; OemToAnsi(AnsiBuffer, AnsiBuffer); if Assigned(Output) then begin Output(string(AnsiBuffer)); end; end; if WaitRes = WAIT_OBJECT_0 then begin break; end; end; finally CloseHandle(pi.hProcess); CloseHandle(pi.hThread); end; finally CloseHandle(hReadStdout); CloseHandle(hWriteStdout); end; end; procedure DoOutput(Text: string); begin Write(Text); end; procedure Main; begin Execute('ping', 'stackoverflow.com -t', 100, DoOutput); end; begin try Main; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.