delphi – 如何比较TFunc / TProc的功能/对象程序？

发布时间：2020-12-15 04:29:35 所属栏目：大数据来源：网络整理

导读：我们使用TList TFunc Boolean具有某些功能…中的对象,现在要再次删除()一些条目.但是它不起作用,因为显然你根本无法将这些参考与…可靠地比较. 以下是一些测试代码： program Project1;{$APPTYPE CONSOLE}uses Generics.Defaults,SysUtils;type TFoo = class

我们使用TList< TFunc< Boolean>>具有某些功能…中的对象,现在要再次删除()一些条目.但是它不起作用,因为显然你根本无法将这些参考与…可靠地比较.

以下是一些测试代码：

program Project1;

{$APPTYPE CONSOLE}

uses
  Generics.Defaults,SysUtils;

type
  TFoo = class
  strict private
    FValue: Boolean;
  public
    constructor Create();
    function Bar(): Boolean;
  end;

{ TFoo }

function TFoo.Bar: Boolean;
begin
  Result := FValue;
end;

constructor TFoo.Create;
begin
  inherited;

  FValue := Boolean(Random(1));
end;

function IsEqual(i1,i2: TFunc<Boolean>): Boolean;
begin
  Result := TEqualityComparer<TFunc<Boolean>>.Default().Equals(i1,i2);
end;

var
  s: string;
  foo: TFoo;
  Fkt1,Fkt2: TFunc<Boolean>;

begin
  try
    Foo := TFoo.Create();

    WriteLn(IsEqual(Foo.Bar,Foo.Bar));             // FALSE (1)
    WriteLn(IsEqual(Foo.Bar,TFoo.Create().Bar));   // FALSE (2)

    Fkt1 := function(): Boolean begin Result := False; end;
    Fkt2 := Fkt1;
    WriteLn(IsEqual(Fkt1,Fkt2));                   // TRUE  (3)

    Fkt2 := function(): Boolean begin Result := False; end;
    WriteLn(IsEqual(Fkt1,Fkt2));                   // FALSE (4)

    Fkt2 := function(): Boolean begin Result := True; end;
    WriteLn(IsEqual(Fkt1,Fkt2));                   // FALSE (5)

    FreeAndNil(Foo);
  except
    on E:Exception do
      Writeln(E.Classname,': ',E.Message);
  end;
  Readln(s);
end.

我们尝试了几乎所有的东西,=运算符,比较指针等.

我们甚至尝试了一些非常讨厌的东西,如反复抛出PPointer和取消引用,直到我们得到相等的值,但是当然也没有产生令人满意的结果.

>案例(2),(4)和(5)都可以,因为实际上有不同的功能.
>案例(3)也是微不足道的.
>案例(1)是我们想要检测的,这是我们无法上班的.

我害怕,Delphi隐藏地创建了两个不同的匿名函数,将调用转发到Foo.Bar.在这种情况下,我们将完全无能为力,除非我们想通过一个未知的记忆,而且我们没有.

解决方法

您必须通过其他方式将名称或索引与它们相关联.匿名方法没有名称并且可能捕获状态(因此每个实例都重新创建它们);在不破坏封装的情况下,没有什么可比的方式使它们相当.

你可以得到方法引用后面的对象,如果它背后确实有一个对象(不能保证这个 – 方法引用的接口是用COM语义来实现的,所有他们真正需要的是一个COM vtable)：

function Intf2Obj(x: IInterface): TObject;
type
  TStub = array[0..3] of Byte;
const
  // ADD [ESP+$04],imm8; [ESP+$04] in stdcall is Self argument,after return address
  add_esp_04_imm8: TStub = ($83,$44,$24,$04);
  // ADD [ESP+$04],imm32
  add_esp_04_imm32: TStub = ($81,$04);

  function Match(L,R: PByte): Boolean;
  var
    i: Integer;
  begin
    for i := 0 to SizeOf(TStub) - 1 do
      if L[i] <> R[i] then
        Exit(False);
    Result := True;
  end;

var
  p: PByte;
begin
  p := PPointer(x)^; // get to vtable
  p := PPointer(p)^; // load QueryInterface stub address from vtable

  if Match(p,@add_esp_04_imm8) then 
  begin
    Inc(p,SizeOf(TStub));
    Result := TObject(PByte(Pointer(x)) + PShortint(p)^);
  end
  else if Match(p,@add_esp_04_imm32) then
  begin
    Inc(p,SizeOf(TStub));
    Result := TObject(PByte(Pointer(x)) + PLongint(p)^);
  end
  else
    raise Exception.Create('Not a Delphi interface implementation?');
end;

type
  TAction = reference to procedure;

procedure Go;
var
  a: TAction;
  i: IInterface;
  o: TObject;
begin
  a := procedure
    begin
      Writeln('Hey.');
    end;
  i := PUnknown(@a)^;
  o := i as TObject; // Requires Delphi 2010
  o := Intf2Obj(i); // Workaround for non-D2010
  Writeln(o.ClassName);
end;

begin
  Go;
end.

这将(目前)打印Go $0 $ActRec;但是如果您有第二个匿名方法,结构上相同,则会导致第二个方法,因为匿名方法体不会被比较,因为结构相等(这将是一个高成本,低价值的优化,因为程序员不太可能做这样的事情,大型的结构比较并不便宜).

如果您使用的是更新版本的Delphi,您可以在此对象的类上使用RTTI,并尝试比较字段,并自行实现结构比较.

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!