asked on

Capturing Console Output

Hi Experts,
please help. I need to capture any console output. That means even 16bit console applications and W32 as well. Right now, I can do the W32 but that's not enough. I also need the .BAT files etc. Please, help anybody. Thank you. I've got this piece of code. It will hang on 16 bit applications (the ReadFile function doesn't return):

Function ExecuteModalGetOutput(FPath, FOutputFile: String; Var ErrorCode: Cardinal; FShow: Longint; Environment: PChar): Boolean;
Var
SI: TStartupInfo;
PI: TProcessInformation;
Dwl: DWord;
SA: TSecurityAttributes;
hPipeOutputRead: THANDLE;
hPipeOutputWrite: THANDLE;
hPipeErrorsRead: THANDLE;
hPipeErrorsWrite: THANDLE;
dwNumberOfBytesRead: DWORD;
szBuffer: Array [$00..BufferLen - $01] Of Byte;
F: File Of Byte;
Begin
Result := False;

SA.nLength := SizeOf(SA);
SA.bInheritHandle := True;
SA.lpSecurityDescriptor := Nil;

CreatePipe(hPipeOutputRead, hPipeOutputWrite, @SA, $00);
CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @SA, $00);

FillChar(SI, SizeOf(SI), $00);
SI.cb := SizeOf(SI);
SI.dwFlags := STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES;
SI.wShowWindow := FShow;
SI.hStdOutput := hPipeOutputWrite;
SI.hStdError := hPipeErrorsWrite;
If CreateProcess(Nil, PChar(FPath), Nil, Nil, True, CREATE_NEW_CONSOLE Or NORMAL_PRIORITY_CLASS, Environment, Nil, SI, PI) Then
Begin
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsWrite);

Try
AssignFile(F, FOutputFile);
{$I-}
Rewrite(F);
{$I+}
If IOResult = $00 Then
Begin
While ReadFile(hPipeOutputRead, szBuffer, BufferLen, dwNumberOfBytesRead, Nil) Do
BlockWrite(F, szBuffer, dwNumberOfBytesRead);

CloseFile(F);
End;
Except
End;

WaitForSingleObject(PI.hProcess, INFINITE);

GetExitCodeProcess(PI.hProcess, Dwl);

ErrorCode := Dwl;

CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);

CloseHandle (hPipeOutputRead);
CloseHandle (hPipeErrorsRead);

Result := True;
End
Else
Begin
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsRead);
CloseHandle(hPipeErrorsWrite);
End;
End;

ASKER CERTIFIED SOLUTION

inthe

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

simonet

Jakubklos, the code below also does what you want. It captures the output of a console application into a TMemo. It also works with 16-bit processes.

unit Cons1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
btnStart: TButton;
btnStop: TButton;
btnGrab: TButton;
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure btnGrabClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1 : TForm1;
hConsole : THandle;
ProcessInfo : TProcessInformation;

implementation

{$R *.DFM}

type
cInfo = array[1..MAXINT div SizeOf(TCharInfo)] of TCharInfo;
pcInfo = ^cInfo;

procedure TForm1.btnStartClick(Sender: TObject);
var
zAppName:array[0..512] of char;
zCurDir:array[0..255] of char;
WorkDir:String;
StartupInfo:TStartupInfo;
begin
btnStart.Enabled := false;
if AllocConsole then
begin
StrPCopy(zAppName,'command.com /c dir');
WorkDir := 'c:\';
StrPCopy(zCurDir,WorkDir);
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWDEFAULT;
if CreateProcess(nil,
zAppName, // pointer to command line string
nil, // pointer to process security attributes
nil, // pointer to thread security attributes
false, // handle inheritance flag
CREATE_SEPARATE_WOW_VDM or // creation flags
NORMAL_PRIORITY_CLASS,
nil, // pointer to new environment block
nil, // pointer to current directory name
StartupInfo, // pointer to STARTUPINFO
ProcessInfo) then // pointer to PROCESS_INF
begin
SetConsoleTitle(PChar('Test Console Application'));
hConsole := GetStdHandle(STD_OUTPUT_HANDLE);
btnStop.Enabled := true;
btnGrab.Enabled := true;
end
else
begin
btnStart.Enabled := true;
end;
end;
end;

procedure TForm1.btnStopClick(Sender: TObject);
var ProcessResult : integer;
begin
try
WaitforSingleObject(ProcessInfo.hProcess,INFINITE); file://wait for DOS
process
GetExitCodeProcess(ProcessInfo.hProcess, ProcessResult);
CloseHandle( ProcessInfo.hProcess );
CloseHandle( ProcessInfo.hThread );
CloseHandle(hConsole);
FreeConsole;
btnStop.Enabled := false;
btnGrab.Enabled := false;
btnStart.Enabled := true;
except
end;
end;

procedure TForm1.btnGrabClick(Sender: TObject);
var
hConOut : THandle;
Dest : TCoord;
csbi : TConsoleScreenBufferInfo; // used to get screen size
i, j : integer;
s : string;
GrabBuff : pcInfo;
begin
btnGrab.Enabled := false;
Dest.X := 0;
Dest.Y := 0;
try
hConOut := GetStdHandle(STD_OUTPUT_HANDLE);
GetConsoleScreenBufferInfo(hConOut, csbi);
SetLength(s, csbi.dwMaximumWindowSize.X + 1);
GetMem(GrabBuff, csbi.dwMaximumWindowSize.X *
csbi.dwMaximumWindowSize.Y * sizeof(TCharInfo));
try
// read the screen rectangle into the buffer
ReadConsoleOutput(hConOut, // output buffer
GrabBuff, // buffer that receives data
csbi.dwMaximumWindowSize, // col/row size of
destination buffer
Dest, // upper-left cell to write data to
csbi.srWindow); // screen buffer rectangle to
read from
file://copy text data from pCharInfo to memo
Memo1.Clear;
for i := 0 to csbi.dwMaximumWindowSize.Y - 1 do
begin
s := '';
for j := 1 to csbi.dwMaximumWindowSize.X do
s := s +
GrabBuff^[i*csbi.dwMaximumWindowSize.X + j].AsciiChar;
Memo1.Lines.Add(s);
end;
finally
freemem(GrabBuff);
end;
finally
btnGrab.Enabled := true;
end;
end;

end.

Yours,

Alex
Athena's Place: http://www.bhnet.com.br/~simonet

rwilson032697

Listening

brainware

Listening..

jakubklos

ASKER

Thanks guys, you were both great. It works.