为了学习多线程,我在COM线程(TRemoteDataModule
)中创建了一个线程。
这是我的组件工厂:
TComponentFactory.Create(ComServer, TServerConn2, Class_ServerConn2, ciMultiInstance, tmApartment);
在线程内部,我不需要调用CoInitialize来使用TADOQuery.Create
,.Open
... .Exec
但在这种情况下,没有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:
当前正在COM线程上下文(TADOConnection
)中创建用于连接数据库的TThread.Create constructor
。虽然TADOConnection.Open
和TADOQuery.Create/.Open
都在TThread.Execute
内执行。
更新3 - Simulacrum
接口
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
处于同一上下文中并且不会引发错误?
答案 0 :(得分:4)
以下任一或两者都适用:
在未使用COM初始化的线程上,所有现有接口指针都会继续工作,直到您进行COM API调用或以其他方式需要COM编组,然后无法检测到未初始化的线程。也就是说,你的“没有给我带来任何麻烦”实际上可能为时尚早。
答案 1 :(得分:4)
用于连接数据库的TADOConnection当前正在COM Thread上下文(TThread.Create构造函数)中创建。虽然,TADOConnection.Open和TADOQuery.Create / .Open都在TThread.Execute中执行。
这不起作用,原因有两个:
TWorker.Create()
和TWorker.Execute()
将在不同的线程上下文中运行。 Create()
将在调用TServerConn2.CheckException()
的线程的上下文中运行(事先已经在其自身上调用CoInitialize/Ex()
),但Execute()
将在上下文中运行TThread
线程代替。 ADO是单元线程,这意味着它的COM接口不能跨线程/公寓边界使用,除非您通过IGlobalInterfaceTable
接口或CoMarshalInterThreadInterfaceInStream()
和CoGetInterfaceAndReleaseStream()
函数封送它们。
即使你编组了ADO接口,TWorker.Execute()
也必须自己调用CoInitialize/Ex()
。 每个个别线程必须初始化COM以建立其线程模型,然后才能访问任何COM接口。线程模型规定COM如何访问接口(直接或通过代理),是否使用消息队列等。
因此,解决问题的简单方法是 NOT 根据线程边界创建和使用ADO组件。将您的TADOConnection
移至Execute()
代替:
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;
答案 2 :(得分:1)
当您使用TComponentFactory
创建公寓线程时,它会为您调用CoInitialize
和CoUnInitialize
- 它位于VCL来源(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;