Delphi OmniThreadLibrary 3.03b: IBackgroundWorker - Beendigung funktioniert nicht

Question

Ich habe ein Problem mit der Beendigung von BackgroundWorker in OmniThreadLibrary. Alles ist in Ordnung, aber wenn ich BackgroundWorker beenden möchte, ist die Beendigung fehlgeschlagen und BackgroundWorker ist noch am Leben. Die ganze Anwendung, die als Stapelverarbeitung ausgeführt wird, ist also noch am Leben.

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. 

Answer 1

Ok Ich finde einen Fehler. Es war nicht der Fehler der OTL. Dieser Fehler wurde durch eine falsche Zerstörung des Objekts in der Finalize() -Methode verursacht. Freigabe der Objekte in der Parametervariable taskState nicht genug. TaskState-Parametervariable sollte ebenfalls gelöscht werden.

procedure TEntityIndexer.FinalizeTask(const taskState: TOmniValue); 
var 
    _obj: TObject; 
begin 
    if not(taskState.IsObject) then 
     Exit; 
    _obj := taskState.AsObject; 
    if Assigned(_obj) then 
     _obj.Free; 
    if _obj is TServerSessionApp then 
     TServerSessionApp(_obj).ParentApplication.Free; 
    // release the objects and clear a taskState variable 
    taskState.Clear; 
    CoUninitialize; 
end;