Delphi 64位版本implements指令失效，调用函数触发AV异常

在Delphi中，可通过类属性的implements关键字委托接口实现。示例里的TImplementator类实现IImplementsInterface接口，聚合实际实现类TImplementsForm并管理其生命周期。该逻辑在Win32平台运行正常，但在Win64环境中，调用接口的过程方法（procedure）正常，调用函数方法（function）时会触发访问违例（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.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;

问题原因 #

这是Delphi Win64平台下的编译器实现问题：当使用implements将接口委托给动态获取的属性（通过read方法返回接口实例）时，Win64的调用约定在处理函数返回值时出现偏差。过程方法无返回值，所以不受影响；但函数方法需要返回值，调用栈的寄存器使用不符合Win64规范，最终触发访问违例。

解决方法 #

方法1：显式实现接口方法并转发

取消implements属性委托，在TCustomImplementator中显式实现IImplementsInterface的所有方法，直接将调用转发给聚合的FComponent实例：

TCustomImplementator<T: TComponent> = class(TComponentAggregator<T>, IImplementsInterface)
private
  function GetImplementator: IImplementsInterface;
protected
  { 显式实现IImplementsInterface }
  function GetResultAV: Integer;
  procedure TestOk;
end;

{ TCustomImplementator<T> }

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

function TCustomImplementator<T>.GetResultAV: Integer;
var
  LImpl: IImplementsInterface;
begin
  LImpl := GetImplementator;
  Result := LImpl.GetResultAV;
end;

procedure TCustomImplementator<T>.TestOk;
var
  LImpl: IImplementsInterface;
begin
  LImpl := GetImplementator;
  LImpl.TestOk;
end;

方法2：缓存聚合的接口实例

将GetImplementator返回的接口实例缓存到类成员变量中，避免每次调用属性时动态获取，让implements直接使用缓存实例：

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

{ TCustomImplementator<T> }

function TCustomImplementator<T>.GetImplementator: IImplementsInterface;
begin
  if not Assigned(FImplementator) then
    Supports(FComponent, IImplementsInterface, FImplementator);
  Result := FImplementator;
end;

验证 #

修改后，Win64平台调用GetResultAV方法将不再触发访问违例，两种方法均能保证Win32和Win64平台的兼容性。

内容的提问来源于stack exchange，提问作者sstvit