捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  沪ICP备05001939号 DELPHI盒子 | 盒子论坛 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 论坛检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
StdIORedirect执行dos命令的控件(无下载)
关键字:StdIORedirect dos
来 自:原创
平 台:Win2k/XP/NT,Win2003 下载所需:0 火柴
深浅度:中级 完成时间:2009/11/1
发布者:xuchuantao17 发布时间:2009/11/2
编辑器:DELPHI7 语  种:简体中文
分 类:系统 下载浏览:480/12139
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名:
 密 码:
自动登陆(30天有效)
图片如果打不开,说明流量不够了,请稍候下载……
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;     
    
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;
  
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.
Google
 
本站原创作品,未经作者许可,严禁任何方式转载;转载作品,如果侵犯了您的权益,请联系我们
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
 相关文章
没有相关文章
相关评论
共有评论3条 当前显示最后3条评论
qufo 2009/11/3 10:17:17
真怀疑文件头是原版自带的还是某好事者“翻译”上去的。保留个原文也好呀。
zhahongyi 2009/11/3 12:46:33
{ *==========*
  |   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;

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;

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.
hujiacheng 2009/12/30 15:07:55
demos失效。。郁闷呢。。呵呵。
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 1999-2023 V4.01 粤ICP备10103342号-1 更新RSS列表