wieder mal eine Frage zum COM und Multithreading: Um ein COM Objekt aus mehreren Threads zu nutzen, verwende ich folgenden (Pseudo)code:
Code: Alles auswählen
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));
  FCoObjectInstaces[0].ThreadID := GetThreadID;
  FCoObjectInstaces[0].CoObject := CoObject.Create;
  GIT.RegisterInterfaceInGlobal(FCoObjectInstaces[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(FCoObjectInstaces) + 1;
  while Assigned(FCoObjectInstaces[i].CoObject) and (i <= High(FCoObjectInstaces)) do
    Inc(i);
  if (i > High(FCoObjectInstaces)) then
    raise Exception.Create('Ran out of instances in InitializeThread!');
 
  GIT.GetInterfaceFromGlobal(CoInterfaceMarshalCookie, TLB.CoObject, FCoObjectInstaces[i].CoObject);
  FCoObjectInstaces[i].ThreadID := GetThreadID;
end;
 
procedure TCoObjectWrapper.LeaveThread;
var
  i: integer;
begin
  i := Low(FCoObjectInstaces) + 1;
  while (FCoObjectInstaces[i].ThreadID <> GetThreadID) and (i <= High(FCoObjectInstaces)) do
    Inc(i);
  if (i > High(FCoObjectInstaces)) then
    raise ELogged.Create('Instance not found');
  FCoObjectInstaces[i].ThreadID := 0;
  FCoObjectInstaces[i].CoObject := nil;
	CoUninitialize; // <----- !
end;
 
function TCoObjectWrapper.CoInstance: TLB.CoObject;
var
  i: integer = Low(FCoObjectInstaces);
begin
  Result := nil;
  while (not Assigned(Result)) and (i <= High(FCoObjectInstaces)) do
  begin
    if (FCoObjectInstaces[i].ThreadID = GetThreadID) then
      Result := FCoObjectInstaces[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;* Grundsaetzlich funktioniert der Code aus allen Threads gut, das einzige Problem tritt bei Terminierung eines DoSomethingThread beim Befehl LeaveThread auf - CoUninitialize in LeaveThread kehrt hier naemlich nicht mehr zurueck. Woran kann das liegen, wie kann ich dieses Verhalten genauer diagnostizieren?
Danke fuer euren Input