unit VmtUtils;

interface

uses
  TypInfo;

type
  PVmtMethodTable = ^TVmtMethodTable;
  TVmtMethodTable = packed record
   {Count: Word;}
   {Entry: array[1..Count] of TVmtMethodEntry;}
    ExCount: Word;
    ExEntry: array[0..0] of TVmtMethodExEntry;
  end;

function GetMethodTable(AClass: TClass): PVmtMethodTable;
function GetVirtualIndex(AClass: TClass; AMethod: Pointer): SmallInt;
function GetVirtualMethodAddress(AClass: TClass; AVirtualIndex: SmallInt): Pointer;
function IsOverridden(ABaseClass, AChildClass: TClass; AMethod: Pointer): Boolean;

implementation

function GetMethodTable(AClass: TClass): PVmtMethodTable;
begin
  Result := PPointer(PByte(AClass) + vmtMethodTable)^;
  if Result <> nil then
  begin
    // skip the first entries
    Inc(PByte(Result), Result.ExCount * SizeOf(Pointer));
    Inc(PByte(Result), SizeOf(Word));
  end;
end;

function GetVirtualIndex(AClass: TClass; AMethod: Pointer): SmallInt;
var
  table: PVmtMethodTable;
  i: Word;
begin
  while AClass <> nil do
  begin
    table := GetMethodTable(AClass);
    if table <> nil then
      for i := 0 to table.ExCount - 1 do
        if table.ExEntry[i].Entry.CodeAddress = AMethod then
          Exit(table.ExEntry[i].VirtualIndex);
    AClass := AClass.ClassParent;
  end;
  Result := -1;
end;

function GetVirtualMethodAddress(AClass: TClass; AVirtualIndex: SmallInt): Pointer;
var
  table: PVmtMethodTable;
  i: Word;
begin
  while AClass <> nil do
  begin
    table := GetMethodTable(AClass);
    if table <> nil then
      for i := 0 to table.ExCount - 1 do
        if table.ExEntry[i].VirtualIndex = AVirtualIndex then
          Exit(table.ExEntry[i].Entry.CodeAddress);
    AClass := AClass.ClassParent;
  end;
  Result := nil;
end;

function IsOverridden(ABaseClass, AChildClass: TClass; AMethod: Pointer): Boolean;
var
  index: SmallInt;
begin
  index := GetVirtualIndex(ABaseClass, AMethod);
  Result := AMethod <> GetVirtualMethodAddress(AChildClass, index);
end;

end.