近期在写一个类pascal解释器,对borland的RTTI机制进行了一番学习,了解了borland的RTTI机制,但本人水平有限,在学习有关接口的RTTI过程中,遇到了些无法解释的问题,在这里提出来,大家共同探讨。
首先说明“接口引用”这个概念在delphi中也许不存在,是我相对于“类引用”提出来的。我们知道在delphi 中有类引用的概念,定义方式如TClass = class of TObject,其实质是指向类RTTI的一个指针,我们可以用这个类引用实现好多动态功能。可接口就比较特殊,虽然定义语法和类定义类似,但只是一个空壳,需要通过某个具体的类来实现。虽然接口是一个空壳,但是这个空壳也有RTTI信息,可以通过TypeInfo函数得到。
在VCL中其实也运用了好多 “接口引用”的概念,比如IInterface中的QueryInterface函数,查询接口支持的函数supports等,但在delphi并没有类似“ Interface of Interface”这样的句法来定义一个接口引用,而是使用一个TGUID来完成接口引用的功能。TGUID其实被定义为一个结构类型,delphi的编译器知道如何把TGUID类型转换成接口引用来使用,但对开发者来说却是不公布的。比如:
var
  Obj : TObject;
  m:TComponent;
  ClassRef: TClass;
  Intf: IInterface;
  IID: TGUID;
begin
  obj := TComponent.Create(nil);
  ClassRef := obj.ClassType; //对于类变量,我们可以用类函数classType来取得它的类类型。
  m := obj as TComponent;
  Intf := m; //把M赋给接口变量,因为TComponent实现了IInterface接口。
  {
   IID := ? intf ;//无法取得接口变量的接口类型?!
   }
end;归结起来,写一个函数,取得一个接口变量的接口类型(GUID):
function GetIntfGUID(AIntf: IInterface):TGUID;
begin
  Result := ;//如何实现?和各位继续探讨
end;

解决方案 »

  1.   

    我对接口与是了解很少, 不过你说的功能我可是实现的.
    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;type
      IFirstIntf=interface
        ['{64C25101-E002-40EF-92DC-F0DFBF876B1C}']
        function GetName:string;
        function GetGUID:string;
        function GetIntfGUID(AIntf: IInterface):TGUID;
      end;  TFirstIntfClass=class(TInterfacedObject, IFirstIntf)
        //IFirstIntf
        function GetName:string;
        function GetGUID:string;
        function GetIntfGUID(AIntf: IInterface):TGUID;
      end;type
      TForm1 = class(TForm)
        btnSayHello: TButton;
        btnGUIID: TButton;
        lst1: TListBox;
        btnAllGUID: TButton;
        btnIntfaceToGUID: TButton;
        procedure btnSayHelloClick(Sender: TObject);
        procedure btnGUIIDClick(Sender: TObject);
        procedure btnAllGUIDClick(Sender: TObject);
        procedure btnIntfaceToGUIDClick(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementation{$R *.dfm}function TFirstIntfClass.GetName;
    begin
      Result:='Hello World';
    end;
    procedure TForm1.btnSayHelloClick(Sender: TObject);
    var
      FirstIntfClass:TFirstIntfClass;
      FirstIntf:IFirstIntf;
    begin
      FirstIntfClass:=TFirstIntfClass.Create;
      try
        FirstIntf:=FirstIntfClass;
        ShowMessage(FirstIntf.GetName);
      finally
        FirstIntf:=nil;
      end;
    end;function TFirstIntfClass.GetGUID;
    begin
      if self.GetInterfaceTable.EntryCount>0 then
        Result:=GUIDToString(Self.GetInterfaceTable.entries[0].iid)
    end;
    procedure TForm1.btnGUIIDClick(Sender: TObject);
    var
      FirstIntfClass:TFirstIntfClass;
      FirstIntf:IFirstIntf;
    begin
      FirstIntfClass:=TFirstIntfClass.Create;
      try
        FirstIntf:=FirstIntfClass;
        ShowMessage(FirstIntf.GetGUID);
      finally
        FirstIntf:=nil;
      end;
    end;procedure TForm1.btnAllGUIDClick(Sender: TObject);
    var
      I:Integer;
      FirstIntfClass:TFirstIntfClass;
      FirstIntf:IFirstIntf;
    begin
      FirstIntfClass:=TFirstIntfClass.Create;
      for I:= 0 to  FirstIntfClass.GetInterfaceTable.EntryCount-1 do begin
        lst1.Items.Add(GUIDToString(FirstIntfClass.GetInterfaceTable.Entries[I].IID));
      end;
      FirstIntfClass.Free;
    end;function TFirstIntfClass.GetIntfGUID(AIntf: IInterface):TGUID;
    var
      I:Integer;
      FirstIntfClass:TFirstIntfClass;
    begin
      FirstIntfClass:=TFirstIntfClass.Create;
      for I:=0 to FirstIntfClass.getInterfaceTable.EntryCount-1 do
        if FirstIntfClass.GetInterface(FirstIntfClass.getInterfaceTable.Entries[I].IID, AIntf) then begin
          Result:=FirstIntfClass.getInterfaceTable.Entries[I].IID;
          Exit;
        end;
      FirstIntfClass.Free;
    end;
    procedure TForm1.btnIntfaceToGUIDClick(Sender: TObject);
    var
      FirstIntfClass:TFirstIntfClass;
      FirstIntf:IFirstIntf;
      GUID:TGUID;
    begin
      GUID:=FirstIntfClass.GetIntfGUID(FirstIntf);
      if GUID.D1>0 then
        ShowMessage(GUIDToString(GUID));
    end;end.
      

  2.   

    将旺仔的代码简化一下得到:)unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;type
      TForm1 = class(TForm)
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;  IFirstIntf = interface
        ['{36838B93-BF8E-4ACD-89FE-E0D970E77BAA}']
        function GetName:string;
      end;  TFirstIntfClass = class(TInterfacedObject, IFirstIntf)
      public
        function GetName:string;
      end;var
      Form1: TForm1;implementation{$R *.dfm}function GetIntfGUID(AIntf: IInterface): TGUID;
    var
      I:Integer;
      FirstIntfClass:TFirstIntfClass;
    begin
      FirstIntfClass:=TFirstIntfClass.Create;
      for I:=0 to FirstIntfClass.getInterfaceTable.EntryCount-1 do
        if FirstIntfClass.GetInterface(FirstIntfClass.getInterfaceTable.Entries[I].IID, AIntf) then
        begin
          Result:=FirstIntfClass.getInterfaceTable.Entries[I].IID;
          Exit;
        end;
      FirstIntfClass.Free;
    end;function TFirstIntfClass.GetName: string;
    begin
      Result:='hello world!';
    end;procedure TForm1.Button1Click(Sender: TObject);
    var
      GUID: TGUID;
      FirstIntf: IFirstIntf;
    begin
      FillMemory(@GUID, SizeOf(GUID), 0);
      GUID:=GetIntfGUID(FirstIntf);
      if GUID.D1>0 then
        ShowMessage(GUIDToString(GUID));
    end;end.不过前提还是需要一个实现了该接口的类,不尽人意啊,继续讨论~~
      

  3.   

    进一步研究getInterfaceTable函数发现:)procedure TForm1.Button2Click(Sender: TObject);
    var
      FirstIntfClass: TFirstIntfClass;
      P: Pointer;
      i: Integer;
    begin
      FirstIntfClass:=TFirstIntfClass.Create;
      P:=PPointer(Integer(FirstIntfClass.ClassType) + vmtIntfTable)^;
      for i:=0 to PInterfaceTable(P)^.EntryCount-1 do
        ShowMessage(GUIDToString(PInterfaceTable(P)^.Entries[i].IID));
      FirstIntfClass.Free;
    end;可以找到一个类实现的所有接口的GUID,但是不能找到指定接口的GUID,继续讨论~~
      

  4.   

    QueryInterface 只能用来查找实现这个接口的对象的其他接口,当然这个能力是对象自己实现的,实际上是Delphi的VCL实现的。VCL中的对象可能是object实现的或者是interface object实现的,谁实现的,我实在记不清楚了,电脑上的delphi已经被我删除了。反正VCL实现的QueryInterface,他能够找到所有这个对象支持的接口,并且比较接口的GUID是不是和申请的GUID一致。Delphi不可能把一个TGuid类型的数值转换成接口来使用。delphi的接口的二进制结构和com对象的接口的完全兼容。如果,没有实现接口的对象存在,就不能得到接口的实例,就无法调用getInterfaceTable。但是,我想接口的类型信息一定已经存在了,察看实现getInterfaceTable的源代码就应该可以得到答案了。我手头已经没有delphi了,所以没法给你答案了。
      

  5.   

    经过我呕心沥血的研究终于得到如下结果:)unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;type
      TForm1 = class(TForm)
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;  IFirstIntf = interface
        ['{36838B93-BF8E-4ACD-89FE-E0D970E77BAA}']
        function GetName:string;
      end;  ISecondIntf = interface
        ['{512A5DC0-424F-48B7-84C9-453EBF352758}']
        function GetName:string;
      end;  IThirdIntf = interface
        ['{34EC1057-3B4E-4F65-9233-6CB845D16BEA}']
        function GetName:string;
      end;  TIntfClass = class(TInterfacedObject, IFirstIntf, ISecondIntf, IThirdIntf)
      public
        function GetName:string;
      end;var
      Form1: TForm1;implementation{$R *.dfm}function GetIntfGUID(AIntf: IInterface; AObject: TObject): TGUID;
    var
      P: PInterfaceTable;
      i: integer;
    begin
      FillMemory(@Result, SizeOf(TGUID), 0);
      P:=AObject.GetInterfaceTable;
      for i:=0 to P.EntryCount-1 do
        if CompareMem(Pointer(Integer(PPointer(AIntf)^)+P.EntryCount*SizeOf(TGUID)+4+(P.EntryCount-i-1)*12),
                      @P^.Entries[P.EntryCount-i-1],
                      SizeOf(TInterfaceEntry)) then
        begin
          Result:=P^.Entries[P.EntryCount-i-1].IID;
          Exit;
        end;
    end;function TIntfClass.GetName: string;
    begin
      Result:='hello world!';
    end;procedure TForm1.Button1Click(Sender: TObject);
    var
      IntfClass: TIntfClass;
      FirstIntf: IFirstIntf;
      SecondIntf: ISecondIntf;
      ThirdIntf: IThirdIntf;
    begin
      IntfClass:=TIntfClass.Create;  FirstIntf:=IntfClass;
      SecondIntf:=IntfClass;
      ThirdIntf:=IntfClass;  ShowMessage(GUIDToString(GetIntfGUID(FirstIntf, IntfClass)));
      ShowMessage(GUIDToString(GetIntfGUID(SecondIntf, IntfClass)));
      ShowMessage(GUIDToString(GetIntfGUID(ThirdIntf, IntfClass)));  FirstIntf:=nil;
      SecondIntf:=nil;
      ThirdIntf:=nil;
    end;end.但是非得一个实现了指定接口的类的对象作为参数,这个要求也不过分吧,继续讨论~~
      

  6.   

    http://blog.codelphi.com/nil/archive/2005/07/24/68198.aspx
      

  7.   

    这个问题没有意义因为你拿到一个接口,你要么知道他的确切guid,然后使用它,要么你把它转换成你所需要的另外一个确切的guid
      

  8.   

    最近比较忙,有段时间没上csdn了,没想到讨论这么热烈~~
    多谢兄弟们的鼎力支持!
    我归结了下,似乎要实现function GetIntfGUID(AIntf: IInterface):TGUID;这个函数是不可能的,在C++Builder中有扩展关键字可以从一个IInterface变量中取得它的TGUID值 ,但在delphi却没有这样的关键字。
    继续讨论
      

  9.   

    回复 alphax(弯弯曲曲,和外父老借谷) 
    这么做是有意义的,在script中,只知道拿到的是一个接口变量(实际上是varaint变量),但不知道该接口变量到底是那个接口类型的接口变量,而这正是我想知道,所以才引出了这个讨论
      

  10.   

    从实现角度看,接口引用指针只是指针的指针,它所指向的指针指向一个vmt,而vmt只是一个方法指针数组,除此以外没有任何信息,接口方法的调用最后实质上被转换成直接的对象方法调用或者通过网络转发到对象的实现方法上,你的问题等同于给定一个函数指针,然后问这个函数具有某某功能否?另一方面,guid是为了扩展性,由com通过强制接口必须实现三个方法的约定引入的,引入时只提供最基本的扩展性设施:queryinterface(_addref,_release是为queryinterface服务的),而没有引入getguid这样的方法,所以不存在般性的方法可以得到一个接口引用指针所代表的接口类型,对特定的一组接口可以通过自己附加一些协定来得到,或者给定一个确知由本地delphi对象实现的接口,可以通过检取接口vmt指针的地址和实现对象的地址的偏移量然后匹配interfacetable中的各项来取得接口指针所代表的接口id(类似于上面的兄弟写得那样),但这些方法都是实现特定的
      

  11.   

    据目前的我水平所了解,想法和alphax基本一致.肯定是有方法从一个接口变量中得到该接口类型的(delphi中),delphi的编译器就知道该怎么做,只是没有公布给程序员使用.
    或者说是给你一个接口类型,得到该接口类型的GUID(如果该接口类型使用了GUID),因为在delphi中所有有关接口类型的地方,都是使用了TGUID来代替,所以delphi的编译器肯定知道某个接口类型对应的GUID,可是我们却没有办法知道.