multithreading - TOmniEventMonitor 可以在后台线程中使用吗？

Question

原始问题

在我们的 Delphi XE4 应用程序中，我们使用 TOmniEventMonitor 来接收来自其他任务的消息。只要它在主线程中运行，它就可以正常工作，但是一旦我将相同的代码放入任务中，TOmniEventMonitor 就会停止接收消息。我在下面提供了一个简单的示例 - 单击 Button_TestInMainThread 会导致文件按预期写入，而单击 Button_TestInBackgroundThread 则不会。这是设计使然，还是有某种方法可以在仍然使用 TOmniEventMonitor 的同时使其正常工作？

unit mainform;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics,Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  OtlTask, OtlTaskControl, OtlComm, OtlEventMonitor;

const
  MY_OMNI_MESSAGE = 134;

type
  TOmniEventMonitorTester = class(TObject)
    fName : string;
    fOmniEventMonitor : TOmniEventMonitor;
    fOmniTaskControl : IOmniTaskControl;
    constructor Create(AName : string);
    destructor Destroy(); override;
    procedure HandleOmniTaskMessage(const task: IOmniTaskControl; const msg: TOmniMessage);
  end;

  TTestLauncherTask = class(TOmniWorker)
    fOmniTaskMonitorTester : TOmniEventMonitorTester;
    function Initialize() : boolean; override;
  end;

  TForm1 = class(TForm)
    Button_TestInMainThread: TButton;
    Button_TestInBackgroundThread: TButton;
    procedure Button_TestInMainThreadClick(Sender: TObject);
    procedure Button_TestInBackgroundThreadClick(Sender: TObject);
  private
    fOmniEventMonitorTester : TOmniEventMonitorTester;
    fTestLauncherTask : IOmniTaskControl;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure OmniTaskProcedure_OneShotTimer(const task: IOmniTask);
begin
  Sleep(1000);
  task.Comm.Send(MY_OMNI_MESSAGE);
end;

constructor TOmniEventMonitorTester.Create(AName : string);
begin
  inherited Create();
  fName := AName;
  fOmniEventMonitor := TOmniEventMonitor.Create(nil);
  fOmniEventMonitor.OnTaskMessage := HandleOmniTaskMessage;
  fOmniTaskControl := fOmniEventMonitor.Monitor(CreateTask(OmniTaskProcedure_OneShotTimer)).Run();
end;

destructor TOmniEventMonitorTester.Destroy();
begin
  fOmniEventMonitor.Free();
  inherited Destroy();
end;

procedure TOmniEventMonitorTester.HandleOmniTaskMessage(const task: IOmniTaskControl; const msg: TOmniMessage);
var
  Filename : string;
  F : TextFile;
begin
  Filename := IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0))) + fName + '.txt';
  AssignFile(F, Filename);
  Rewrite(F);
  Writeln(F, fName);
  CloseFile(F);
end;

function TTestLauncherTask.Initialize() : boolean;
begin
  result := inherited Initialize();
  if result then begin
    fOmniTaskMonitorTester := TOmniEventMonitorTester.Create('background');
  end;
end;

procedure TForm1.Button_TestInMainThreadClick(Sender: TObject);
begin
  fOmniEventMonitorTester := TOmniEventMonitorTester.Create('main');
end;

procedure TForm1.Button_TestInBackgroundThreadClick(Sender: TObject);
begin
  fTestLauncherTask := CreateTask(TTestLauncherTask.Create()).Run();
end;

end.

其他观察结果

使用以下代码似乎可以在后台线程中成功使用 TOmniEventMonitor。这确实是一个非常笨拙的解决方案——创建了 IOmniTwoWayChannel 但没有以任何有意义的方式使用——但是一旦我尝试通过注释掉标记为“不要删除!”的任何一行来简化代码，HandleTaskMessage 就不会不再被召唤。谁能告诉我我在这里做错了什么？

unit mainform;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  DSiWin32, GpLists, OtlTask, OtlTaskControl, OtlCommon, OtlComm, OtlEventMonitor;

const
  MY_OMNI_MESSAGE = 134;

type

  TOmniEventMonitorTestTask = class(TOmniWorker)
    fOmniTaskControl : IOmniTaskControl;
    fOmniTwoWayChannel : IOmniTwoWayChannel;
    fOmniEventMonitor : TOmniEventMonitor;
    function  Initialize() : boolean; override;
    procedure HandleTaskMessage(const task: IOmniTaskControl; const msg: TOmniMessage);
    procedure HandleTaskTerminated(const task: IOmniTaskControl);
  end;

  TForm1 = class(TForm)
    Button_TestInBackgroundThread: TButton;
    procedure Button_TestInBackgroundThreadClick(Sender: TObject);
  private
    fTestTask : IOmniTaskControl;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure OmniTaskProcedure_OneShotTimer(const task: IOmniTask);
begin
  Sleep(1000);
  task.Comm.Send(MY_OMNI_MESSAGE); // don't remove!
  (task.Param['Comm'].AsInterface as IOmniCommunicationEndpoint).Send(MY_OMNI_MESSAGE);
end;

procedure TOmniEventMonitorTestTask.HandleTaskMessage(const task: IOmniTaskControl; const msg: TOmniMessage);
var
  Filename : string;
  F : TextFile;
begin
  Filename := IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0))) + 'HandleTaskMessage.txt';
  AssignFile(F, Filename);
  Rewrite(F);
  Writeln(F, 'HandleTaskMessage!');
  CloseFile(F);
end;

procedure TOmniEventMonitorTestTask.HandleTaskTerminated(const task: IOmniTaskControl);
var
  Filename : string;
  F : TextFile;
begin
  Filename := IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0))) + 'HandleTaskTerminated.txt';
  AssignFile(F, Filename);
  Rewrite(F);
  Writeln(F, 'HandleTaskTerminated!');
  CloseFile(F);
end;

function TOmniEventMonitorTestTask.Initialize() : boolean;
begin
  result := inherited Initialize();
  if result then begin
    fOmniEventMonitor := TOmniEventMonitor.Create(nil);
    fOmniEventMonitor.OnTaskMessage := HandleTaskMessage;
    fOmniEventMonitor.OnTaskTerminated := HandleTaskTerminated;
    fOmniTwoWayChannel := CreateTwoWayChannel();
    Task.RegisterComm(fOmniTwoWayChannel.Endpoint1); // don't remove!
    fOmniTaskControl := fOmniEventMonitor.Monitor( CreateTask(OmniTaskProcedure_OneShotTimer) ).SetParameter('Comm', fOmniTwoWayChannel.Endpoint2).Run();
  end;
end;

procedure TForm1.Button_TestInBackgroundThreadClick(Sender: TObject);
begin
  fTestTask := CreateTask(TOmniEventMonitorTestTask.Create()).Run();
end;

end.

Answer 1

只要有消息泵处理消息，TOmniEventMonitor 在线程内运行就没有问题。我将这段代码放在一起进行演示。这按预期工作。

procedure TMyThread.Execute;
var
  Message: TMsg;
begin
  FreeOnTerminate := True;
  fOmniEventMonitor := TOmniEventMonitor.Create(nil);
  fOmniEventMonitor.OnTaskMessage := HandleOmniTaskMessage;
  fOmniTaskControl := fOmniEventMonitor.Monitor(CreateTask(OmniTaskProcedure_OneShotTimer)).Run();
  try
    while not Terminated do
    begin
      if MsgWaitForMultipleObjects(0, nil^, False, 1000, QS_ALLINPUT) = WAIT_OBJECT_0 then
      begin
        while PeekMessage(Message, 0, 0, 0, PM_REMOVE) do
        begin
          TranslateMessage(Message);
          DispatchMessage(Message);
        end;
      end;
    end;
  finally
    fOmniTaskControl := nil;
    fOmniEventMonitor.Free;
  end;
end;

据我所知，TOmniTaskExecutor 等待发送到特定句柄的消息。在您的代码示例中，它是终止事件和几个通信句柄。 TOmniEventMonitor 的消息永远不会被处理。

将 TTestLauncherTask.Initialize 更改为以下结果可以正确写出文件。 DoNothingProc 只是类中的一个空方法。

function TTestLauncherTask.Initialize() : boolean;
begin
  result := inherited Initialize();
  if result then begin
    fOmniTaskMonitorTester := TOmniEventMonitorTester.Create('background');
    // Tell the task about the event monitor
    Task.RegisterWaitObject(fOmniTaskMonitorTester.fOmniEventMonitor.MessageWindow, DoNothingProc);
  end;
end;

我将 TOmniEventMonitor 的消息窗口添加到 Task WaitObject 列表中，以便随后使用 MsgWaitForMultipleObjectsEx 调用注册该句柄，并等待 Remi 和 David 将我的消息处理撕成碎片:)