为了学习多线程,我在 COM Thread ( TRemoteDataModule
) 中创建了一个线程。
这是我的组件工厂:
TComponentFactory.Create(ComServer, TServerConn2, Class_ServerConn2, ciMultiInstance, tmApartment);
在线程内部,我不需要调用 CoInitialize 来使用TADOQuery.Create
,.Open
....Exec
我读到我需要在调用除 CoGetMalloc 之外的任何库函数之前在线程上初始化 COM 库,以获取指向标准分配器和内存分配函数的指针。
但是在这种情况下,没有 CoInitialize 并没有给我带来任何麻烦。
这与线程模型有关吗?我在哪里可以找到这个主题的解释?
更新:
当我说 INSIDE 时,它意味着在 COM 方法上下文中:
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;
更新 2:
用于连接数据库的TADOConnection
当前正在 COM 线程上下文 ( TThread.Create constructor
) 中创建。虽然,TADOConnection.Open
和TADOQuery.Create/.Open
都在里面进行TThread.Execute
。
更新 3 - 拟像
界面:
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;
执行:
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.
更新 4
错误应该发生在这里:
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;
以某种方式(因为TComponentFactory
可能?)CoCreateInstance
识别出TWorker
它在相同的上下文中TServerConn2
而不是引发错误?