delphi - 在Delphi中获取接口(interface)引用的GUID

标签 delphi interface rtti

我想获取接口(interface)引用的信息。

当我在调试时将鼠标移到接口(interface)引用上时，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 来查找有关接口(interface)类型的更多信息。

在现实世界中，“I”只是任何接口(interface)指针。由于 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 年以来，类和接口(interface)内部的细节已经发生了变化。

那么任何人都可以提供该代码的工作版本或其他一些方法来获取有关接口(interface)引用的信息吗？

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)

关于delphi - 在Delphi中获取接口(interface)引用的GUID，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/65940537/

上一篇：ruby-on-rails - 是否有推荐的方法来替换 Rails 中的保留类型列？

下一篇：reactjs - typescript 使用字符串或字符串[]

相关文章：

c++ - 验证基础对象是否属于特定的派生类型

c++ - 需要帮助将 Graphics32 Delphi 示例转换为 C++

delphi - 如何在没有每新行给出两个字符的情况下计算 RichEdit 中的字符数？

go - 在非本地包中扩展接口(interface)方法

java - 为接口(interface)方法指定抽象或不指定有什么区别？

delphi - 使用 RTTI 访问记录的所有元素

delphi - 尝试调用 tru RTTI 函数；无效的类型转换

android - 如何在Delphi中检查和挂断/拒绝Android上的来电/去电？

delphi - Firemonkey 中的 BringToFront 问题

c# - 是否可以强制接口(interface)实现在 C# 中是虚拟的？

©2024 IT工具网  联系我们