组件是特定的类-在BPL结构中不起作用

Question

我正在将Delphi软件从Delphi 6(2001(升级到Delphi 11 Alexandria。

此软件由许多BPL组成，但此代码无法正常工作。当检查来自BPL的组件是否是TIBCQuery时，is命令不会返回True，尽管它确实是。

procedure LoadDLLAndPassDatabaseConnection(const DLLName: string);
var
PackageHandle: HMODULE;
ServiceModule: TMyServiceModule;
I: Integer;
Component: TComponent;
begin
PackageHandle := LoadPackage(PChar(DLLName));
ServiceModule := TMyServiceModule(GetProcAddress(hInst,'GetServiceModule'));
if Assigned(ServiceModule) then
begin
for I:=0 to ServiceModule.ComponentCount - 1 do
begin
Component := ServiceModule.Components[I];
// This component is declared in another bpl.
// It really is an TIBQuery, but the following if never returns True...
// (Evaluating Component.ClassName results in 'TIBQuery')
if Component is TIBQuery then
begin
// this is never executed...
TIBQuery(Component).Database := GetDatabase;
end;
end;
end;
end;

我已经考虑过比较类名，但这对后代不起作用。我们尝试切换项目选项，例如"；发射运行时类型信息"；，但这并没有什么区别。

如何做到这一点？

谢谢！

Answer 1

is运算符不能跨BPL(DLL(工作，原因如下：

• 您正在检查的类是在其自己的单元文件中实现的
• 构建BPL，链接单元，并在BPL文件中创建RTTI部分
• 然后，构建EXE，链接单元，并在EXE文件中创建新的RTTI部分

现在：两个模块的class name相同，但is运算符用于检查相等性的RTTI不同，因此运算符返回FALSE！

解决方案：检查类名是否相等。

Answer 2

我在某个地方找到了这个，但它似乎与Antionio的答案有点矛盾。

当您使用包时，中的任何单元只有一个副本记忆力一份表格，一份SysUtils，一份System(好吧，大部分(，一份StdCtrls，等等。所有与类相关的操作；是"；以及"；作为"；操作员，依赖关于类引用。类引用实际上只是地址。他们指向类内部布局的定义。(他们指向所谓的虚拟方法表VMT。(两个等级如果它们指向相同的VMT——如果地址相等。当您在StdCtrls的EXE副本中定义了一个类，并且在StdCtrls的DLL副本中定义的类，这些类将真正有不同的地址。"；是"；以及"；作为"；操作员无法使用跨模块冲突。但当你使用软件包时，只有一个副本的，保存在vcl70.bpl中，因此所有引用该包将共享一个类定义。

Answer 3

Antonio Petricca写道(谢谢！(，不可能使用is运算符。我现在已经通过比较(祖先(类名实现了这一点——我想共享代码：

function IsSameClassOrAncestor(const ClazzToCheck: TClass; const Clazz: TClass): Boolean;
begin
Result := SameText(ClazzToCheck.ClassName, Clazz.ClassName);
if not Result and not SameText(ClazzToCheck.ClassName, 'TObject') then
begin
Result := IsSameClassOrAncestor(ClazzToCheck.ClassParent, Clazz);
end;
end;

这样，我可以如下检查：

if IsSameClassOrAncestor(Component, TIBQuery)
begin
// The code is now executed correctly, also for descendants
TIBQuery(Component).Database := GetDatabase;
end;