Delphi 如果在包内访问RTTI，则访问冲突

我编写了一个简单的控制台程序来施展一些RTTI魔法：

program TypeCast;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.RTTI, Generics.Collections;

type
  TSpr = class
  public
    s: string;
    i: Integer;
    b: Boolean;
  end;

var
  Spr: TSpr;
  vCtx: TRTTIContext;
  vType: TRTTIType;
  vField: TRTTIField;
  Dict: TDictionary<string, TRTTIField>;

begin
  try
    Spr := TSpr.Create;
    vType := vCtx.GetType(TSpr.ClassInfo);
    Dict := TDictionary<string, TRTTIField>.Create;
    for vField in vType.GetFields do
      Dict.AddOrSetValue(vField.Name, vField);
    Dict['s'].SetValue(Spr, 'Hello World!');
    Dict['i'].SetValue(Spr, 123);
    Dict['b'].SetValue(Spr, True);
    Writeln(Spr.s);
    Writeln(Spr.i);
    Writeln(Spr.b);
    Spr.Free;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

如果我编译并运行这个程序，它可以正常工作。但如果我使用这种技术将这些类型的变量转发到另一个包中定义的对象，这会给我带来很多麻烦

MCVE素材/复制步骤：
…假设您从空环境开始

创建

PluginInterface

包。在那里添加

UClassManager

unit UClassManager;

interface

uses
  Classes, Contnrs;

type
  TClassManager = class(TClassList);

function ClassManager: TClassManager;

implementation

var
  Manager: TClassManager;

function ClassManager: TClassManager;
begin
  Result := Manager;
end;

initialization
Manager := TClassManager.Create;

finalization
Manager.Free;

end.

和

UPlugin

单位

unit UPlugin;

interface

uses RTTI;

type
  TPlugin = class
  public
    procedure Init; virtual; abstract;
    function SetProp(Key: string; Value: TValue): Boolean; virtual; abstract;
  end;

  TPluginClass = class of TPlugin;
  IPluginHost = interface
    function RunPlugin(PluginName: string): TPlugin; // Run Plugin by it's ClassName
  end;

var
  Host: IPluginHost;

implementation

end.

创建

VCL表单应用程序

，启用运行时包，添加对

PluginInterface

的引用，并在其上添加TButton。为相应的事件生成以下处理程序：

procedure TForm1.FormCreate(Sender: TObject);
begin
  LoadPackage('UniversalSpr.bpl');
  Host := Self;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Plugin: TPlugin;
begin
  Plugin := Host.RunPlugin('TSprPlugin');
  Plugin.Init;
  Plugin.SetProp('SprTableName', 'MATERIALS');
  Plugin.SetProp('EditRights', True);
  Plugin.SetProp('BeforePostValue1', 3);
end;

function TForm1.RunPlugin(PluginName: string): TPlugin;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to ClassManager.Count - 1 do
    if ClassManager[I].ClassNameIs(PluginName) then begin
      Result := TPluginClass(ClassManager[I]).Create;
      Break;
    end;
end;

对于粗糙，

TForm1

应该是

IPluginHost

的后代。不要忘记将

UClassManager

和

UPlugin

添加到

uses

子句中。其他单元将由IDE自动添加

创建包

UniversalSpr

，并将其输出文件放在应用程序所在的同一目录中。在

TSprPlugin

内部实现

UPlugin

：

unit USprPlugin;

interface

uses
  UPlugin, RTTI, Generics.Collections;

type
  TSpr = class
    SprTableName: string;
    BeforePostValue1: int64;
    EditRights: boolean;
  end;
  TSprPlugin = class(TPlugin)
    procedure Init; override;
    function SetProp(Key: string; Value: TValue): Boolean; override;
    private
      Spr: TSpr;
      PropDict: TDictionary<string, TRTTIField>;
  end;

implementation

procedure TSprPlugin.Init;
var
  vCtx: TRTTIContext;
  vType: TRTTIType;
  vField: TRTTIField;
begin
  if not Assigned(Spr) then
    Spr := TSpr.Create;
  vType := vCtx.GetType(Spr.ClassInfo);
  if not Assigned(PropDict) then
    PropDict := TDictionary<string, TRTTIField>.Create;
  for vField in vType.GetFields do
    PropDict.Add(vField.Name, vField);
end;

function TSprPlugin.SetProp(Key: string; Value: TValue): Boolean;
var
  Field: TRTTIField;
begin
  Result := PropDict.TryGetValue(Key, Field);
  if Result then
    // here I get Access Violation
    Field.SetValue(Spr, Value);
end;

end.

---

Dalija建议避免使用包，我已经考虑到了这一点，这就是为什么我创建了

TypeCast

来测试RTTI。但我需要软件包，因为我的应用程序的设计，我不能仅仅将其重写为单一的。在不放弃软件包的情况下，如何避免这种访问冲突？

无论是否使用运行时软件包，您当前的代码都存在一些问题。您的MCVE并不是完全最小的，而且您已经从正在工作的控制台应用程序向打包的代码中添加了太多无法工作的步骤

在调试您的问题时，您应该先将逻辑封装到

TSprPlugin

类中，然后直接测试该类，而不会弄乱运行时包。当您确定

TSprPlugin

code功能正常时，您可以添加软件包并查看其运行情况

现在，您的代码在以下简单测试项目中失败

program test;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  USprPlugin in 'USprPlugin.pas',
  UPlugin in 'UPlugin.pas';

var
  Plugin: TPlugin;

begin
  Plugin := TSprPlugin.Create;
  Plugin.Init;

  Plugin.SetProp('SprTableName', 'MATERIALS');
  Plugin.SetProp('EditRights', True);
  Plugin.SetProp('BeforePostValue1', 3);
end.

将

vCtx

从局部变量移动到

TSprPlugin

字段解决了上述测试用例的问题

unit USprPlugin;

interface

uses
  UPlugin, RTTI, UniversalSprUnit, Generics.Collections;

type
  TSprPlugin = class(TPlugin)
    vCtx: TRTTIContext;
    procedure Init; override;
    function SetProp(Key: string; Value: TValue): Boolean; override;
    private
      Spr: TSpr;
      PropDict: TDictionary<string, TRTTIField>;
  end;

implementation

procedure TSprPlugin.Init;
var
  vType: TRTTIType;
  vField: TRTTIField;
begin
  vCtx := TRttiContext.Create;
  if not Assigned(Spr) then
    Spr := TSpr.Create;
  vType := vCtx.GetType(Spr.ClassInfo);
  if not Assigned(PropDict) then
    PropDict := TDictionary<string, TRTTIField>.Create;
  for vField in vType.GetFields do
    PropDict.Add(vField.Name, vField);
end;

function TSprPlugin.SetProp(Key: string; Value: TValue): Boolean;
var
  Field: TRTTIField;
begin
  Result := PropDict.TryGetValue(Key, Field);
  if Result then
    // here I get Access Violation
    Field.SetValue(Spr, Value);
end;

end.

单位USprPlugin；
接口
使用
UPlugin、RTTI、UniversalSprUnit、泛型药。收藏；
类型
TSprPlugin=class（TPlugin）
vCtx:trtti上下文；
程序初始化；推翻
函数SetProp（键：字符串；值：TValue）：布尔；推翻
私有的
Spr:TSpr；
本题：t词典；
结束；
实施
程序TSprPlugin.Init；
变量
v型：trtti型；
vField:TRTTIField；
开始
vCtx:=TRttiContext.Create；
如果未分配（Spr），则
Spr:=TSpr.Create；
vType:=vCtx.GetType（Spr.ClassInfo）；
如果未分配（PropDict），则
PropDict:=TDictionary.Create；
对于vType.GetFields中的vField
添加（vField.Name，vField）；
结束；
函数TSprPlugin.SetProp（键：字符串；值：TValue）：布尔；
变量
字段：TRTTIField；
开始
结果：=PropDict.TryGetValue（键，字段）；
如果结果是这样的话
//这里我得到了访问权限冲突
字段设置值（Spr，值）；
结束；
结束。

从这里开始，您可以一步一步地添加其他功能，确保每一步都不会破坏功能

---

此外，您没有释放

Spr

和

PropDict

字段，因此造成内存泄漏，但我不确定是否因为该代码与您所遇到的问题没有直接联系，或者您确实存在内存泄漏而未包含该代码。

从中不清楚的是软件包的排列方式。我希望任何对不同包中定义的类型执行RTTI的尝试都会失败。您是否考虑过进行一些调试以确定哪一行代码失败，以及哪一引用是

nil

？顺便说一句，您不需要编写

vCtx:=TRTTIContext。创建
，您可以删除该行。
TRttiContext
变量将自动初始化。您不需要
vCtx.Free
，您可以删除该行。嗯，我声明
USprPlugin
和
UniversalSprUnit
使用相同的包，它是
UniversalSpr
。通过调试，我发现我可以读取
PropDict[Key]
的属性，除了
FieldType
。另外，不要测试
ContainsKey
，然后测试
GetValue
。它执行两次查找。使用
TryGetValue
一次完成。您删除了一些不相关的内容，但这远远不是正确的MCVE。您未能创建最简单的示例，仍然有很多不足之处，但最重要的是，您未能创建完整且可验证的示例。我不能不做很多猜测就把你的代码按原样编译。说
ClassManager
是一个简单的类列表并不能减少它。如何填充它，如何初始化主机，如何从其名称中查找插件。这就是你真正的问题可能隐藏的所有相关信息。实际上，TRTTIContext是记录，而不是类，所以我认为它不需要显式创建。当我介绍软件包时，问题就出现了，我不能简单地避免它们，我有很多用插件范例编写的代码。另外，在设置
TypeCast
程序中的s、I、b之前，我最初调用了
vCtx.Free
。我可以假设释放对象实际上并不会擦除它，但让我挑明一点：记录不是显式创建的，它是记录，所以它的内存不必分配给
Create
，但这并不意味着可以省略其他初始化。同样的方法，
Free
可以使记录中的数据无效，即使记录仍然存在于内存中。在这种情况下，我更喜欢遵循文档。
program test;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  USprPlugin in 'USprPlugin.pas',
  UPlugin in 'UPlugin.pas';

var
  Plugin: TPlugin;

begin
  Plugin := TSprPlugin.Create;
  Plugin.Init;

  Plugin.SetProp('SprTableName', 'MATERIALS');
  Plugin.SetProp('EditRights', True);
  Plugin.SetProp('BeforePostValue1', 3);
end.

unit USprPlugin;

interface

uses
  UPlugin, RTTI, UniversalSprUnit, Generics.Collections;

type
  TSprPlugin = class(TPlugin)
    vCtx: TRTTIContext;
    procedure Init; override;
    function SetProp(Key: string; Value: TValue): Boolean; override;
    private
      Spr: TSpr;
      PropDict: TDictionary<string, TRTTIField>;
  end;

implementation

procedure TSprPlugin.Init;
var
  vType: TRTTIType;
  vField: TRTTIField;
begin
  vCtx := TRttiContext.Create;
  if not Assigned(Spr) then
    Spr := TSpr.Create;
  vType := vCtx.GetType(Spr.ClassInfo);
  if not Assigned(PropDict) then
    PropDict := TDictionary<string, TRTTIField>.Create;
  for vField in vType.GetFields do
    PropDict.Add(vField.Name, vField);
end;

function TSprPlugin.SetProp(Key: string; Value: TValue): Boolean;
var
  Field: TRTTIField;
begin
  Result := PropDict.TryGetValue(Key, Field);
  if Result then
    // here I get Access Violation
    Field.SetValue(Spr, Value);
end;

end.