Omnithread:创建任务包装器/修改任务,为现有任务添加一些额外的预处理和 post 处理
Omnithread: Create a task wrapper / modify a task that adds some extra pre- and post processing to an alredy existing task
一些背景:
基本上归结为我希望能够 "execute" 当前线程中的任务。
为什么? -我有一个任务创建程序,有一次我希望任务在后台任务中立即执行,而其他时候我希望使用 IOmniThreadPool
.
来安排任务
在我想使用 OmniThreadpool 的情况下,我想做一些关于任务状态的输出,比如它已排队、开始、完成或失败。
此时尚未开始执行任务。
所以我想象了这样的事情:
function WrapIntoPoolTask(const aOriginalTask:IOmniTaskCOntrol):IOmniTaskCOntrol;
begin
if Assigned(aOriginalTask) then
begin
var lPoolProgress:=TaskPoolProgress; // fetch global task pool progress interface
// immediately displays message says its been queued, remember message bookmark
var lMessageBookMark:=lPoolProgress.MessageList.AddMessage(aOriginalTask.Name,pmPaused);
Result:=CreateTask(
procedure (const aTask:IOmniTask)
begin
lPoolProgress.MessageList.UpdateMessage(lMessageBookMark,pmStarted); // update message status
try
aOriginalTask.ExecuteTaskInThisThread; // <<=== So how do I do this?
lPoolProgress.MessageList.UpdateMessage(lMessageBookMark,pmCompleted);
except
lPoolProgress.MessageList.UpdateMessage(lMessageBookMark,pmFailed);
raise;
end;
end
,
'Pooled:'+aOriginalTask.Name
);
end;
end;
在执行原始任务后使用 UpdateMessage 调用可以移动到 IOmniTaskControl
接口的 OnTerminated
处理程序。我试过了,它对线程结束部分工作得很好。它甚至允许处理我更喜欢的退出代码和退出消息。
我想我在这里缺少的可能是 OnInitialize
或 OnStartExecution
处理程序来设置我的 pmStarted
状态。
问题:
- 如何直接执行来自
IOmniTaskCOntrol
的任务 "body"
或
- 如何在创建任务后向我的任务添加一些初始化代码。此代码应在执行我的任务原始主体之前立即执行。
为了解决我的问题,我不得不稍微更改一下 omnithreadlibrary 单元 OtlTaskControl
。
一个例程添加到 IOmniTaskControl
(GUID 应该改变,但我没有)
IOmniTaskControl = interface ['{881E94CB-8C36-4CE7-9B31-C24FD8A07555}']
...
function DirectExecute:IOmniTaskControl;
...
end; { IOmniTaskControl }
并将实现添加到 TOmniTaskControl
:
function TOmniTaskControl.DirectExecute:IOmniTaskControl;
VAR lTask:IOmniTask;
begin
Result:=self;
lTask:=CreateTask;
(lTask as IOmniTaskExecutor).Execute;
end;
然后我的 "custom wrapper" 例程实际上将池进度处理添加到原始任务中:
function WrapIntoOmniPoolTask(const aTaskControl:IOmniTaskCOntrol):IOmniTaskCOntrol;
var lTaskControl:IOmniTaskCOntrol;
lPoolProgress:IAppProgress;
lmbm:integer;
begin
if Assigned(aTaskControl) then
begin
// have some local copies to work around compiler bug RX10.3 and RX10.4
// cannot use inline vars due to this bug either.
lTaskControl:=aTaskControl;
lPoolProgress:=TaskPoolProgress;
lmbm:=lPoolProgress.MessageList.AddMessage(aTaskControl.Name,pmPaused);
Result:=CreateTask(
procedure (const aTask:IOmniTask)
begin
try
lPoolProgress.MessageList.UpdateMessage(lmbm,pmStarted);
try
lTaskControl.DirectExecute;
aTask.SetExitStatus(lTaskControl.ExitCode,lTaskControl.ExitMessage);
HandlePoolTaskTermination(lTaskControl,lmbm,lPoolProgress);
except
HandlePoolTaskTermination(lTaskControl,lmbm,lPoolProgress);
if IsFatalException then
raise;
end;
finally
// release interfaces when all is done
lPoolProgress:=nil;
lTaskControl:=nil;
end;
end,
'Pooled: '+lTaskCOntrol.Name
);
end;
end;
最后,将我的包装任务安排到 omnipoolthread 中的例程。
function TfrmMain.CreateTestTask:IOmniTaskControl;
begin
Result:=WrapIntoOmniPoolTask(CreateTask(TestTask,TGUID.NewGuid.ToString)).Unobserved;
end;
一切似乎都按预期工作,包括从内部任务传播到外部任务的退出代码和退出消息。
这里报告了我所指的编译器错误:https://quality.embarcadero.com/browse/RSP-29564(请投票!)
对于那些感兴趣的人:这就是 HandlePoolTaskTermination
的样子:
procedure HandlePoolTaskTermination(const aTaskControl:IOmniTaskCOntrol;const aMessageBookmark:integer;const aPoolProgress:IAppProgress);
begin
var pm:=pmCompleted;
if Assigned(aTaskControl.FatalException) then
begin
pm:=pmWarning;
var pe:=peError;
if IsAbortException(aTaskControl.FatalException) then
pe:=peWarning
else if IsFatalException(aTaskControl.FatalException) then
begin
pm:=pmFailed;
pe:=peFatalError;
end;
aPoolProgress.ErrorList.AddErrorToMessage(aMessageBookmark,'',pe,aTaskControl.FatalException)
end
else if aTaskControl.ExitCode<>0 then
begin
pm:=pmWarning;
aPoolProgress.ErrorList.AddErrorToMessage(aMessageBookmark,aTaskControl.ExitMessage,peWarning);
end;
aPoolProgress.MessageList.UpdateMessage(aMessageBookmark,pm);
end;
如果 "current" 异常是 EAccessViolation
、EInvalidOperation
等,则 IsFatalException
returns 为真。
一些背景:
基本上归结为我希望能够 "execute" 当前线程中的任务。
为什么? -我有一个任务创建程序,有一次我希望任务在后台任务中立即执行,而其他时候我希望使用 IOmniThreadPool
.
在我想使用 OmniThreadpool 的情况下,我想做一些关于任务状态的输出,比如它已排队、开始、完成或失败。
此时尚未开始执行任务。
所以我想象了这样的事情:
function WrapIntoPoolTask(const aOriginalTask:IOmniTaskCOntrol):IOmniTaskCOntrol;
begin
if Assigned(aOriginalTask) then
begin
var lPoolProgress:=TaskPoolProgress; // fetch global task pool progress interface
// immediately displays message says its been queued, remember message bookmark
var lMessageBookMark:=lPoolProgress.MessageList.AddMessage(aOriginalTask.Name,pmPaused);
Result:=CreateTask(
procedure (const aTask:IOmniTask)
begin
lPoolProgress.MessageList.UpdateMessage(lMessageBookMark,pmStarted); // update message status
try
aOriginalTask.ExecuteTaskInThisThread; // <<=== So how do I do this?
lPoolProgress.MessageList.UpdateMessage(lMessageBookMark,pmCompleted);
except
lPoolProgress.MessageList.UpdateMessage(lMessageBookMark,pmFailed);
raise;
end;
end
,
'Pooled:'+aOriginalTask.Name
);
end;
end;
在执行原始任务后使用 UpdateMessage 调用可以移动到 IOmniTaskControl
接口的 OnTerminated
处理程序。我试过了,它对线程结束部分工作得很好。它甚至允许处理我更喜欢的退出代码和退出消息。
我想我在这里缺少的可能是 OnInitialize
或 OnStartExecution
处理程序来设置我的 pmStarted
状态。
问题:
- 如何直接执行来自
IOmniTaskCOntrol
的任务 "body"
或
- 如何在创建任务后向我的任务添加一些初始化代码。此代码应在执行我的任务原始主体之前立即执行。
为了解决我的问题,我不得不稍微更改一下 omnithreadlibrary 单元 OtlTaskControl
。
一个例程添加到 IOmniTaskControl
(GUID 应该改变,但我没有)
IOmniTaskControl = interface ['{881E94CB-8C36-4CE7-9B31-C24FD8A07555}']
...
function DirectExecute:IOmniTaskControl;
...
end; { IOmniTaskControl }
并将实现添加到 TOmniTaskControl
:
function TOmniTaskControl.DirectExecute:IOmniTaskControl;
VAR lTask:IOmniTask;
begin
Result:=self;
lTask:=CreateTask;
(lTask as IOmniTaskExecutor).Execute;
end;
然后我的 "custom wrapper" 例程实际上将池进度处理添加到原始任务中:
function WrapIntoOmniPoolTask(const aTaskControl:IOmniTaskCOntrol):IOmniTaskCOntrol;
var lTaskControl:IOmniTaskCOntrol;
lPoolProgress:IAppProgress;
lmbm:integer;
begin
if Assigned(aTaskControl) then
begin
// have some local copies to work around compiler bug RX10.3 and RX10.4
// cannot use inline vars due to this bug either.
lTaskControl:=aTaskControl;
lPoolProgress:=TaskPoolProgress;
lmbm:=lPoolProgress.MessageList.AddMessage(aTaskControl.Name,pmPaused);
Result:=CreateTask(
procedure (const aTask:IOmniTask)
begin
try
lPoolProgress.MessageList.UpdateMessage(lmbm,pmStarted);
try
lTaskControl.DirectExecute;
aTask.SetExitStatus(lTaskControl.ExitCode,lTaskControl.ExitMessage);
HandlePoolTaskTermination(lTaskControl,lmbm,lPoolProgress);
except
HandlePoolTaskTermination(lTaskControl,lmbm,lPoolProgress);
if IsFatalException then
raise;
end;
finally
// release interfaces when all is done
lPoolProgress:=nil;
lTaskControl:=nil;
end;
end,
'Pooled: '+lTaskCOntrol.Name
);
end;
end;
最后,将我的包装任务安排到 omnipoolthread 中的例程。
function TfrmMain.CreateTestTask:IOmniTaskControl;
begin
Result:=WrapIntoOmniPoolTask(CreateTask(TestTask,TGUID.NewGuid.ToString)).Unobserved;
end;
一切似乎都按预期工作,包括从内部任务传播到外部任务的退出代码和退出消息。
这里报告了我所指的编译器错误:https://quality.embarcadero.com/browse/RSP-29564(请投票!)
对于那些感兴趣的人:这就是 HandlePoolTaskTermination
的样子:
procedure HandlePoolTaskTermination(const aTaskControl:IOmniTaskCOntrol;const aMessageBookmark:integer;const aPoolProgress:IAppProgress);
begin
var pm:=pmCompleted;
if Assigned(aTaskControl.FatalException) then
begin
pm:=pmWarning;
var pe:=peError;
if IsAbortException(aTaskControl.FatalException) then
pe:=peWarning
else if IsFatalException(aTaskControl.FatalException) then
begin
pm:=pmFailed;
pe:=peFatalError;
end;
aPoolProgress.ErrorList.AddErrorToMessage(aMessageBookmark,'',pe,aTaskControl.FatalException)
end
else if aTaskControl.ExitCode<>0 then
begin
pm:=pmWarning;
aPoolProgress.ErrorList.AddErrorToMessage(aMessageBookmark,aTaskControl.ExitMessage,peWarning);
end;
aPoolProgress.MessageList.UpdateMessage(aMessageBookmark,pm);
end;
如果 "current" 异常是 EAccessViolation
、EInvalidOperation
等,则 IsFatalException
returns 为真。