Multithreading 线程同步DOS输出

Multithreading 线程同步DOS输出,multithreading,delphi,Multithreading,Delphi,我有一个cmd,它将不断地、不间断地向我返回值,我不知道如何获取这些值并将其设置为字符串以发送TMemo 获取cmd结果的代码: function GetDosOutput(CMD: string; Dir: string = 'C:\'): string; var SA: TSecurityAttributes; SI: TStartupInfo; PI: TProcessInformation; StdOutPipeRead, StdOutPipeWrite:

我有一个cmd,它将不断地、不间断地向我返回值,我不知道如何获取这些值并将其设置为字符串以发送TMemo

获取cmd结果的代码:

 function GetDosOutput(CMD: string; Dir: string = 'C:\'): string;
  var
   SA: TSecurityAttributes;
   SI: TStartupInfo;
   PI: TProcessInformation;
   StdOutPipeRead, StdOutPipeWrite: THandle;
   Handle, WasOK: Boolean;
   Buffer: array[0..255] of AnsiChar;
   BytesRead: Cardinal;
   utf8: UTF8String;
 begin
  Result := '';
  SA.nLength := SizeOf(SA);
  SA.bInheritHandle := True;
  SA.lpSecurityDescriptor := nil;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);

  try
     FillChar(SI, SizeOf(SI), 0);
     SI.cb := SizeOf(SI);
     SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
     SI.wShowWindow := SW_HIDE;
     SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
     SI.hStdOutput := StdOutPipeWrite;
     SI.hStdError := StdOutPipeWrite;

     Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CMD), nil, nil, True,
     0, nil, pchar(Dir), SI, PI);
     CloseHandle(StdOutPipeWrite);
     if Handle then
       try
         repeat
           WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
           if BytesRead > 0 then begin
             Buffer[BytesRead] := #0;
             utf8:= Result + String(Buffer);
             Result:= utf8;
           end;
         until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
       finally
         CloseHandle(PI.hThread);
         CloseHandle(PI.hProcess);
       end;
   finally
     CloseHandle(StdOutPipeRead);
   end;
 end;
我不能等到线程结束,因为结果不会停止更新,线程永远不会完成,只需要在运行时更新。
我试图使用同步坏没有工作。我怎样才能继续

我的代码:

type
 TThread_DOS = class(TThread)
  private
   FCmd: string;
   FResult: string;
  protected
   procedure Execute; override;
  public
   Constructor Create(const cmd: string; Notify: TNotifyEvent);
   property Result: string read FResult;
   property CMD: string read FCmd;
 end;

constructor TThread_DOS.Create(const cmd: string; Notify: TNotifyEvent);
 begin
  inherited Create(false);
  FCmd:= cmd;
  FreeOnTerminate:= true;
  OnTerminate:= Notify;
 end;

procedure TThread_DOS.Execute;
 begin
  inherited;
  FResult:= (GetDosOutput(FCmd));
 end;
试一试 示例使用备忘录:

procedure TForm1.DosCommand1NewLine(ASender: TObject; const ANewLine: string;
  AOutputType: TOutputType);
begin
  case AOutputType of
    otEntireLine:
      Memo1.Lines.Add(ANewLine);
  end;
end;

创建一个TThread类,并将TMemo和您的参数传递给它,让它为您做任何事情

每次需要显示结果时,都可以通过同步来显示

例如:

unit ThreadUnit;

interface

Uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  VCL.StdCtrls;

type
 TMyThread = class(TThread)
 private
  FMemo : TMemo;
  FCMD : String;
  FDir : String;
 public
  constructor Create(var ResultMemo : TMemo; CMD, Dir : String);
 protected
  procedure Execute; override;
 end;

implementation

{ TMyThread }

constructor TMyThread.Create(var ResultMemo : TMemo; CMD, Dir : String);
begin
 Inherited Create(True);

 FreeOnTerminate := True;

 FMemo := ResultMemo;
 FCMD := CMD;

 if Dir = '' then
  FDir := 'C:\'
 else
  FDir := Dir;
end;

procedure TMyThread.Execute;
  var
   SA: TSecurityAttributes;
   SI: TStartupInfo;
   PI: TProcessInformation;
   StdOutPipeRead, StdOutPipeWrite: THandle;
   Handle, WasOK: Boolean;
   Buffer: array[0..255] of AnsiChar;
   BytesRead: Cardinal;
   utf8: UTF8String;

   Result : String;
 begin
  Result := '';
  SA.nLength := SizeOf(SA);
  SA.bInheritHandle := True;
  SA.lpSecurityDescriptor := nil;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);

  try
     FillChar(SI, SizeOf(SI), 0);
     SI.cb := SizeOf(SI);
     SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
     SI.wShowWindow := SW_HIDE;
     SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
     SI.hStdOutput := StdOutPipeWrite;
     SI.hStdError := StdOutPipeWrite;

     Handle := CreateProcess(nil, PChar('cmd.exe /C ' + FCMD), nil, nil, True,
     0, nil, pchar(FDir), SI, PI);
     CloseHandle(StdOutPipeWrite);
     if Handle then
       try
         repeat
           WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
           if BytesRead > 0 then begin
             Buffer[BytesRead] := #0;
             utf8:= Result + String(Buffer);
             Result:= utf8;

             Synchronize(procedure
                         begin
                          FMemo.Lines.Add(Result);
                         end);
           end;
         until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
       finally
         CloseHandle(PI.hThread);
         CloseHandle(PI.hProcess);
       end;
   finally
     CloseHandle(StdOutPipeRead);
   end;
end;

end.
像这样使用此线程:

procedure TForm2.Button1Click(Sender: TObject);
var
 MyThread : TMyThread;
begin
 MyThread := TMyThread.Create(Memo1, 'PING 127.0.0.1', '');
 MyThread.Start;
end;
它将在备忘录中逐行显示结果,而不会冻结UI


请注意构造函数和同步是如何工作的…

是否要在Repeat…till循环中显示结果值?还是循环后的一次?。您的代码没有持续(不间断)result@M...M需要实时获取结果。我不能使用线程的OnTerminate事件。不需要OnTerminate事件,请使用我在答案中发布的单位