Capture Console in Delphi 2009 and above - delphi

Question

The code below works for Delphi XE, but the 2400 buffersize is pretty ugly.
Anyone have some suggestions on cleaning this routine up ?? And making the 2400 limit disappear (without defining a 64000 buffer).
Thanks
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);
end;
end;

Answer 1

I've got some code that does this. I've hacked out various irrelevant bits, so this may not compile as is. But you should get the idea:
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;
You'll want to clean up the temp files at some point.