谁能给一个捕获控制台程序输出的代码阿 bcb 的也行

[under]

谁能给一个捕获控制台程序输出的代码阿 bcb 的也行
好像是用管道重定向 标准输出 可具体我不会了，大家帮帮忙给段代码啊

[sxf_zero]

//---------------------------------------------------------------------------

#include <vcl.h>
#pragma hdrstop

#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------
typedef struct _TFPARAM
{
HANDLE hReadPipe;
HWND hEdit;
} TFPARAM,*LPTFPARAM;
DWORD __stdcall ThreadFunc(LPVOID);
void __stdcall ConsoleExecute(LPTSTR lpszAppName,LPTSTR lpszCmdLine,HWND hEdit)
{
HANDLE hCurrentProcess,hReadPipe,hWritePipe,hWritePipe2;
STARTUPINFO si;
PROCESS_INFORMATION pi;
LPTFPARAM lptfParam;
DWORD idThread;
CreatePipe(&hReadPipe,&hWritePipe,NULL,0);/*创建管道*/
hCurrentProcess=GetCurrentProcess();
//hCurrentProcess=GetModuleHandle(0);
DuplicateHandle(hCurrentProcess,hReadPipe,
hCurrentProcess,NULL,0,FALSE,DUPLICATE_SAME_ACCESS);
DuplicateHandle(hCurrentProcess,hWritePipe,
hCurrentProcess,&hWritePipe2,0,TRUE,DUPLICATE_SAME_ACCESS);
/*复制管道以传递给控制台程序*/
ZeroMemory(&si,sizeof si);
si.cb=sizeof(STARTUPINFO);
si.dwFlags=STARTF_USESTDHANDLES|STARTF_USESHOWWINDOW;
si.wShowWindow=SW_HIDE;
si.hStdOutput=hWritePipe2;
CreateProcess(lpszAppName,lpszCmdLine ,NULL,NULL,TRUE,0,
NULL,NULL,&si,&pi);/*运行控制台程序*/
lptfParam=(LPTFPARAM)malloc(sizeof(TFPARAM));
lptfParam->hEdit=hEdit;
lptfParam->hReadPipe=hReadPipe;
CreateThread(NULL,0,ThreadFunc,lptfParam,0,&idThread);
/*创建一个线程读取控制台输出*/
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
CloseHandle(hWritePipe);
CloseHandle(hWritePipe2);
}
DWORD __stdcall ThreadFunc(LPVOID lptfParam)
{
DWORD count;
LPSTR buf=(char *)malloc(4096),/*存储输出内容，不够可以扩大*/
pb=buf;
while(TRUE)
{
if(!ReadFile(((LPTFPARAM)lptfParam)->hReadPipe,pb,1024,&count,NULL))
if(GetLastError()==ERROR_BROKEN_PIPE)break;
pb+=count;
}/*读入控制台程序的输出*/
*pb=0;
SetWindowText(((LPTFPARAM)lptfParam)->hEdit,buf);
CloseHandle(((LPTFPARAM)lptfParam)->hReadPipe);
free(lptfParam);
free(buf);
return 0;
}

//------------------------------------------------------------------

void __fastcall TForm1::BitBtn1Click(TObject *Sender)
{
HWND hwnd;
hwnd=Memo1->Handle;
ConsoleExecute(NULL,"command /? ",hwnd);
}
//---------------------------------------------------------------------------

[TechnoFantasy]

Capture the output from a DOS (command/console) Window

procedure TForm1.Button1Click(Sender: TObject) ;

procedure RunDosInMemo(DosApp:String;AMemo:TMemo) ;
const
ReadBuffer = 2400;
var
Security : TSecurityAttributes;
ReadPipe,WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
Apprunning : DWord;
begin
With Security do begin
nlength := SizeOf(TSecurityAttributes) ;
binherithandle := true;
lpsecuritydescriptor := nil;
end;
if Createpipe (ReadPipe, WritePipe,
@Security, 0) then begin
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;

if CreateProcess(nil,
PChar(DosApp),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
then
begin
repeat
Apprunning := WaitForSingleObject
(ProcessInfo.hProcess,100) ;
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT) ;
Repeat
BytesRead := 0;
ReadFile(ReadPipe,Buffer[0],
ReadBuffer,BytesRead,nil) ;
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer) ;
AMemo.Text := AMemo.text + String(Buffer) ;
until (BytesRead < ReadBuffer) ;
end;
FreeMem(Buffer) ;
CloseHandle(ProcessInfo.hProcess) ;
CloseHandle(ProcessInfo.hThread) ;
CloseHandle(ReadPipe) ;
CloseHandle(WritePipe) ;
end;
end;

begin {button 1 code}
RunDosInMemo('chkdsk.exe c:\',Memo1) ;
end;

[TechnoFantasy]

原文连接：

http://delphi.about.com/cs/adptips2001/a/bltip0201_2.htm

[ly_liuyang]

网上下载吧,很多的

推荐StdIORedirect控件

Public methods and properties:
|
|
|
| procedure Run (fileName, cmdLine, directory : string);
|
| Run a program with redirected output
|
| procedure AddInputText (const st : string);
|
| Add a line of text to be sent to the application's STDIN
|
| procedure Terminate;
|
| Terminate the program started with 'Run'
|
| property ReturnValue : DWORD read fReturnValue;
property OutputText : TStrings read fOutputText;
property ErrorText : TStrings read fErrorText;
property Running : boolean read fRunning;


published
property OnOutputText : TOnText read fOnOutputText write fOnOutputText;
property OnErrorText : TOnText read fOnErrorText write fOnErrorText;
property OnTerminate : TNotifyEvent read fOnTerminate write
fOnTerminate;

*===========================================================================
*)


unit StdIORedirect;

interface

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

type
TOnText = procedure (sender : TObject; st : string) of object;
TStdIORedirect = class(TComponent)
private
fErrorRead: THandle;
fOutputRead: THandle;
fInputWrite: THandle;

fErrorWrite : THandle;
fOutputWrite : THandle;
fInputRead : THandle;
fProcessInfo : TProcessInformation;
fReturnValue: DWORD;

fOutputLineBuff : string;
fErrorLineBuff : string;

fErrorText: TStrings;
fOutputText: TStrings;
fInputText : TStrings;

fOutputStream : TStream;
fErrorStream : TStream;

fOutputStreamPos : Integer;
fErrorStreamPos : Integer;

fOnErrorText: TOnText;
fOnOutputText: TOnText;

fInputEvent : TEvent;
fRunning: boolean;
fOnTerminate: TNotifyEvent;

procedure CreateHandles;
procedure DestroyHandles;
procedure HandleOutput;
{ Private declarations }
protected
property StdOutRead : THandle read fOutputRead;
property StdInWrite : THandle read fInputWrite;
property StdErrRead : THandle read fErrorRead;
procedure PrepareStartupInformation (var info : TStartupInfo);

public
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;

procedure Run (fileName, cmdLine, directory : string);
procedure AddInputText (const st : string);
procedure Terminate;

property ReturnValue : DWORD read fReturnValue;
property OutputText : TStrings read fOutputText;
property ErrorText : TStrings read fErrorText;
property Running : boolean read fRunning;

published
property OnOutputText : TOnText read fOnOutputText write fOnOutputText;
property OnErrorText : TOnText read fOnErrorText write fOnErrorText;
property OnTerminate : TNotifyEvent read fOnTerminate write fOnTerminate;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Custom', [TStdIORedirect]);
end;

type
TStdIOInputThread = class (TThread)
private
fParent : TStdIORedirect;
protected
procedure Execute; override;
public
constructor Create (AParent : TStdIORedirect);
end;

TStdIOOutputThread = class (TThread)
private
fParent : TStdIORedirect;
protected
procedure Execute; override;
public
constructor Create (AParent : TStdIORedirect);
end;

{ TStdIORedirect }

procedure TStdIORedirect.AddInputText(const st: string);
begin
fInputText.Add(st);
fInputEvent.SetEvent
end;

constructor TStdIORedirect.Create(AOwner: TComponent);
begin
inherited Create (AOwner);
fOutputText := TStringList.Create;
fErrorText := TStringList.Create;
fInputText := TStringList.Create;
fInputEvent := TEvent.Create (Nil, False, False, '');
end;

procedure TStdIORedirect.CreateHandles;
var
sa : TSecurityAttributes;
hOutputReadTmp, hErrorReadTmp, hInputWriteTmp : THandle;

begin
DestroyHandles;

sa.nLength := sizeof (sa);
sa.lpSecurityDescriptor := Nil;
sa.bInheritHandle := True;

if not CreatePipe (hOutputReadTmp, fOutputWrite, @sa, 0) then
RaiseLastWin32Error;

if not CreatePipe (hErrorReadTmp, fErrorWrite, @sa, 0) then
RaiseLastWin32Error;

if not CreatePipe (fInputRead, hInputWriteTmp, @sa, 0) then
RaiseLastWin32Error;

if not DuplicateHandle (GetCurrentProcess, hOutputReadTmp,
GetCurrentProcess, @fOutputRead, 0, FALSE, DUPLICATE_SAME_ACCESS) then
RaiseLastWin32Error;

if not DuplicateHandle (GetCurrentProcess, hErrorReadTmp,
GetCurrentProcess, @fErrorRead, 0, FALSE, DUPLICATE_SAME_ACCESS) then
RaiseLastWin32Error;

if not DuplicateHandle (GetCurrentProcess, hInputWriteTmp,
GetCurrentProcess, @fInputWrite, 0, FALSE, DUPLICATE_SAME_ACCESS) then
RaiseLastWin32Error;

CloseHandle (hOutputReadTmp);
CloseHandle (hErrorReadTmp);
CloseHandle (hInputWriteTmp);

fOutputStream := TMemoryStream.Create;
fErrorStream := TMemoryStream.Create;
fOutputStreamPos := 0;
fErrorStreamPos := 0;

fOutputText.Clear;
fErrorText.Clear;
end;

destructor TStdIORedirect.Destroy;
begin
DestroyHandles;
fOutputText.Free;
fErrorText.Free;
fInputEvent.Free;
fInputText.Free;
inherited;
end;

[ly_liuyang]

procedure TStdIORedirect.DestroyHandles;
begin
if fInputRead <> 0 then CloseHandle (fInputRead);
if fOutputRead <> 0 then CloseHandle (fOutputRead);
if fErrorRead <> 0 then CloseHandle (fErrorRead);

if fInputWrite <> 0 then CloseHandle (fInputWrite);
if fOutputWrite <> 0 then CloseHandle (fOutputWrite);
if fErrorWrite <> 0 then CloseHandle (fErrorWrite);

fInputRead := 0;
fOutputRead := 0;
fErrorRead := 0;

fInputWrite := 0;
fOutputWrite := 0;
fErrorWrite := 0;

fErrorStream.Free; fErrorStream := Nil;
fOutputStream.Free; fOutputStream := Nil;
end;

procedure TStdIORedirect.HandleOutput;
var
ch : char;
begin
fOutputStream.Position := fOutputStreamPos;

while fOutputStream.Position < fOutputStream.Size do
begin
fOutputStream.Read (ch, sizeof (ch));
case ch of
#13 :
begin
fOutputText.Add (fOutputLineBuff);
if Assigned (OnOutputText) then
OnOutputText (self, fOutputLineBuff);
fOutputLineBuff := '';
end;

#0..#12, #14..#31 :;

else
fOutputLineBuff := fOutputLineBuff + ch
end;
end;

fOutputStreamPos := fOutputStream.Position;

fErrorStream.Position := fErrorStreamPos;

while fErrorStream.Position < fErrorStream.Size do
begin
fErrorStream.Read (ch, sizeof (ch));
case ch of
#13 :
begin
fErrorText.Add (fErrorLineBuff);
if Assigned (OnErrorText) then
OnErrorText (self, fErrorLineBuff);
fErrorLineBuff := '';
end;

#0..#12, #14..#31 :;

else
fErrorLineBuff := fErrorLineBuff + ch
end;
end;

fErrorStreamPos := fErrorStream.Position;

end;

procedure TStdIORedirect.PrepareStartupInformation(
var info: TStartupInfo);
begin
info.cb := sizeof (info);
info.dwFlags := info.dwFlags or STARTF_USESTDHANDLES;
info.hStdInput := fInputRead;
info.hStdOutput := fOutputWrite;
info.hStdError := fErrorWrite;
end;

procedure TStdIORedirect.Run(fileName, cmdLine, directory: string);
var
startupInfo : TStartupInfo;
pOK : boolean;
fName, cLine, dir : PChar;
begin
if not Running then
begin
FillChar (startupInfo, sizeof (StartupInfo), 0);
CreateHandles;
PrepareStartupInformation (startupInfo);

if fileName <> '' then fName := PChar (fileName) else fName := Nil;
if cmdLine <> '' then cLine := PChar (' '+cmdLine) else cLine := Nil;
if directory <> '' then dir := PChar (directory) else dir := Nil;

pOK := CreateProcess (fName, cLine, Nil, Nil, True,
CREATE_NO_WINDOW, Nil, dir, startupInfo, fProcessInfo);

CloseHandle (fOutputWrite); fOutputWrite := 0;
CloseHandle (fInputRead); fInputRead := 0;
CloseHandle (fErrorWrite); fErrorWrite := 0;

if pOK then
begin
fRunning := True;
try
TStdIOInputThread.Create (self);
TStdIOOutputThread.Create (self);
while MsgWaitForMultipleObjects (1, fProcessInfo.hProcess, False,
INFINITE, QS_ALLINPUT) = WAIT_OBJECT_0 + 1 do
Application.ProcessMessages;

if not GetExitCodeProcess (fProcessInfo.hProcess, fReturnValue) then
RaiseLastWin32Error;


finally
fInputText.Clear;
CloseHandle (fProcessInfo.hThread);
CloseHandle (fProcessInfo.hProcess);
fRunning := False;
if Assigned (OnTerminate) then
OnTerminate (self);
end;
end
else RaiseLastWin32Error;
end;
end;

procedure TStdIORedirect.Terminate;
begin
if Running then TerminateProcess (fProcessInfo.hProcess, 0);
end;

{ TStdIOInputThread }

constructor TStdIOInputThread.Create(AParent: TStdIORedirect);
begin
inherited Create (True);
FreeOnTerminate := True;
fParent := AParent;
Resume;
end;

function CopyTextToPipe (handle : THandle; text : TStrings) : boolean;
var
i : Integer;
st : string;
bytesWritten : DWORD;
p : Integer;
bTerminate : boolean;
begin
bTerminate := False;
for i := 0 to text.Count - 1 do
begin
st := text [i];
p := Pos (#26, st);
if p > 0 then
begin
st := Copy (st, 1, p - 1);
bTerminate := True;
end
else
st := st + #13#10;

if st <> '' then
if not WriteFile (handle, st [1], Length (st), bytesWritten, Nil) then
if GetLastError <> ERROR_NO_DATA then
RaiseLastWin32Error;

end;
result := bTerminate;
text.Clear;
end;

procedure TStdIOInputThread.Execute;
var
objects : array [0..1] of THandle;
objectNo : DWORD;
begin
if fParent.fInputText.Count > 0 then
fParent.fInputEvent.SetEvent;

objects [0] := fParent.fProcessInfo.hProcess;
objects [1] := fParent.fInputEvent.Handle;

while True do
begin
objectNo := WaitForMultipleObjects (2, @objects [0], False, INFINITE);

case objectNo of
WAIT_OBJECT_0 + 1 :
if CopyTextToPipe (fParent.fInputWrite, fParent.fInputText) then
begin
CloseHandle (fParent.fInputWrite);
fParent.fInputWrite := 0;
break;
end;
else
break;
end;
end;
end;

{ TStdIOOutputThread }

constructor TStdIOOutputThread.Create(AParent: TStdIORedirect);
begin
inherited Create (True);
FreeOnTerminate := True;
fParent := AParent;
Resume;
end;

procedure TStdIOOutputThread.Execute;
var
buffer : array [0..1023] of char;
bytesRead : DWORD;

begin
while ReadFile (fParent.fOutputRead, buffer, 1024, bytesRead, Nil) and
(bytesRead > 0) do
begin
fParent.fOutputStream.Seek (0, soFromEnd);
fParent.fOutputStream.Write (buffer [0], bytesRead);
Synchronize (fParent.HandleOutput)
end;
end;

end.

http://lysoft.7u7.net