Delphi RTTI GetMethod ('create')不工作

Question

我有一个简单的过程来使用 RTTI 查找类构造函数。但我不知道为什么，抛出了一个访问冲突异常。

procedure simplemethod;
var
   QRClass : TClass;
   ClaseRTTI : TRttiInstanceType;
   metodo : TRttiMethod; 
   Ctx: TRttiContext;
begin
  ctx := TRttiContext.Create;
  ClaseRTTI := Ctx.FindType('unitname.classname') as TRttiInstanceType;
  QRClass := ClaseRTTI.MetaclassType;
  metodo := ClaseRTTI.GetMethod('create');
  ctx.Free; 
end;

“create”构造函数是继承的，并且未在 unitname.classname 中声明。

编辑

这里我有实际的代码

 function TFDatosDocumentacionOficial.GenerarDocumentacion(p_idtabla, p_id, p_idserie_documento,
                                                           p_idtdocumento, p_idusuario, p_idinforme : integer;
                                                           p_subsis : string = '') : integer;
 var
   QRClass : TClass;
   FQRPlan : TFQRPlanFR3;
   FQRMDPlan : TFQRMDPlanFR3;
   Instancia : TValue;
   ClaseRTTI : TRttiInstanceType;
   fichero : string;
   filtro: string;
   //
   metodo : TRttiMethod;
 begin
   QTDocumento.open;
   QSerieDocumento.open;
   if QTDocumento.locate('IDTDOCUMENTO', p_idtdocumento, []) then
   begin
     fichero := QTDocumentoDESCRIPCION.asString+' '+QSerieDocumentoDESCRIPCIONCORTA.asString+'_'+QSerieDocumentoPROX_NUM.asString+'.pdf';
     ClaseRTTI := utiles.findAnyClass( QTDocumentoQR.AsString );
     QRClass := ClaseRTTI.MetaclassType;
     metodo := ClaseRTTI.GetMethod('create');
     Instancia := metodo.Invoke(QRClass,[self,1,p_idinforme]);
   end;
end;

findAnyClass 是

function FindAnyClass(const Name: string): TRttiInstanceType;
var
  ctx: TRttiContext;
  typ: TRttiType;
  list: TArray<TRttiType>;
begin
  Result := nil;
  ctx := TRttiContext.Create;
  list := ctx.GetTypes;
  for typ in list do
    begin
      if typ.IsInstance and (EndsText(Name, typ.Name)) then
        begin
          Result := Ctx.FindType(typ.asInstance.DeclaringUnitName+'.'+typ.Name) as TRttiInstanceType;
          break;
        end;
    end;
  ctx.Free;
end;

Answer 1

您的FindAnyClass()功能有问题。

你应该回来了

Result := typ.AsInstance;

而不是

Result := Ctx.FindType(typ.asInstance.DeclaringUnitName+'.'+typ.Name) as TRttiInstanceType;

它们是相同的TRttiInstanceType对象，所以FindType()是多余的。

但是，更重要的是，您返回的是 TRttiInstanceType TRttiContext 拥有的对象并在 TRttiContext 时被释放已被摧毁。

调用者没有检查 ClaseRTTI 是否是 nil ，但假设它不是 nil根据您的情况，访问 ClaseRTTI.MetaclassType并调用ClaseRTTI.GetMethod()正在对无效对象进行操作。这就是为什么GetMethod()崩溃。但即使没有，调用 metodo.Invoke() 的行为将是未定义并且也可能崩溃。

您必须保留 TRttiContext范围内，直到您完成对其 RTTI 数据的访问。

<小时/>

更安全的选择是 FindAnyClass()返回元类TClass相反，然后调用者可以简单地对其进行类型转换并调用它的 Create()通常构造函数而不是通过 RTTI，例如:

function FindAnyClass(const Name: string): TClass;
var
  ctx: TRttiContext;
  typ: TRttiType;
begin
  Result := nil;
  for typ in ctx.GetTypes do
  begin
    if typ.IsInstance and (EndsText(Name, typ.Name)) then
    begin
      Result := typ.AsInstance.MetaclassType;
      break;
    end;
  end;
end;

然后你可以这样做:

// tweak this to match your actual code as needed...
type
  TQRBase = class(... whatever ...)
  public
    constructor Create(... params ...); virtual;
  end;

  TQRClass = class of TQRBase;

// derive other classes from TQRBase as needed...

...

function TFDatosDocumentacionOficial.GenerarDocumentacion(p_idtabla, p_id, p_idserie_documento,
                                                           p_idtdocumento, p_idusuario, p_idinforme : integer;
                                                           p_subsis : string = '') : integer;
var
  QRClass : TQRClass;
  Instancia : TQRBase;
  ...
begin
  QTDocumento.open;
  QSerieDocumento.open;
  if QTDocumento.locate('IDTDOCUMENTO', p_idtdocumento, []) then
  begin
    ...
    QRClass := utiles.findAnyClass( QTDocumentoQR.AsString ) as TQRClass;
    Instancia := QRClass.Create(Self, 1, p_idinforme);
    ...
  end;
end;