1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:

program RTTITEst;

{$APPTYPE CONSOLE}

{$M+}

uses
  SysUtils,
  Windows,
  ComObj;

type
  TMyClass = class(TInterfacedObject, IDispatch)
  protected
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  published
    procedure MyTestMethod;
    procedure MyOtherTestMethod;
  end;

type
  POleStrList = ^TOleStrList;
  TOleStrList = array[0..65535] of PWideChar;

  PDispIDList = ^TDispIDList;
  TDispIDList = array[0..65535] of Longint;

function TMyClass.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
  LocaleID: Integer; DispIDs: Pointer): HResult;
var
  P: Pointer;
begin
  P := MethodAddress(String(POleStrList(Names)^[0]));
  if P <> nil then
  begin
    PDispIDList(DispIDs)^[0] := Integer(P);
    Result := S_OK;
  end else
    Result := DISP_E_UNKNOWNNAME;
end;

function TMyClass.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

function TMyClass.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;

type
  TProc = procedure of object;

function TMyClass.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
  Method: TMethod;
begin
  Method.Code := Pointer(DispID);
  Method.Data := self;
  TProc(Method);
  Result := S_OK;
end;

procedure TMyClass.MyTestMethod;
begin
  Writeln('You called MyTestMethod!');
end;

procedure TMyClass.MyOtherTestMethod;
begin
  Writeln('You called MyOtherTestMethod!');
end;

var
  Test: TMyClass;
  MyVariant: Variant;
begin
  try
    Test := TMyClass.Create;
    Test._AddRef; // Necessary because Delphi doesn't seem to notice that Test is used on the next lines
    try
      MyVariant := Test as IDispatch;
    finally
      Test._Release;
    end;

    MyVariant.MyTestMethod; // redirects to TMyClass.MyTestMethod
    MyVariant.MyOtherTestMethod; // redirects to TMyClass.MyOtherTestMethod
    MyVariant.MyOtherTestMethodThatDoesntExist; // raises exception (because there is no such method in TMyClass)
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
  readln;
end.					

1:
2:
3:

You called MyTestMethod!
You called MyOtherTestMethod!
EOleError: Method 'MyOtherTestMethodThatDoesntExist' not supported by automation object