近期在写一个类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;
首先说明“接口引用”这个概念在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;
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.
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.不过前提还是需要一个实现了该接口的类,不尽人意啊,继续讨论~~
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,继续讨论~~
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.但是非得一个实现了指定接口的类的对象作为参数,这个要求也不过分吧,继续讨论~~
多谢兄弟们的鼎力支持!
我归结了下,似乎要实现function GetIntfGUID(AIntf: IInterface):TGUID;这个函数是不可能的,在C++Builder中有扩展关键字可以从一个IInterface变量中取得它的TGUID值 ,但在delphi却没有这样的关键字。
继续讨论
这么做是有意义的,在script中,只知道拿到的是一个接口变量(实际上是varaint变量),但不知道该接口变量到底是那个接口类型的接口变量,而这正是我想知道,所以才引出了这个讨论
或者说是给你一个接口类型,得到该接口类型的GUID(如果该接口类型使用了GUID),因为在delphi中所有有关接口类型的地方,都是使用了TGUID来代替,所以delphi的编译器肯定知道某个接口类型对应的GUID,可是我们却没有办法知道.