Capture the Output of a DOS application

Post date: Mar 16, 2010 3:49:42 PM

{

Unit: uDOSOutput

Author: Marco Pipino

Description: Capture the Output of a DOS application

Original: freevbcode.com/ShowCode.asp?ID=3957

Ported by: steve10120

Website: hackhound.org

History: First try

}

unit uDOSOutput;
interface
uses Windows;
function ExecuteCommand(CommandLine:string):string;
var
  mCommand: string;
  mOutputs: string;
implementation
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;
end.

Usage:

ShowMessage(ExecuteCommand('netstat'));