Capture the Output of a DOS application

posted 16 Mar 2010, 08:49 by Delphi Basics   [ updated 16 Mar 2010, 08:50 ]
{
  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'));

Comments