Delphi RTTI GetMethod('create') 不工作

Delphi RTTI GetMethod('create') not working

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

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;

你的 FindAnyClass() 功能有问题。

你应该returning

Result := typ.AsInstance;

而不是

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

它们是相同的 TRttiInstanceType 对象,因此 FindType() 是多余的。

但是,更重要的是,您正在 returning 一个 TRttiInstanceType 对象,该对象由 TRttiContext 拥有并在 TRttiContext 被销毁时被释放。

调用方不检查 ClaseRTTI 是否为 nil,但假设在您的情况下它不是 nil,则访问 ClaseRTTI.MetaclassType 并调用 ClaseRTTI.GetMethod()正在对 无效对象 进行操作。这就是 GetMethod() 崩溃的原因。但即使没有,调用 metodo.Invoke() 的行为也将是 undefined 并且也可能崩溃。

必须TRttiContext保持在范围内,直到您访问完其 RTTI 数据。


一个更安全的选择是使用 FindAnyClass() return 元类 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;