2014-10-18 117 views
-1

我使用这个函数从DelphiDabbler得到dos输出在德尔福。但是如果这个过程需要很长时间(例如:gammu getussd命令),它会导致我的应用程序暂时没有响应。
如何避免这种情况?获取非阻塞命令行输出

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string; 
var 
    SA: TSecurityAttributes; 
    SI: TStartupInfo; 
    PI: TProcessInformation; 
    StdOutPipeRead, StdOutPipeWrite: THandle; 
    WasOK: Boolean; 
    Buffer: array[0..255] of AnsiChar; 
    BytesRead: Cardinal; 
    WorkDir: string; 
    Handle: Boolean; 
begin 
    Result := ''; 
    with SA do begin 
    nLength := SizeOf(SA); 
    bInheritHandle := True; 
    lpSecurityDescriptor := nil; 
    end; 
    CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0); 
    try 
    with SI do 
    begin 
     FillChar(SI, SizeOf(SI), 0); 
     cb := SizeOf(SI); 
     dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; 
     wShowWindow := SW_HIDE; 
     hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin 
     hStdOutput := StdOutPipeWrite; 
     hStdError := StdOutPipeWrite; 
    end; 
    WorkDir := Work; 
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine), 
          nil, nil, True, 0, nil, 
          PChar(WorkDir), SI, PI); 
    CloseHandle(StdOutPipeWrite); 
    if Handle then 
     try 
     repeat 
      WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil); 
      if BytesRead > 0 then 
      begin 
      Buffer[BytesRead] := #0; 
      Result := Result + Buffer; 
      end; 
     until not WasOK or (BytesRead = 0); 
     WaitForSingleObject(PI.hProcess, INFINITE); 
     finally 
     CloseHandle(PI.hThread); 
     CloseHandle(PI.hProcess); 
     end; 
    finally 
    CloseHandle(StdOutPipeRead); 
    end; 
end; 

作者:乔Donth

回答

4

您可以使用一个简单的线程这一点,得到的结果在OnTerminate事件,这将在主线程的上下文中运行,因此不需要furthor同步:

Type 
    TMyThread = Class(TThread) 
    private 
    FCmd: String; 
    FResult: String; 
    protected 
    Procedure Execute; override; 
    public 
    Constructor Create(const cmd: String;Notity:TNotifyEvent); 
    Property Result: String Read FResult; 
    End; 
    { TMyTHread } 

constructor TMyThread.Create(const cmd: String;Notity:TNotifyEvent); 
begin 
    inherited Create(false); 
    FCmd := cmd; 
    FreeOnTerminate := True; 
    OnTerminate := Notity; 
end; 

procedure TMyThread.Execute; 
begin 
    inherited; 
    FResult := GetDosOutput(FCmd); 
end; 

procedure TForm3.ThreadTerminated(Sender: TObject); 
begin 
    Memo1.Lines.Text := TMyThread(Sender).Result; 
end; 

procedure TForm3.Button1Click(Sender: TObject); 
begin 
    TMyThread.Create('DIR',ThreadTerminated); 
end; 
+3

在线程启动后设置'OnTerminate'处理程序是不安全的。线程在设置处理程序之前有完成的风险。相反,将它添加到Create构造函数中。 – 2014-10-18 19:27:43

+0

@LURD感谢您的建议。 – bummi 2014-10-18 21:18:33