delphi - 在 Delphi 中获取接口引用的 GUID
问题描述
我想获取接口参考的信息。
例如,当我在调试时将鼠标移到接口引用上时,IDE 可以显示例如“TMyObject($5864933A) as 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 了解有关接口类型的更多信息。
在现实世界中,“我”只是任何接口指针。由于 TypeInfo 需要类型而不是实例,因此这是不可能的。
因此,我尝试使用 Hallvard 的旧 hack,如http://hallvards.blogspot.com/2006/09/hack11-get-guid-of-interface-reference.html所述
这会给我 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)
推荐阅读
- sql - How to subtract a column of string based on other columns in Hive?
- python - how to parse a website if the url of the search request is changing
- google-apps-script - Trying to understand setFormula vs setValue behaviour
- swift - Cannot convert value of type `AuthResultCallback`?
- go - 在同一执行线程中没有通道的上下文
- docker - How to resolve error run gitlab ci runner (windows)
- javascript - Can I have HMR (hot module replacement) with Routify?
- haskell - 在 Polysemy 中将一元值转换为 IO
- java - 自定义错误处理程序返回大量调试消息
- python - python井字游戏而