盒子论坛 v2.1

通过CreateProcess 调用cmd.exe来执行一个导出数据库数据的脚本。
下面这段代码在Win XP下都能执行没任何问题，
但在Win10下就有问题，在Win10下WaitForSingleObject每次反馈给wrResult的结果都是258(WAIT_TIMEOUT=258)。一直跳不出循环。

我用的Delphi XE

各位这是怎么回事?应该怎么修改？
代码如下：

procedure ReturnCommandResult(const Command :string; var ItemList :TStringList);
var
  hReadPipe: THandle;
  hWritePipe: THandle;
  SI: TStartUpInfo;
  PI: TProcessInformation;
  SA: TSecurityAttributes;
  BytesRead: DWORD;
  Dest: array[0..32767] of char;
  CmdLine: array[0..512] of char;
  Avail, ExitCode, wrResult: DWORD;
  osVer: TOSVERSIONINFO;
  tmpstr: AnsiString;
  Line: string;
  CommandHead :string;
  sCommand :string;
begin
  sCommand :=Lowercase(Command);

  SA.nLength := SizeOf(SA);
  SA.lpSecurityDescriptor := nil;
  SA.bInheritHandle := True;
  CreatePipe(hReadPipe, hWritePipe, @SA, 0);

  try
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(TStartUpInfo);
    SI.wShowWindow := SW_HIDE;
    SI.dwFlags := STARTF_USESHOWWINDOW;
    SI.dwFlags := SI.dwFlags or STARTF_USESTDHANDLES;
    SI.hStdOutput := hWritePipe;
    SI.hStdError := hWritePipe;

    sCommand :='cmd.exe /c '+Command;
    StrPCopy(CmdLine, sCommand);

    if CreateProcess(nil, CmdLine, nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then
      begin
        ExitCode := 0;

        while ExitCode = 0 do
          begin
          wrResult := WaitForSingleObject(PI.hProcess, 1000);

          if PeekNamedPipe(hReadPipe, @Dest[0], 32768, @Avail, nil, nil) then
          begin
          if Avail > 0 then
          begin
          try
          FillChar(Dest, SizeOf(Dest), 0);
          ReadFile(hReadPipe, Dest[0], Avail, BytesRead, nil);
          TmpStr := Copy(Dest, 0, BytesRead - 1);
          Line := Line + TmpStr;
          except
          end;
          end;
          end;
          if wrResult<>WAIT_TIMEOUT then
          ExitCode := 1;
          end;
        GetExitCodeProcess(PI.hProcess, ExitCode);
        CloseHandle(PI.hProcess);
        CloseHandle(PI.hThread);
      end;
  finally
    ShowMessage('a');
    if Line = '' then
     Line :='命令没有输出回应!';
    ItemList.Text := Line;
    CloseHandle(hReadPipe);
    CloseHandle(hWritePipe);
  end;
end;
----------------------------------------------
-

信息

登陆以后才能回复