COM und Multithreading; CoUninitialize blockiert

Antworten
Eclipticon
Beiträge: 292
Registriert: Sa 5. Feb 2011, 20:38
OS, Lazarus, FPC: Windows XP VirtualBox (FPC 2.6.4, Laz 1.2.4)
CPU-Target: 32Bit
Wohnort: Wien

COM und Multithreading; CoUninitialize blockiert

Beitrag von Eclipticon »

Hi,

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;


* Macht das grundsaetzlich Sinn oder ist das vom Code her ein grosser Bloedsinn?

* 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 :)

SchwabenTom
Beiträge: 49
Registriert: So 4. Jan 2015, 21:34
OS, Lazarus, FPC: Winux (L 0.9.xy FPC 2.2.z)
CPU-Target: xxBit

Re: COM und Multithreading; CoUninitialize blockiert

Beitrag von SchwabenTom »


Antworten