Z
zxwqh0971
Unregistered / Unconfirmed
GUEST, unregistred user!
200分求readfile读取管道问题,请高手指点!另100分在http://www.delphibbs.com/delphibbs/dispq.asp?lid=3056832 ( 积分: 100 )<br />function ExecAndWaitWithMemo(Filename, Params:String;AMemo:TMemo) : boolean;
const
ReadBuffer = 1024;
var
Security : TSecurityAttributes;
ReadPipe,WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
Apprunning : DWord;
ErrorFlag : Dword;
Buf : string;
Read_os : Toverlapped;
CmdLine : string;
begin
CmdLine:=filename+' '+params;
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;
Result := CreateProcess(nil,PChar(CmdLine),@Security,@Security,true,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
nil,nil,start,ProcessInfo);
if Result then
begin
NetSection := TCriticalSection.Create;
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess,1000);
Repeat
BytesRead := 0;
FillChar(Read_os,Sizeof(Read_os),#0);
Read_os.Internal := 0;
Read_os.InternalHigh := 0;
Read_os.Offset := 0;
Read_os.OffsetHigh := 0;
Read_os.hEvent := CreateEvent(@Security,true,False,nil);
//if ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,nil) then
NetSection.Acquire ;
if GetOverLappedResult(ReadPipe,Read_os,BytesRead,True) then
begin
ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,@Read_os);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
Buf := Buf + string(Buffer);
Application.ProcessMessages;
while pos(#10, Buf) > 0 do
begin
AMemo.Lines.Add(Copy(Buf, 1, pos(#10, Buf) - 1));
Delete(Buf, 1, pos(#10, Buf));
end;
end;
NetSection.Release ;
until (BytesRead < ReadBuffer);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
end;
FreeMem(Buffer);
CloseHandle(Read_Os.hEvent);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;
执行ExecAndWaitWithMemo('c:/test.bat','',Memo1)将批处理结果显示显示在memo1中,程序执行时有时发生没有响应的情况,跟踪发现程序进入ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,@Read_os)后就再也没有出来,请指点!
我查了ReadFile函数帮助,有这么一段提示:
ReadFile returns when one of the following is true: a write operation completes on the write end of the pipe, the number of bytes requested has been read, or an error occurs.
我的错误可能就出在这里,请高手指点一二,不胜感激!
const
ReadBuffer = 1024;
var
Security : TSecurityAttributes;
ReadPipe,WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
Apprunning : DWord;
ErrorFlag : Dword;
Buf : string;
Read_os : Toverlapped;
CmdLine : string;
begin
CmdLine:=filename+' '+params;
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;
Result := CreateProcess(nil,PChar(CmdLine),@Security,@Security,true,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
nil,nil,start,ProcessInfo);
if Result then
begin
NetSection := TCriticalSection.Create;
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess,1000);
Repeat
BytesRead := 0;
FillChar(Read_os,Sizeof(Read_os),#0);
Read_os.Internal := 0;
Read_os.InternalHigh := 0;
Read_os.Offset := 0;
Read_os.OffsetHigh := 0;
Read_os.hEvent := CreateEvent(@Security,true,False,nil);
//if ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,nil) then
NetSection.Acquire ;
if GetOverLappedResult(ReadPipe,Read_os,BytesRead,True) then
begin
ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,@Read_os);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
Buf := Buf + string(Buffer);
Application.ProcessMessages;
while pos(#10, Buf) > 0 do
begin
AMemo.Lines.Add(Copy(Buf, 1, pos(#10, Buf) - 1));
Delete(Buf, 1, pos(#10, Buf));
end;
end;
NetSection.Release ;
until (BytesRead < ReadBuffer);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
end;
FreeMem(Buffer);
CloseHandle(Read_Os.hEvent);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;
执行ExecAndWaitWithMemo('c:/test.bat','',Memo1)将批处理结果显示显示在memo1中,程序执行时有时发生没有响应的情况,跟踪发现程序进入ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,@Read_os)后就再也没有出来,请指点!
我查了ReadFile函数帮助,有这么一段提示:
ReadFile returns when one of the following is true: a write operation completes on the write end of the pipe, the number of bytes requested has been read, or an error occurs.
我的错误可能就出在这里,请高手指点一二,不胜感激!