EPr*_*und 3 windows delphi com multithreading delphi-6
为了学习多线程,我在COM Thread(TRemoteDataModule)中创建了一个线程。
这是我的组件工厂:
TComponentFactory.Create(ComServer, TServerConn2, Class_ServerConn2, ciMultiInstance, tmApartment);
Run Code Online (Sandbox Code Playgroud)
在线程内部,我不需要调用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;
Run Code Online (Sandbox Code Playgroud)
更新2:
当前TADOConnection用于连接数据库的是在COM Thread上下文(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;
Run Code Online (Sandbox Code Playgroud)
实现方式:
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.
Run Code Online (Sandbox Code Playgroud)
更新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;
Run Code Online (Sandbox Code Playgroud)
通过某种方式(由于TComponentFactory可能?)CoCreateInstance确定TWorker与上下文相同TServerConn2并且不引发错误?
以下两项或两项可能适用:
在未使用COM初始化的线程上,所有现有接口指针将一直起作用,直到您进行COM API调用或以其他方式要求进行COM编组,然后才能检测到未初始化的线程。也就是说,您的“没有给我带来任何麻烦”实际上可能还为时过早。
| 归档时间: |
|
| 查看次数: |
2185 次 |
| 最近记录: |