C
CD不快乐
Unregistered / Unconfirmed
GUEST, unregistred user!
我通过命名管道调用了一个ＤＯＳ程序，代码如下，但请教如何才能实时得到ＤＯＳ的执行信息呢，而不是执行完再返回。分就这么多了，实在是不好意思。
代码:
procedure TForm1.RunDosInMemo(const DosApp:string;Amemo:TMemo);
const
ReadBuffer=2400; //设置ReadBuffer的大小
var
Security:TSecurityAttributes;
ReadPipe,WritePipe:THandle;
start:TStartUpInfo;
ProcessInfo:TProcessInformation;
Buffer:PChar;
BytesRead:DWord;
Buf:string;
begin
with Security do
begin
nlength:=sizeof(TSecurityAttributes);
binherithandle:=true;
lpsecuritydescriptor:=nil;
end;
{创建一个命名管道来捕获Console的输出}
if CreatePipe(ReadPipe,WritePipe,@Security,0) then
begin
Buffer:=AllocMem(ReadBuffer+1);
FillChar(Start,Sizeof(Start),#0);
{设置Console程序的启动属性}
with Start do
begin
cb:=sizeof(start);
start.lpReserved:=nil;
lpDesktop:=nil;
lpTitle:=nil;
dwX:=0;
dwY:=0;
dwXSize:=0;
dwYSize:=0;
dwXCountChars:=0;
dwYCountChars:=0;
dwFillAttribute:=0;
hStdOutput:=WritePipe; //将输出定向到建立的WritePipe上
hStdInput:=ReadPipe; //将输入定向到建立的ReadPipe上
hStdError:=WritePipe; //将错误输出定向到建立的WritePipe上
dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
wshowwindow:=SW_HIDE; //设置窗口为hide
end;
try
{创建一个子进程，运行Console}
if CreateProcess(nil,PChar(DosApp),@Security,@Security,true,
NORMAL_PRIORITY_CLASS,
nil,nil,start,ProcessInfo)then
begin
Application.ProcessMessages;
{等待进程运行结束}
WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
{关闭程序...开始没有关掉它，如果没有输出的话，程序死掉了。}
closeHandle(WritePipe);
buf:='';
{读取Console的输出}
repeat
bytesRead:=0;
ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,nil);
Buffer[BytesRead]:=#0;
OemToAnsi(Buffer,Buffer);
Buf:=Buf+String(Buffer);
Application.ProcessMessages;
until(bytesRead<ReadBuffer);
//sendDebug(Buf);
{按照换行符进行切割，并在Memo中显示出来}
while pos(#10,buf)>0 do
begin
AMemo.Lines.Add(Copy(Buf,1,Pos(#10,buf)-1));
Delete(Buf,1,Pos(#10,buf));
Application.ProcessMessages;
end;
end;
finally
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RunDosInMemo('ping 127.0.0.1 -t',Amemo);
end;