Multithreading COM和多线程在Pascal/Delphi中，conInitialize不返回

我在Free Pascal中使用以下伪代码，以允许访问多线程应用程序中的COM对象：

type
  TCoObjectInstance = record
    ThreadID: TThreadID;
    CoObject: TLB.CoObject;
  end;

type
  TCoObjectWrapper = class(...)
  strict private
    FCoObjectInstance: array[0..9] of TCoObjectInstance;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure InitializeThread;
    procedure LeaveThread;
    function CoInstance: MyCoInstance;
    procedure UseCoInstance;
    //...
  end;

var
  MyOneCoObjectWrapper: TOneCoObjectWrapper;

type
  TDoSomethingThread = class(TThread)
  protected
    procedure Execute; override;
  public
    Finished: boolean;
    // ...
  end;


// TDoSomethingThread

procedure TDoSomethingThread.Execute;
begin
    MyOneCoObjectWrapper.InitializeThread;
    while (not Terminated) do
    begin
        MyOneCoObjectWrapper.UseCoInstance;
        Sleep(100);
    end;
    MyOneCoObjectWrapper.LeaveThread; // <--------------- !!!
  end;
  Finished := True;
end;


// TCoObjectWrapper

constructor TCoObjectWrapper.Create;
begin
   // ...
  OleCheck(CoInitializeEx(nil, COINIT_APARTMENTTHREADED));
  FCoObjectInstances[0].ThreadID := GetThreadID;
  FCoObjectInstances[0].CoObject := CoObject.Create;
  GIT.RegisterInterfaceInGlobal(FCoObjectInstances[0].CoObject, TLB.CoObject, CoInterfaceMarshalCookie);
  // ...
end;

destructor TCoObjectWrapper.Destroy;
begin
   // ...
  CoUninitialize;
  // ...
end;

procedure TCoObjectWrapper.InitializeThread;
var
  i: integer;
begin
  OleCheck(CoInitializeEx(nil, COINIT_APARTMENTTHREADED));

  // Find next free instance
  i := Low(FCoObjectInstances) + 1;
  while Assigned(FCoObjectInstances[i].CoObject) and (i <= High(FCoObjectInstances)) do
    Inc(i);
  if (i > High(FCoObjectInstances)) then
    raise Exception.Create('Ran out of instances in InitializeThread!');

  GIT.GetInterfaceFromGlobal(CoInterfaceMarshalCookie, TLB.CoObject, FCoObjectInstances[i].CoObject);
  FCoObjectInstances[i].ThreadID := GetThreadID;
end;

procedure TCoObjectWrapper.LeaveThread;
var
  i: integer;
begin
  i := Low(FCoObjectInstances) + 1;
  while (FCoObjectInstances[i].ThreadID <> GetThreadID) and (i <= High(FCoObjectInstances)) do
    Inc(i);
  if (i > High(FCoObjectInstances)) then
    raise ELogged.Create('Instance not found');
  FCoObjectInstances[i].ThreadID := 0;
  FCoObjectInstances[i].CoObject := nil;
  CoUninitialize; // <----- !
end;

function TCoObjectWrapper.CoInstance: TLB.CoObject;
var
  i: integer = Low(FCoObjectInstances);
begin
  Result := nil;
  while (not Assigned(Result)) and (i <= High(FCoObjectInstances)) do
  begin
    if (FCoObjectInstances[i].ThreadID = GetThreadID) then
      Result := FCoObjectInstances[i].CoObject;
    Inc(i);
  end;
  if not Assigned(Result) then
    raise Exception.Create('Instance not found');
end;

procedure TCoObjectWrapper.UseCoInstance;
begin
   // Do somthing with the COM object
end;

这应该按如下方式工作：

在FormCreate主线程中，TCoObjectWrapper MyOneCoObjectWrapper的全局实例 创造

MyOneCoObjectWrapper的方法从主线程调用，访问封装的COM对象

从主线程创建一个TDoSomethingThread实例。一旦线程启动，它将通过调用MyOneCoObjectWrapper.initializeThread初始化其COM

主线程和子线程访问COM对象

线程终止后，调用MyOneCoObjectWrapper.LeaveThread来完成该线程的COM，这就是问题的症结所在-见下文

主线程对COM对象的更多使用

在FormDestroy主线程中，TCoObjectWrapper的全局实例被销毁，主线程的COM在TCoObjectWrapper.Destroy中完成

我的问题是：

在代码方面，这是解决这个问题的一种完全愚蠢的方法吗

无论是从主线程还是从子线程，它都工作得非常好。唯一的问题是，TCoObjectWrapper.LeaveThread经常挂起在ConInitialize，程序冻结。这种行为有什么解释吗？我如何进一步分析

---

谢谢

您确定要Conit_ApartmentThreaded您的TCoObjectWrapper。Create本身正在调用CoInitializeEx，为什么？您的TCoObjectWrapper.LeaveThread正在清除条目，但它没有释放从GIT获得的接口指针。终止从哪里来？@DavidHeffernan:注册表中相应的CLSID条目告诉我一个公寓的线程模型-这是错误的吗？该COM接口上的文档非常糟糕。@PauloMadeira:CoObjectWrapper.Create本身正在调用CoInitializeEx，因为它还创建COM对象的一个实例。释放GIT的接口指针-您是如何做到的？并且在TCoObjectWrapper中的某个点设置了Terminated，对不起，忘记了那段代码！至于TCoObjectWrapper.Create，它不应该调用CoInitializeX本身，这是不应该调用CoInitializeX的一种方式，即从某个现有线程中的库调用。更糟糕的是MyOneCoObjectWrapper是在第一个线程中初始化的，因此实际上是隐式地强制它位于STA中，而不是显式地。至于GIT，在TCoObjectWrapper.InitializeThread中会得到一个接口指针，您永远不会释放它，但应该释放它。