Search code examples
multithreadingdelphiomnithreadlibrary

Can TOmniEventMonitor be used in a background thread?


Original Question

In our Delphi XE4 application we use a TOmniEventMonitor to receive messages from other tasks. As long as this is running in the main thread, it works fine, but once I put the same code in a task, the TOmniEventMonitor stops receiving messages. I have included a simple example of this below -- clicking Button_TestInMainThread results in a file being written as expected, clicking Button_TestInBackgroundThread does not. Is this by design, or is there some way to get this working while still using 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.

Additional Observations

With the following code it seems to be possible to successfully use a TOmniEventMonitor within a background thread. This really is a very clumsy solution -- an IOmniTwoWayChannel gets created but not used in any meaningful way -- but as soon as I try to simplify the code by commenting out either of the lines marked "don't remove!", HandleTaskMessage doesn't get called any more. Can anybody tell me what I am doing wrong here?

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.

Solution

  • There is no problem with TOmniEventMonitor running inside of a thread, provided there is a message pump handling the messages for it. I put this block of code together to demonstrate. This works as expected.

    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;
    

    From what I can see, the TOmniTaskExecutor waits for messages to specific handles. In your code example, it's the terminate event and a couple of comm handles. The messages for the TOmniEventMonitor are never processed.

    Changing your TTestLauncherTask.Initialize to the following results in it correctly writing out the file. DoNothingProc is just an empty method on the class.

    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;
    

    I am adding the message window for the TOmniEventMonitor to the Task WaitObject list so the handle is then registered with the MsgWaitForMultipleObjectsEx call and waiting for Remi and David to tear my message handling to shreds :)