• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 793
  • Last Modified:

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;
0
jakubklos
Asked:
jakubklos
1 Solution
 
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
 
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

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now