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，然后调用者可以简单地键入它并通常而不是通过RTTI调用它的Create()构造函数，例如：

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;