各位好，我刚刚学delphi，现在要写个程序捕获程序的输出，
试了一些网上的例子，有些不行，有些不能实时的显示找了stdioredirect的源代码，但不知道如何使用，请各位提示一下usestdioredirect
..................procedure TForm1.Button1Click(Sender: TObject);
var
a: TStdIORedirect;
begin
a := TStdIORedirect.Create(这里如何写？);
a.Run('ping',' http://www.163.com','');
a.AddInputText(memo1.Text);
end;下面的
a.Run('ping',' http://www.163.com','');
a.AddInputText(memo1.Text);是这样用的吗？
试了一些网上的例子，有些不行，有些不能实时的显示找了stdioredirect的源代码，但不知道如何使用，请各位提示一下usestdioredirect
..................procedure TForm1.Button1Click(Sender: TObject);
var
a: TStdIORedirect;
begin
a := TStdIORedirect.Create(这里如何写？);
a.Run('ping',' http://www.163.com','');
a.AddInputText(memo1.Text);
end;下面的
a.Run('ping',' http://www.163.com','');
a.AddInputText(memo1.Text);是这样用的吗？
下面有个例子不知道是不是你想要的
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;
刚学delphi就先学学语法吧
我也没用过StdIORedirect控件
以前听说过
这个我试过，不能实时输出的@ahjoe：
现在急用，不允许我慢慢学习啊
我是不知道如何声明与初始化这个StdIORedirect下面是StdIORedirect的源代码：{*===========================================================================*
| StdIORedirect
|
|
|
| Component to get output from and provide input to command line apps
|
|
|
| Copyright (C) Colin Wilson 1999. All rights reserved
|
|
|
| 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;
{$WARN SYMBOL_DEPRECATED OFF}
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('Misc Units', [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;
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;
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;
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.