program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  IBase = interface
    procedure Foo;
  end;

  ISub = interface (IBase)
    procedure Bar;
  end;

  ISpecialBase = interface (IBase)
  end;

  ISpecialSub = interface (ISub)
  end;

  TMyClass = class(TInterfacedObject, ISpecialBase, ISpecialSub)

    procedure SpecialFoo1;
    procedure SpecialFoo2;
    procedure SpecialBar;

    procedure ISpecialBase.Foo = SpecialFoo1;

    procedure ISpecialSub.Foo = SpecialFoo2;
    procedure ISpecialSub.Bar = SpecialBar;

    function GetTheRightOne(const Param: boolean) : IBase;
  end;


{ TMyClass }

function TMyClass.GetTheRightOne(const Param: boolean): IBase;
begin
  if Param then
    Result := ISpecialBase(Self)
  else
    Result := ISpecialSub(Self);
end;

procedure TMyClass.SpecialBar;
begin
  WriteLn('SubBar');
end;

procedure TMyClass.SpecialFoo1;
begin
  WriteLn('BaseFoo');
end;

procedure TMyClass.SpecialFoo2;
begin
  WriteLn('SubFoo');
end;

function GetSub(const Intf: IInterface): ISub;
type
  PPVtable = ^PVtable;
  PVtable = ^TVtable;
  TVtable = array[0..MaxInt div SizeOf(Pointer) - 1] of Pointer;
var
  intfVTable: PPVtable;
  caddr: NativeUInt;
begin
  result := nil;
  intfVTable := PPVTable(Intf);
  // 3 is offset to user methods
  // +0 = first user method, +1 = second user method etc
  // get the "address" of the first method in ISub
  caddr := NativeUInt(intfVTable^[3+1]);
  // compiler stores number of interface entries the
  // implementing object implements right after the interface vtable
  // so if we get a low number here, it means Intf is the IBase interface
  // and not the ISub
  if caddr > $100 then
    result := ISub(Intf);
end;

procedure CallIt(const b: IBase);
var
  s: ISub;
begin
  b.Foo;

  s := GetSub(b);
  if Assigned(s) then
    s.Bar;
end;

var
  c: TMyClass;
  b: IBase;
begin
  try
    c := TMyClass.Create;

    b := c.GetTheRightOne(True);
    CallIt(b);

    WriteLn('---');

    b := c.GetTheRightOne(False);
    CallIt(b);

    WriteLn('...');

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  ReadLn;
end.