Capture Console in Delphi 2009 and Above

Question

Below is the code for Delphi XE, but the 2400 bufferize is pretty ugly.

Anyone have any suggestions for clearing this routine? And the 2400 limit will disappear (without defining the 64000 buffer).

thank

procedure TForm1.Button1Click(Sender: TObject);
begin
     CaptureConsoleOutput('c:\windows\system32\ipconfig','',Memo1);
end;

procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo); const CReadBuffer = 2400; var saSecurity: TSecurityAttributes; hRead: THandle; hWrite: THandle; suiStartup: TStartupInfo; piProcess: TProcessInformation; pBuffer: array[0..CReadBuffer] of AnsiChar; dRead: DWord; dRunning: DWord; begin saSecurity.nLength := SizeOf(TSecurityAttributes); saSecurity.bInheritHandle := True; saSecurity.lpSecurityDescriptor := nil;

if CreatePipe(hRead, hWrite, @saSecurity, 0) then begin FillChar(suiStartup, SizeOf(TStartupInfo), #0); suiStartup.cb := SizeOf(TStartupInfo); suiStartup.hStdInput := hRead; suiStartup.hStdOutput := hWrite; suiStartup.hStdError := hWrite; suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; suiStartup.wShowWindow := SW_HIDE;

 if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity,
   @saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess)
   then
 begin
   repeat
     dRunning  := WaitForSingleObject(piProcess.hProcess, 100);
     Application.ProcessMessages();
     repeat
       dRead := 0;
       ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
       pBuffer[dRead] := #0;

       OemToAnsi(pBuffer, pBuffer);
       AMemo.Lines.Add(String(pBuffer));
     until (dRead < CReadBuffer);
   until (dRunning <> WAIT_TIMEOUT);
   CloseHandle(piProcess.hProcess);
   CloseHandle(piProcess.hThread);
 end;

 CloseHandle(hRead);
 CloseHandle(hWrite);

; ;

code>

Answer 1

I have code that does this. I have cracked various irrelevant bits, so this may not compile as it is. But you must understand:

  procedure ReadStdout(hstdout: THandle; out stdout: string);
  var
    Buffer: AnsiString;
    FileSize: DWORD;
    NumberOfBytesRead: DWORD;
  begin
    FileSize := SetFilePointer(hstdout, 0, nil, FILE_END);
    if FileSize>0 then begin
      SetLength(Buffer, FileSize);
      SetFilePointer(hstdout, 0, nil, FILE_BEGIN);
      ReadFile(hstdout, Buffer[1], FileSize, NumberOfBytesRead, nil);
      //should really check that NumberOfBytesRead=FileSize
      stdout := Buffer;
    end else begin
      stdout := '';
    end;
  end;

  function CreateFileHandle(const FileName: string): THandle;
  var
    SecurityAttributes: TSecurityAttributes;
  begin
    ZeroMemory(@SecurityAttributes, SizeOf(SecurityAttributes));
    SecurityAttributes.nLength := SizeOf(SecurityAttributes);
    SecurityAttributes.lpSecurityDescriptor := nil;
    SecurityAttributes.bInheritHandle := True;
    Result := CreateFile(
      PChar(FileName),
      GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE,
      @SecurityAttributes,
      CREATE_ALWAYS,
      FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH,
      0
    );
  end;

  procedure Execute(const ExecutableFileName, DataFileName, TempFolder: string);
  var        
    hstdin, hstdout: THandle;
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    ExitCode: DWORD;
    stdout: string;
  begin
    hstdin := CreateFileHandle(TempFolder+'stdin');
    hstdout := CreateFileHandle(TempFolder+'stdout');
    Try
      ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
      StartupInfo.cb := SizeOf(StartupInfo);
      StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      StartupInfo.wShowWindow := SW_HIDE;
      StartupInfo.hStdInput := hstdin;
      StartupInfo.hStdError := hstdout;
      if CreateProcess(
        PChar(ExecutableFileName),
        '',
        nil,
        nil,
        True,
        CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
        nil,
        PChar(TempFolder),
        StartupInfo,
        ProcessInfo
      ) then begin            
        Try
          WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
          GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
          ReadStdout(hstdout, stdout);
        Finally
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
        End;
      end else begin
        //error;
      end;
    Finally
      CloseHandle(hstdout);
      CloseHandle(hstdin);
    End;
  end;

At some point you will want to clear the temporary files.