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;
jakubklosAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

intheCommented:
hi,
do you mean like this:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
procedure RunDosInMemo(Que:String;EnMemo:TMemo);
   const
      CUANTOBUFFER = 2000;
   var
     Seguridades         : TSecurityAttributes;
     PaLeer,PaEscribir   : THandle;
     start               : TStartUpInfo;
     ProcessInfo         : TProcessInformation;
     Buffer              : Pchar;
     BytesRead           : DWord;
     CuandoSale          : DWord;
   begin
     With Seguridades do
     begin
       nlength              := SizeOf(TSecurityAttributes);
       binherithandle       := true;
       lpsecuritydescriptor := nil;
     end;
     {Creamos el pipe...}
     if Createpipe (PaLeer, PaEscribir, @Seguridades, 0) then
     begin
       Buffer  := AllocMem(CUANTOBUFFER + 1);
       FillChar(Start,Sizeof(Start),#0);
       start.cb          := SizeOf(start);
       start.hStdOutput  := PaEscribir;
       start.hStdInput   := PaLeer;
       start.dwFlags     := STARTF_USESTDHANDLES +
                            STARTF_USESHOWWINDOW;
       start.wShowWindow := SW_HIDE;

       if CreateProcess(nil,
          PChar(Que),
          @Seguridades,
          @Seguridades,
          true,
          NORMAL_PRIORITY_CLASS,
          nil,
          nil,
          start,
          ProcessInfo)
       then
         begin
           {Espera a que termine la ejecucion}
           repeat
             CuandoSale := WaitForSingleObject( ProcessInfo.hProcess,100);
             Application.ProcessMessages;
           until (CuandoSale <> WAIT_TIMEOUT);
           {Leemos la Pipe}
           Repeat
             BytesRead := 0;
             {Llenamos un troncho de la pipe, igual a nuestro buffer}
             ReadFile(PaLeer,Buffer[0],CUANTOBUFFER,BytesRead,nil);
             {La convertimos en una string terminada en cero}
             Buffer[BytesRead]:= #0;
             {Convertimos caracteres DOS a ANSI}
             OemToAnsi(Buffer,Buffer);
             EnMemo.Text := EnMemo.text + String(Buffer);
           until (BytesRead < CUANTOBUFFER);
         end;
       FreeMem(Buffer);
       CloseHandle(ProcessInfo.hProcess);
       CloseHandle(ProcessInfo.hThread);
       CloseHandle(PaLeer);
       CloseHandle(PaEscribir);
     end;
   end;

 begin
   RunDosInMemo('c:\autoexec.bat',Memo1);
  // RunDosInMemo('chkdsk.exe c:\',Memo1);
 end;


end.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
simonetCommented:
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
0
rwilson032697Commented:
Listening
0
brainwareCommented:
Listening..
0
jakubklosAuthor Commented:
Thanks guys, you were both great. It works.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.