implements 指令在 64 位版本中不起作用

Question

在 Delphi 中，您可以将接口的实现委托给类属性。 在示例中，TImplementator 类实现 IImplementsInterface 协定，聚合该类 - 它的真正实现者 (TImplementsForm)，同时还监视其生命周期。 ButtonTestClick 方法表明这在 Win32 下有效（很长一段时间，有几十个接口）。在Win64下，调用过程可以工作，当调用函数时我们得到一个异常（AV）

  IImplementsInterface = interface
    ['{8E978167-9C0C-414F-BBE8-037D6D865575}']
    function GetResultAV: Integer;
    procedure TestOk;
  end;

  TImplementsForm = class(TForm, IImplementsInterface)
    ButtonTest: TButton;
    procedure ButtonTestClick(Sender: TObject);
  protected
    { IImplementsInterface }
    function GetResultAV: Integer;
    procedure TestOk;
  public
  end;

  TComponentAggregator<T: TComponent> = class(TInterfacedObject)
  private
    FComponent: T;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TCustomImplementator<T: TComponent> = class(TComponentAggregator<T>, IImplementsInterface)
  private
    function GetImplementator: IImplementsInterface;
  protected
    property Implementator: IImplementsInterface read GetImplementator implements IImplementsInterface;
  end;

  TImplementator = class(TCustomImplementator<TImplementsForm>, IImplementsInterface);

var
  ImplementsForm: TImplementsForm;

implementation

{$R *.dfm}

{ TComponentAggregator<T> }

constructor TComponentAggregator<T>.Create;
begin
  inherited Create;
  FComponent := T.Create(nil);
end;

destructor TComponentAggregator<T>.Destroy;
begin
  FComponent.Free;
  inherited Destroy;
end;

{ TImplementator }

function TCustomImplementator<T>.GetImplementator: IImplementsInterface;
begin
  Supports(FComponent, IImplementsInterface, Result);
end;

{ TImplementsForm }

procedure TImplementsForm.ButtonTestClick(Sender: TObject);
begin
  var LImplementsInterface: IImplementsInterface := TImplementator.Create; // LImplementsInterface - TImplementator as IImplementsInterface
  LImplementsInterface.TestOk;     // Ok x32, ok x64
  var LResult := LImplementsInterface.GetResultAV; // Ok x32, ACCESS_VIOLATION x64
end;

function TImplementsForm.GetResultAV: Integer;
begin
  Result := -1;
end;

procedure TImplementsForm.TestOk;
begin
  ShowMessage('TImplementsForm.Test');
end

Win64下如何实现效果

Answer 1

准确地说：AV 不会发生在您标记的行中，而是发生在该方法的尾声期间，当

LImplementsInterface

变量即将被清除时。

单步执行代码让我相信这是一些编译器故障，但我并不完全确定。

无论如何：在这一行中实现

IImplementsInterface

是多余的并导致这个问题：

TImplementator = class(TCustomImplementator<TImplementsForm>, IImplementsInterface);

该接口已在通用

TCustomImplementator<T>

类中实现，当您将其从

TImplementator

中删除时，代码将正常工作 (*)。

(*) 因为不会有 AV - 你仍然有内存泄漏，因为通过使用接口委托，你还委托了

_AddRef

/

_Release

调用，并且将它们委托给了

TComponent

实例 -这意味着您正在泄漏包装您的

TComponentAggregator

的

TComponent

实例。