如何通过接口的DispID 获取方法名？

Question

最近研究了Delphi RTTI
想要实现一个类似TAutoObject功能的类
经过以下试验分析
Delphi 的双重接口的调用模式大致如下
  //接口
  ITest = interface(IDispatch)
  ['{C8E5E6FF-FBF2-4397-A4F3-8041DF9548E8}']
    function Test: Boolean; stdcall;
  end;
  {$m-}{$METHODINFO OFF}
  //disp接口
  ITestDisp = dispinterface
  ['{C8E5E6FF-FBF2-4397-A4F3-8041DF9548E8}']
    function Test: Boolean; dispid 500;
  end;
  TTest = class(TInterfacedObject, ITest, IDispatch)
  protected
    function Test: Boolean; stdcall;
    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;
  end;//以下是调用
var
  I: ITest;
  Disp: ITestDisp;
  V: Variant;
begin
  //用非disp接口调用, 直接执行到 Test 方法内部
  I := TTest.Create;
  I.Test;
  //用dips接口调用,执行到Invoke,再由 Invoke 执行其它方法
  Disp := TTest.Create as ITestDisp;
  Disp.Test;
  //用Variant调用,首先执行到 GetIDsOfNames 获取方法ID,然后再执行到 Invoke 再由 Invoke 执行其它方法
  V := TTest.Create as ITestDisp;
  V.Test;
end;
我想要的效果正是类似DispID的效果, 既只要有接口就可以调用, 避免传错参数或调错方法,
然而我发现当执行到 Invoke 时传来的只是方法的DispID
于是我无从下手了,不知道该如何把DispID解释成方法名或方法地址,于是无法进行调用实际想调用的方法跟据我的实验,用Variant的方式,只要在其调用GetIDsOfNames时生成一个模拟的DispID,
这个DispID便可以由Invoke获取了,然而这个DispID却不是接口声明时的DispID,于是
用disp接口仍然无法获取方法地址.我跟踪过TAutoObject的调用，他的调用是通过工厂类直接执行，然而一直跟踪下去才发现他是调用了Ole32 API，而这个API
是需要IDL Table支持的，即一定要是COM或COM+才能获取到。用Variant调用的方式确实能满足我的需要,但其不能直接使用接口调用,传错参数也能编译通过,并且效比较低,
首先要执行 GetIDsOfNames获取方法ID,再进行调用。经过跟踪调试发现,只要引用了ComObj单元,Disp接口调用时，都会调用到ComObj的DispCallByIDProc函数指针，该指针指向
DispCallByID 函数，通过修改这个函数的指针，指向自己的DispCallByID,由DispCallByID转向Invoke以外的另一个方法把
方法名传过去，也能达到我想要的效果，但是这样做是修改了Delphi内部的调用机制，比起
这种方法，我更倾向于使用原有的机制，如果通过通过DispID获取到方法地址那才是最佳解决案。

Answer 1

高手提的问题，太难了。
我也曾经想过这个问题，不过我的应用仅仅是用别人接口的Invoke,但是没有勇气去解决。 反问一个问题，你上面的代码执行不通耶。第二、第二种调用都执行不过。期望高手为你解决。

Answer 2

呵呵，不好意思，上面的代码是我随手打上去的，dispinterface 不支持 Boolean类型
将 Test: Boolean 改成Variant即可

Answer 3

我将完整代码贴上
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj, ObjAuto, ActiveX;
type
  {$m+}{$METHODINFO ON} {$P+}
  ITest = interface(IDispatch)
  ['{C8E5E6FF-FBF2-4397-A4F3-8041DF9548E8}']
    function Test: Variant;
  end;
  ITestDisp = dispinterface
  ['{C8E5E6FF-FBF2-4397-A4F3-8041DF9548E8}']
    function Test: Variant; dispid 101;
  end;  {$m-}{$METHODINFO OFF}{$P-}
  TTest = class(TInterfacedObject, ITest, IDispatch)
  protected
    //function Invoke(MethodName: string; var Params; var VarResult, ExcepInfo: Pointer): HResult; stdcall;
    function Test: Variant;
    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;
  end;  TForm3 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.btn1Click(Sender: TObject);
var
  Id: ITestDisp;
  V: OleVariant;
  I: ITest;
begin
  I := TTest.Create;
  Id := TTest.Create as ITestDisp;
  V := TTest.Create as IDispatch;
  I.Test;
  Id.Test;
  V.Test;  I := nil;
  Id := nil;
  V := Unassigned;
end;{TTest}function TTest.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
  LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  //Variant类型调用将执行到此处
  ShowMessage('GetIDsOfNames');
  PDispIdList(DispIDs)^[0] := -1;
  Result := S_OK;
end;function TTest.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := S_OK;
end;function TTest.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := S_OK;
end;function TTest.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
  //难题就在这了, 看看是否是GetIDsOfName中返回的DispID?
  //如果是dispinterface调用的将直接传入"function Test: Variant; dispid 101;" 中的dispid 101
  ShowMessage(IntToStr(DispID));
  //本应该在此处获取方法地址
end;function TTest.Test: Variant;
begin
  Result := 'OK';
  ShowMessage('Test!');
end;//procedure IntefCall(Result: Pointer; const Dispatch: IDispatch;
//  DispDesc: PDispDesc; Params: Pointer); cdecl;
//var
//  LArgCount: Integer;
//  LIdent: string;
//begin
//  LArgCount := DispDesc^.CallDesc.ArgCount;
//  LIdent := Uppercase(String(PChar(@(DispDesc^.CallDesc).ArgTypes[LArgCount])));
//可在此处通过Dispatch获取实例地址并调用非Invoke方法
//end;initialization
  //此处可重写系统DispCallByIDProc函数
  //DispCallByIDProc := @IntefCall;
end.

Answer 4

ObjComAuto单元中有一个类：TObjectDispatch, 但它仅仅是一个TObject的代理类，同样不能完成显试Disp接口的调用。

Answer 5

bu cuo,挺简单的，看看api就能搞定。。

Answer 6

这个方法也是待实现方法，要实现起来也不难，关键是不能通过DispID获取方法名。