delphi - 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

好的，我发现了一个错误。这不是 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;