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.
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.
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 :)