求救：在程序中使用CreateProcess执行其他程序，导致调用的程序处死假死状态！！

Question

在程序中使用CreateProcess运行其他exe文件，在调用的exe文件运行期间，程序处于假死状态，有没有办法可以处理呢？
例如对于idftp.get()可以在idftpword事件中
使用  Application.processmessages;就可以不出现假死状态Result:=CreateProcess(nil,PChar(CmdLine),nil,nil,false,
        CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
        nil,PCHAR(ExtractFilePath(ExeFile)),SUInfo,
        ProcInfo);  

Answer 1

procedure CheckResult(b: Boolean);
begin
  if not b then
    Raise Exception.Create(SysErrorMessage(GetLastError));
end;function RunDOS(const Prog, CommandLine,Dir: String;var ExitCode:DWORD): String;
var
  HRead,HWrite:THandle;
  StartInfo:TStartupInfo;
  ProceInfo:TProcessInformation;
  b:Boolean;
  sa:TSecurityAttributes;
  inS:THandleStream;
  sRet:TStrings;
begin
  Result := ';
  FillChar(sa,sizeof(sa),0);
  //设置允许继承，否则在NT和2000下无法取得输出结果
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := True;
  sa.lpSecurityDescriptor := nil;
  b := CreatePipe(HRead,HWrite,@sa,0);
  CheckResult(b);
  FillChar(StartInfo,SizeOf(StartInfo),0);
  StartInfo.cb := SizeOf(StartInfo);
  StartInfo.wShowWindow := SW_HIDE;
  //使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
  StartInfo.dwFlags := STARTF_USESTDHANDLES+STARTF_USESHOWWINDOW;
  StartInfo.hStdError := HWrite;
  StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);//HRead;
  StartInfo.hStdOutput := HWrite;
  b := CreateProcess(PChar(Prog),//lpApplicationName: PChar
        PChar(CommandLine), //lpCommandLine: PChar
        nil, //lpProcessAttributes: PSecurityAttributes
        nil, //lpThreadAttributes: PSecurityAttributes
        True, //bInheritHandles: BOOL
        CREATE_NEW_CONSOLE,
        nil,
        PChar(Dir),
        StartInfo,
        ProceInfo );
  CheckResult(b);
  WaitForSingleObject(ProceInfo.hProcess,INFINITE);
  GetExitCodeProcess(ProceInfo.hProcess,ExitCode);
  inS := THandleStream.Create(HRead);
  if inS.Size>0 then
  begin
    sRet := TStringList.Create;
    sRet.LoadFromStream(inS);
    Result := sRet.Text;
    sRet.Free;
  end;
  inS.Free;
  CloseHandle(HRead);
  CloseHandle(HWrite);
end;

Answer 2

同意  iBear(大熊 不要怀疑我的温柔) ，
使用线程，那样WaitForSingleObject时，UI不会失去响应能力。

Answer 3

最后将WaitForSingleObject的等待时间修改后循环等待，也算解决了。// WaitForSingleObject(ProcInfo.hProcess,INFINITE);
    repeat    //这个避免主程序假死
      ret:=WaitforSingleObject(ProcInfo.hProcess,100); //等待
      Application.ProcessMessages;
    until ret<>Wait_Timeout;
function ExecAndWait(const ExeFile,Params:String;WNDState:Word;var excode:DWord):boolean;
var
  SUInfo:TStartupInfo;
  ProcInfo:TProcessInformation;
  CmdLine:string;
  ret :integer;
  rtnex:bool;
begin
  CmdLine:=ExeFile+' '+Params;
  FillChar(SUInfo,sizeof(SUInfo),#0);
  with SUInfo do
  begin
    cb:=sizeof(SUInfo);
    dwFlags:=STARTF_USESHOWWINDOW;
    wShowWindow:=WNDState;
  end;
  Result:=CreateProcess(nil,PChar(CmdLine),nil,nil,false,
         CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
         nil,PCHAR(ExtractFilePath(ExeFile)),SUInfo,
         ProcInfo);
  if Result then
  begin
   // WaitForSingleObject(ProcInfo.hProcess,INFINITE);
    repeat    //这个避免主程序假死
      ret:=WaitforSingleObject(ProcInfo.hProcess,100); //等待
      Application.ProcessMessages;
    until ret<>Wait_Timeout;    rtnex := GetExitCodeProcess(ProcInfo.hProcess,excode);
    if not rtnex then  result := false;    CloseHandle(ProcInfo.hProcess);
    CloseHandle(ProcInfo.hThread);
  end;
end;