Question

In order to learn multithreading, I've created a thread inside a COM Thread (TRemoteDataModule).

This is my Component Factory:

TComponentFactory.Create(ComServer, TServerConn2, Class_ServerConn2, ciMultiInstance, tmApartment);

Inside the Thread, I didn't needed to Call CoInitialize to use TADOQuery.Create, .Open... .Exec

I read that I need to initialize the COM library on a thread before you call any of the library functions except CoGetMalloc, to get a pointer to the standard allocator, and the memory allocation functions.

But in this case, the absence of CoInitialize didn't brought me any trouble.
Is this related with Thread Model? Where can I Find the explanation for this subject?

UPDATE:

When I say INSIDE, it means inside the COM method context:

interface
type
  TWorker = class(TThread); 

  TServerConn2 = class(TRemoteDataModule, IServerConn2)
  public 
    procedure Method(); safecall;
  end;


implementation 
  procedure TServerConn2.Method(); 
  var W: TWorker;
  begin
    W := TWorkerTread.Create(Self);
  end;

UPDATE 2:

The TADOConnection used to connect to database are currently being created in the COM Thread context (TThread.Create constructor). Although, TADOConnection.Open and TADOQuery.Create/.Open are both being performed inside TThread.Execute .

UPDATE 3 - Simulacrum

Interface:

type
  TServerConn2 = class;

  TWorker = class(TThread)
  private
    FDB: TADOConnection;
    FOwner: TServerConn2;
  protected
    procedure Execute; override;
  public
    constructor Create(Owner: TServerConn2);
    destructor Destroy; override;
  end;

  TServerConn2 = class(TRemoteDataModule, IServerConn2)
    ADOConnection1: TADOConnection;
    procedure RemoteDataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure CheckException; safecall;
  public
    User, Pswd, Str: String;
    Ok: Boolean;
  end;

Implementation:

class procedure TServerConn2.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;

{ TWorker }

constructor TWorker.Create(Owner: TServerConn2);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FDB := TADOConnection.Create(nil);
  FOwner := Owner;
end;

destructor TWorker.Destroy;
begin
  FDB.Free;
  FOwner.Ok := True;
  inherited;
end;

procedure TWorker.Execute;
var Qry: TADOQuery;
begin
  FDB.LoginPrompt := False;
  FDB.ConnectionString := FOwner.Str;
  FDB.Open(FOwner.User, FOwner.Pswd);

  Qry := TADOQuery.Create(nil);
  try
    Qry.Connection := FDB;
    Qry.LockType := ltReadOnly;
    Qry.SQL.Text := 'SELECT TOP 1 * FROM MyTable';
    Qry.Open;
  finally
    Qry.Free;
  end;
end;

procedure TServerConn2.CheckException;
var W: TWorker;
begin
  W := TWorker.Create(Self);
  while not Ok do Sleep(100);
end;

procedure TServerConn2.RemoteDataModuleCreate(Sender: TObject);
begin
  User := 'user';
  Pswd := 'pass';
  Str := ADOConnection1.ConnectionString;
end;

initialization
  TComponentFactory.Create(ComServer, TServerConn2,
    Class_ServerConn2, ciMultiInstance, tmApartment);
end.

UPDATE 4

The error should happen here:

function CreateADOObject(const ClassID: TGUID): IUnknown;
var
  Status: HResult;
  FPUControlWord: Word;
begin
  asm
    FNSTCW  FPUControlWord
  end;
  Status := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
    CLSCTX_LOCAL_SERVER, IUnknown, Result);
  asm
    FNCLEX
    FLDCW FPUControlWord
  end;
  if (Status = REGDB_E_CLASSNOTREG) then
    raise Exception.CreateRes(@SADOCreateError) else
    OleCheck(Status);
end;

By somehow (because of TComponentFactory maybe?) CoCreateInstance identifies that TWorker is in the same context than TServerConn2 and don't raise errors?

Was it helpful?

Solution

Either or both of the following might apply:

  1. On a thread not initialized with COM all existing interface pointers keep working until you make a COM API call or otherwise require COM marshalling which then fails detecting an uninitialized thread. That is, your "didn't brought me any trouble" might actually be too early to say.

  2. If any thread in the process calls Co­Initialize­[Ex] with the COINIT_MULTI­THREADED flag, then that not only initializes the current thread as a member of the multi-threaded apartment, but it also says, "Any thread which has never called Co­Initialize­[Ex] is also part of the multi-threaded apartment." - so called impicit MTA thing

OTHER TIPS

The TADOConnection used to connect to database are currently being created in the COM Thread context (TThread.Create constructor). Although, TADOConnection.Open and TADOQuery.Create/.Open are both being performed inside TThread.Execute .

That will not work, for 2 reasons:

  1. TWorker.Create() and TWorker.Execute() will run in different thread contexts. Create() will run in the context of the thread that is calling TServerConn2.CheckException() (which will have already called CoInitialize/Ex() on itself beforehand), but Execute() will run in the context of the TThread thread instead. ADO is apartment threaded, which means its COM interfaces cannot be used across thread/apartment boundaries unless you marshal them, either via the IGlobalInterfaceTable interface or the CoMarshalInterThreadInterfaceInStream() and CoGetInterfaceAndReleaseStream() functions.

  2. even if you did marshal the ADO interfaces, TWorker.Execute() must call CoInitialize/Ex() on itself. EVERY individual thread must initialize COM to establish its threading model before then accessing any COM interfaces. The threading model dictates how COM accesses interfaces (direct or through proxies), whether message queues are used, etc.

So the simple solution to your problem is to NOT create and use the ADO components across thread boundaries at all. Move your TADOConnection into Execute() instead:

constructor TWorker.Create(Owner: TServerConn2);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FOwner := Owner;
end;

destructor TWorker.Destroy;
begin
  FOwner.Ok := True;
  inherited;
end;

procedure TWorker.Execute;
var
  DB: TADOConnection;
  Qry: TADOQuery;
begin
  CoInitialize;
  try
    DB := TADOConnection.Create(nil);
    try
      DB.LoginPrompt := False;
      DB.ConnectionString := FOwner.Str;
      DB.Open(FOwner.User, FOwner.Pswd);

      Qry := TADOQuery.Create(nil);
      try
        Qry.Connection := DB;
        Qry.LockType := ltReadOnly;
        Qry.SQL.Text := 'SELECT TOP 1 * FROM MyTable';
        Qry.Open;
      finally
        Qry.Free;
      end;
    finally
      DB.Free;
    end;
  finally
    CoUninitialize;
  end;
end;

When you create an apartment thread using TComponentFactory it calls CoInitialize and CoUnInitialize for you - it's right in the VCL source (System.Win.VCLCom.pas):

procedure TApartmentThread.Execute;
var
  msg: TMsg;
  Unk: IUnknown;
begin
  try
    CoInitialize(nil);  // *** HERE
    try
      FCreateResult := FFactory.CreateInstanceLic(FUnkOuter, nil, FIID, '', Unk);
      FUnkOuter := nil;
      FFactory := nil;
      if FCreateResult = S_OK then
        CoMarshalInterThreadInterfaceInStream(FIID, Unk, IStream(FStream));
      ReleaseSemaphore(FSemaphore, 1, nil);
      if FCreateResult = S_OK then
        while GetMessage(msg, 0, 0, 0) do
        begin
          DispatchMessage(msg);
          Unk._AddRef;
          if Unk._Release = 1 then break;
        end;
    finally
      Unk := nil;
      CoUninitialize;  // ** AND HERE
    end;
  except
    { No exceptions should go unhandled }
  end;
end;
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top