问题描述
我想获取接口引用的信息。
当我在调试时将鼠标移到接口引用上时,IDE 可以将例如“TMyObject($5864933A) 显示为 IMyInterface”,并且我想打印出与我的引用类似的内容(这似乎出问题了)。
所以,基本上,我想打电话
type
IMyInterface = interface
['{ABDA7685-DB67-43C1-947F-4B9535142355}']
end;
TMyObject = class(TInterfacedobject,IMyInterface)
end;
var
T: PTypeInfo;
I: IMyInterface;
begin
I := TMyObject.Create;
T := TypeInfo(I);
...
并使用 TypeInfo 了解有关接口类型的更多信息。
在现实世界中,“I”只是任何接口指针。因为 TypeInfo 需要一个类型而不是一个实例,所以这是不可能的。
因此,我尝试使用 Hallvard 的旧 hack,如 VssReporter
所述这会给我 IID,然后我可以用它来获取更多信息。但是,在 Delphi 10.2 中运行代码时,它似乎不再起作用。
function GetInterfaceIID(const I: IInterface; var IID: TGUID): boolean;
var
InterfaceEntry: PInterfaceEntry;
begin
InterfaceEntry := GetInterfaceEntry(I);
Result := Assigned(InterfaceEntry);
if Result then
IID := InterfaceEntry.IID;
end;
无论我使用哪个变量调用该方法,引用“I”始终是“IInterface”。
二、测试应用
var
MyInterface: IMyInterface;
UnkNown: IUnkNown;
Instance: TObject;
IID: TGUID;
begin
MyInterface := TMyObject.Create;
// Instance := GetImplementingObject(MyInterface); // not necessary since D2010
// Writeln(Instance.ClassName);
if GetInterfaceIID(MyInterface,IID) then // Results in Access Violation
writeln('MyInterface IID = ',GUIDToString(IID));
...
给我一个访问冲突。
显然,自 2006 年以来,类和接口内部的细节发生了变化。
那么任何人都可以提供该代码的工作版本或其他一些方法来获取有关接口引用的信息吗?
E:阐明目标和失败的原因
解决方法
好的,我设法把它放在一起,包括我正在寻找的方法:
function InterfaceTypeInfo(const Intf: IInterface): PTypeInfo;
以下是完整的测试程序,包括例程
program TestInterfaceTypeInfo;
{$APPTYPE CONSOLE}
{$IF CompilerVersion >= 20.0}
// Requires TDictionary,which was introduced in Delphi 2009
{$DEFINE INTF_TYPEINFO_CACHE}
{$IFEND}
uses
SysUtils,TypInfo,Rtti,{$IFDEF INTF_TYPEINFO_CACHE}
System.Generics.Collections,{$ENDIF}
Classes;
// *** A set of routines to help finding the TypeInfo for an interface reference
// The following functionality is slightly modified version of
// http://hallvards.blogspot.com/2006/09/hack11-get-guid-of-interface-reference.html
{$IFDEF INTF_TYPEINFO_CACHE}
var
// Optimized mapping of TGUID to TypeInfo
IntfTypeInfoCache: TDictionary<TGUID,PTypeInfo> = nil;
{$ENDIF}
function GetPIMTOffset(const I: IInterface): integer;
// PIMT = Pointer to Interface Method Table
const
AddByte = $04244483; // opcode for ADD DWORD PTR [ESP+4],Shortint
AddLong = $04244481; // opcode for ADD DWORD PTR [ESP+4],Longint
type
PAdjustSelfThunk = ^TAdjustSelfThunk;
TAdjustSelfThunk = packed record
case AddInstruction: longint of
AddByte : (AdjustmentByte: shortint);
AddLong : (AdjustmentLong: longint);
end;
PInterfaceMT = ^TInterfaceMT;
TInterfaceMT = packed record
QueryInterfaceThunk: PAdjustSelfThunk;
end;
TInterfaceRef = ^PInterfaceMT;
var
QueryInterfaceThunk: PAdjustSelfThunk;
begin
Result := -1;
if Assigned(Pointer(I)) then
try
QueryInterfaceThunk := TInterfaceRef(I)^.QueryInterfaceThunk;
case QueryInterfaceThunk.AddInstruction of
AddByte: Result := -QueryInterfaceThunk.AdjustmentByte;
AddLong: Result := -QueryInterfaceThunk.AdjustmentLong;
end;
except
// Protect against non-Delphi or invalid interface references
end;
end;
{$IF CompilerVersion < 21.0}
function GetImplementingObject(const I: IInterface): TObject;
var
Offset: integer;
begin
Offset := GetPIMTOffset(I);
if Offset > 0
then Result := TObject(PChar(I) - Offset)
else Result := nil;
end;
{$IFEND}
function GetInterfaceEntry(const I: IInterface): PInterfaceEntry;
var
Offset: integer;
Instance: TObject;
InterfaceTable: PInterfaceTable;
j: integer;
CurrentClass: TClass;
begin
Offset := GetPIMTOffset(I);
Instance :=
{$IF CompilerVersion >= 21.0}
I as TObject;
{$ELSE}
GetImplementingObject(I);
{$IFEND}
if (Offset >= 0) and Assigned(Instance) then
begin
CurrentClass := Instance.ClassType;
while Assigned(CurrentClass) do
begin
InterfaceTable := CurrentClass.GetInterfaceTable;
if Assigned(InterfaceTable) then
for j := 0 to InterfaceTable.EntryCount-1 do
begin
Result := @InterfaceTable.Entries[j];
if Result.IOffset = Offset then
Exit;
end;
CurrentClass := CurrentClass.ClassParent
end;
end;
Result := nil;
end;
// Finds the IID of an interface
function GetInterfaceIID(const I: IInterface; var IID: TGUID): Boolean;
var
InterfaceEntry: PInterfaceEntry;
begin
InterfaceEntry := GetInterfaceEntry(I);
Result := Assigned(InterfaceEntry);
if Result then
IID := InterfaceEntry.IID;
end;
// Finds the TypeInfo corresponding to IID of an interface
function InterfaceTypeInfoOfGUID(const IID: TGUID): PTypeInfo;
var
Context : TRttiContext;
ItemType : TRttiType;
T: TRttiInterfaceType;
begin
Result := nil;
{$IFDEF INTF_TYPEINFO_CACHE}
if not Assigned(IntfTypeInfoCache) then
begin
IntfTypeInfoCache := TDictionary<TGUID,PTypeInfo>.Create;
{$ENDIF}
for ItemType in Context.GetTypes do
begin
if ItemType is TRttiInterfaceType then
begin
T := TRttiInterfaceType(ItemType);
if T.GUID = IID then
{$IFDEF INTF_TYPEINFO_CACHE}
Result := T.Handle;
IntfTypeInfoCache.AddOrSetValue(T.GUID,T.Handle);
{$ELSE}
Exit(T.Handle);
{$ENDIF}
end
end;
{$IFDEF INTF_TYPEINFO_CACHE}
end;
if not Assigned(Result) then
IntfTypeInfoCache.TryGetValue(IID,Result);
{$ENDIF}
end;
// Finds the TypeInfo for an interface reference
function InterfaceTypeInfo(const Intf: IInterface): PTypeInfo;
var
IID: TGUID;
begin
if GetInterfaceIID(Intf,IID) then
Result := InterfaceTypeInfoOfGUID(IID)
else
Result := nil;
end;
// Test with an interface that is globally defined,such as
// IInterfaceComponentReference
var
MyInterface: IInterfaceComponentReference;
Unknown: IUnknown;
Instance: TObject;
IID: TGUID;
T: PTypeInfo;
begin
MyInterface := TComponent.Create(nil);
if GetInterfaceIID(MyInterface,IID) then
writeln('MyInterface IID = ',GUIDToString(IID));
Unknown := MyInterface;
if GetInterfaceIID(Unknown,IID) then
writeln('Derived IUnknown IID = ',GUIDToString(IID));
Unknown := TComponent.Create(nil);
if GetInterfaceIID(Unknown,IID) then
writeln('Pure IUnknown IID = ',GUIDToString(IID));
T := InterfaceTypeInfo(MyInterface);
if Assigned(T) then
begin
writeln('TypeInfo = ',T.Name,GUIDToString(T.TypeData.GUID));
writeln(Format('%s($%x) as %s',// will also need to use GetImplementingObject instead of 'as' prior to Delphi 2010
[(MyInterface as TObject).ClassName,NativeInt(MyInterface),T.Name]));
end;
readln;
{$IFDEF INTF_TYPEINFO_CACHE}
IntfTypeInfoCache.Free;
{$ENDIF}
end.
打印出来
MyInterface IID = {E28B1858-EC86-4559-8FCD-6B4F824151ED}
Derived IUnknown IID = {E28B1858-EC86-4559-8FCD-6B4F824151ED}
Pure IUnknown IID = {00000000-0000-0000-C000-000000000046}
TypeInfo = IInterfaceComponentReference{E28B1858-EC86-4559-8FCD-6B4F824151ED}
TComponent($20067E8) as IInterfaceComponentReference
E:引入 IntfTypeInfoCache 以优化搜索。
E: NativeInt(MyInterface),而不是测试代码中的Integer(MyInterface)