I have problem with termination of BackgroundWorker in OmniThreadLibrary. Everything is OK, but when I want to terminate BackgroundWorker, termination has failed and BackgroundWorker is still alive. So, whole application that run as batch process is still alive.
procedure TEntityIndexer.StartReindex;
begin
if LoadTable then
begin
// In a ProcessRecords method I schedule WorkItems for background tasks
ProcessRecords;
while FCounter > 0 do
ProcessMessages;
// In ProcessMessages I keep the main thread alive
ProcessRecordsContinue;
// In ProcessRecordsContinue method I process the results of background tasks and OnRequestDone method
end
else
TerminateBackgroundWorker;
end;
procedure ProcessMessages;
var
Msg: TMsg;
begin
while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
constructor TEntityIndexer.Create;
begin
...
CreateBackgroundWorker;
end;
procedure TEntityIndexer.CreateBackgroundWorker;
begin
FBackgroundWorker := Parallel.BackgroundWorker
.NumTasks(INITasksCount)
.Initialize(InitializeTask)
.Finalize(FinalizeTask)
.OnRequestDone(HandleRequestDone)
.Execute(ProcessSupportStrings);
end;
procedure TEntityIndexer.FinalizeTask(const taskState: TOmniValue);
var
_obj: TObject;
begin
if not(taskState.IsObject) then
Exit;
_obj := taskState.AsObject;
if _obj is TServerSessionApp then
TServerSessionApp(_obj).ParentApplication.Free;
CoUninitialize;
end;
procedure TEntityIndexer.ProcessRecordsContinue;
begin
if FStack.Count = 0 then
Exit;
...
FStack.Clear;
StartReindex;
end;
procedure TEntityIndexer.ProcessRecords;
...
begin
FVTable.First;
while not FVTable.Eof do
begin
...
_omniValue := TOmniValue.CreateNamed(
[ovIdKey, _id,
ovXMLKey, FVTable.FieldByName('mx').AsString,
ovGenKey, FVTable.FieldByName('created').AsString
]);
FBackgroundWorker.Schedule(FBackgroundWorker.CreateWorkItem(_omniValue));
Inc(FCounter);
FVTable.Next;
end;
end;
procedure TEntityIndexer.ProcessSupportStrings(const workItem: IOmniWorkItem);
var
...
begin
if not(workItem.taskState.IsObject) then
...
if not workItem.Data.IsArray then
raise Exception.Create('Empty parameters!');
...
// make some JSON and XML strings
...
try
try
workItem.Result := TOmniValue.CreateNamed(
[... ]);
...
end;
procedure TEntityIndexer.HandleRequestDone(const Sender: IOmniBackgroundWorker;
const workItem: IOmniWorkItem);
var
...
begin
Dec(FCounter);
if workItem.IsExceptional then
begin
// Process the exception
end
else if workItem.Result.IsArray then
begin
...
FStack.AddToStack(_stackItem);
end;
end;
procedure TEntityIndexer.InitializeTask(var taskState: TOmniValue);
begin
CoInitialize(nil);
taskState.AsObject := CreateAnotherServerSession;
end;
procedure TEntityIndexer.TerminateBackgroundWorker;
begin
// Here is s problem - Termination of the BackgroundWorker doesn't work, but finalization
// of background tasks is done
FBackgroundWorker.Terminate(INFINITE);
FBackgroundWorker := nil;
end;
end.
