Capture CMD output

procedure CaptureConsoleOutput(DosApp : string;AMemo : TMemo); 
const 
  ReadBuffer = 1048576;  // 1 MB Buffer 
var 
  Security            : TSecurityAttributes; 
  ReadPipe,WritePipe  : THandle; 
  start               : TStartUpInfo; 
  ProcessInfo         : TProcessInformation; 
  Buffer              : Pchar; 
  TotalBytesRead, 
  BytesRead           : DWORD; 
  Apprunning,n, 
  BytesLeftThisMessage, 
  TotalBytesAvail : integer; 
begin 
  with Security do 
  begin 
    nlength              := SizeOf(TSecurityAttributes); 
    binherithandle       := true; 
    lpsecuritydescriptor := nil; 
  end; 

  if CreatePipe (ReadPipe, WritePipe, @Security, 0) then 
  begin 
    // Redirect In- and Output through STARTUPINFO structure 

    Buffer  := AllocMem(ReadBuffer + 1); 
    FillChar(Start,Sizeof(Start),#0); 
    start.cb          := SizeOf(start); 
    start.hStdOutput  := WritePipe; 
    start.hStdInput   := ReadPipe; 
    start.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW; 
    start.wShowWindow := SW_HIDE; 

    // Create a Console Child Process with redirected input and output 

    if CreateProcess(nil      ,PChar(DosApp), 
                     @Security,@Security, 
                     true     ,CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, 
                     nil      ,nil, 
                     start    ,ProcessInfo) then 
    begin 
      n:=0; 
      TotalBytesRead:=0; 
      repeat 
        // Increase counter to prevent an endless loop if the process is dead 
        Inc(n,1); 
         
        // wait for end of child process 
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100); 
        Application.ProcessMessages; 

        // it is important to read from time to time the output information 
        // so that the pipe is not blocked by an overflow. New information 
        // can be written from the console app to the pipe only if there is 
        // enough buffer space. 

        if not PeekNamedPipe(ReadPipe        ,@Buffer[TotalBytesRead], 
                             ReadBuffer      ,@BytesRead, 
                             @TotalBytesAvail,@BytesLeftThisMessage) then break 
        else if BytesRead > 0 then 
          ReadFile(ReadPipe,Buffer[TotalBytesRead],BytesRead,BytesRead,nil); 
        TotalBytesRead:=TotalBytesRead+BytesRead; 
      until (Apprunning <> WAIT_TIMEOUT) or (n > 150); 

      Buffer[TotalBytesRead]:= #0; 
      OemToChar(Buffer,Buffer); 
      AMemo.Text := AMemo.text + StrPas(Buffer); 
    end; 
    FreeMem(Buffer); 
    CloseHandle(ProcessInfo.hProcess); 
    CloseHandle(ProcessInfo.hThread); 
    CloseHandle(ReadPipe); 
    CloseHandle(WritePipe); 
  end; 
end; 

Select allOpen in new window

//Approach 1:

unit Unit1;

interface

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

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

var
Form1: TForm1;
mCommand: string;
mOutputs: string;


implementation

{$R *.dfm}
function ExecuteCommand(CommandLine:string):string;
var
PROC: TProcessInformation;
Ret: LongBool;
START: TStartupInfo;
SA: TSecurityAttributes;
hReadPipe: THandle;
hWritePipe: THandle;
dBytesRead: DWORD;
sBuff: array[0..255] of Char;
begin
if Length(CommandLine) > 0 then
mCommand := CommandLine;
if Length(mCommand) = 0 then
begin
MessageBox(0, PChar('Command Line empty.'), PChar('Error'), MB_ICONEXCLAMATION);
Exit;
end;
SA.nLength := SizeOf(TSecurityAttributes);
SA.bInheritHandle := TRUE;
SA.lpSecurityDescriptor := nil;
Ret := CreatePipe(hReadPipe, hWritePipe, @SA, 0);
if not Ret then
begin
MessageBox(0, PChar('CreatePipe() failed.'), PChar('Error'), MB_ICONEXCLAMATION);
Exit;
end;
FillChar(START ,Sizeof(TStartupInfo), #0);
START.cb := SizeOf(TStartupInfo);
START.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
START.hStdOutput := hWritePipe;
START.hStdError := hWritePipe;
Ret := CreateProcess(nil, PChar(mCommand), @SA, @SA, TRUE, NORMAL_PRIORITY_CLASS, nil, nil, START, PROC);
if Ret <> TRUE then
begin
MessageBox(0, PChar('File or command not found.'), PChar('Error'), MB_ICONEXCLAMATION);
Exit;
end;
Ret := CloseHandle(hWritePipe);
mOutputs := '';
repeat
Ret := ReadFile(hReadPipe, sBuff, 255, dBytesRead, nil);
mOutputs := mOutputs + Copy(sBuff, 1, dBytesRead);
until Ret = FALSE;
Ret := CloseHandle(PROC.hProcess);
Ret := CloseHandle(PROC.hThread);
Ret := CloseHandle(hReadPipe);
ExecuteCommand := mOutputs
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(ExecuteCommand('netstat'));
end;
end.

Select allOpen in new window

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

//To test it, drop a TMemo, a TEdit and a TButton on a form. 
//Set the button's click event handler as follows:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Text := GetDosOutput(Edit1.Text);
end;

Select allOpen in new window