正如 David 已经提到的,问题是编译器为返回方法类型的属性生成错误的 RTTI。
所以对于房产
property OnIntegerValue: TOnIntegerValue;
编译器为如下所示的方法生成 RTTI:
function OnIntegerValue: Integer;
但它不包括此方法的隐式 Self 参数。这就是您收到范围检查错误的原因,因为在读取 RTTI 以创建 TRttiInterfaceType 时,会执行这行代码:
SetLength(FParameters, FTail^.ParamCount - 1);
这绝不应该发生,因为所有有效方法都具有隐式 Self 参数。
错误的 RTTI 还有另一个问题,因为它会因为它生成的无效方法而弄乱了虚拟方法的索引。如果方法类型有一个参数,您不会得到范围检查错误,而是一个错误的 TRttiMethod 实例,这会导致所有后续方法具有错误的虚拟索引,这将导致虚拟接口调用失败。
这是我写的一个单元,你可以用它来修复错误的 RTTI。
unit InterfaceRttiPatch;
interface
uses
TypInfo;
procedure PatchInterfaceRtti(ATypeInfo: PTypeInfo);
implementation
uses
Windows;
function SkipShortString(P: Pointer): Pointer;
begin
Result := PByte(P) + PByte(P)^ + 1;
end;
function SkipAttributes(P: Pointer): Pointer;
begin
Result := PByte(P) + PWord(P)^;
end;
procedure PatchInterfaceRtti(ATypeInfo: PTypeInfo);
var
typeData: PTypeData;
table: PIntfMethodTable;
p: PByte;
entry: PIntfMethodEntry;
tail: PIntfMethodEntryTail;
methodIndex: Integer;
paramIndex: Integer;
next: PByte;
n: UINT_PTR;
count: Integer;
doPatch: Boolean;
function IsBrokenMethodEntry(entry: Pointer): Boolean;
var
p: PByte;
tail: PIntfMethodEntryTail;
begin
p := entry;
p := SkipShortString(p);
tail := PIntfMethodEntryTail(p);
// if ParamCount is 0 the compiler has generated
// wrong typeinfo for a property returning a method type
if tail.ParamCount = 0 then
Exit(True)
else
begin
Inc(p, SizeOf(TIntfMethodEntryTail));
Inc(p, SizeOf(TParamFlags));
// if Params[0].ParamName is not 'Self'
// and Params[0].Tail.ParamType is not the same typeinfo as the interface
// it is very likely that the compiler has generated
// wrong type info for a property returning a method type
if PShortString(p)^ <> 'Self' then
begin
p := SkipShortString(p); // ParamName
p := SkipShortString(p); // TypeName
if PIntfMethodParamTail(p).ParamType^ <> ATypeInfo then
Exit(True);
end;
end;
Result := False;
end;
begin
if ATypeInfo.Kind <> tkInterface then Exit;
typeData := GetTypeData(ATypeInfo);
table := SkipShortString(@typeData.IntfUnit);
if table.RttiCount = $FFFF then Exit;
next := nil;
for doPatch in [False, True] do
begin
p := PByte(table);
Inc(p, SizeOf(TIntfMethodTable));
for methodIndex := 0 to table.Count - 1 do
begin
entry := PIntfMethodEntry(p);
p := SkipShortString(p);
tail := PIntfMethodEntryTail(p);
Inc(p, SizeOf(TIntfMethodEntryTail));
for paramIndex := 0 to tail.ParamCount - 1 do
begin
Inc(p, SizeOf(TParamFlags)); // TIntfMethodParam.Flags
p := SkipShortString(p); // TIntfMethodParam.ParamName
p := SkipShortString(p); // TIntfMethodParam.TypeName
Inc(p, SizeOf(PPTypeInfo)); // TIntfMethodParamTail.ParamType
p := SkipAttributes(p); // TIntfMethodParamTail.AttrData
end;
if tail.Kind = 1 then // function
begin
p := SkipShortString(p); // TIntfMethodEntryTail.ResultTypeName
Inc(p, SizeOf(PPTypeInfo)); // TIntfMethodEntryTail.ResultType
end;
p := SkipAttributes(p); // TIntfMethodEntryTail.AttrData
if doPatch and IsBrokenMethodEntry(entry) then
begin
WriteProcessMemory(GetCurrentProcess, entry, p, next - p, n);
count := table.Count - 1;
p := @table.Count;
WriteProcessMemory(GetCurrentProcess, p, @count, SizeOf(Word), n);
count := table.RttiCount;
p := @table.RttiCount;
WriteProcessMemory(GetCurrentProcess, p, @count, SizeOf(Word), n);
p := PByte(entry);
end;
end;
p := SkipAttributes(p); // TIntfMethodTable.AttrData
next := p;
end;
end;
end.