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;
我有一个使用 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;