Delphi OmniThreadLibrary 3.03b：IBackgroundWorker - 终止不起作用

Question

我有在OmniThreadLibrary中终止BackgroundWorker的问题。一切正常，但是当我想终止BackgroundWorker时，终止失败并且BackgroundWorker仍然活着。因此，以批处理方式运行的整个应用程序仍然存在。

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

好的我找到了一个bug。这不是OTL的错误。这是由Finalize（）方法中对象的错误破坏引起的。 taskState参数变量中的对象释放不够。 TaskState参数变量也应该被清除。

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;