La directiva implementa no funciona en la versión de 64 bits.

Resuelto sstvit asked hace 7 meses • 0 respuestas

En Delphi, puedes delegar la implementación de una interfaz a una propiedad de clase. En el ejemplo, la clase TImplementator implementa el contrato IImplementsInterface, agregando la clase, su implementador real (TImplementsForm), y también monitorea su vida útil. El método ButtonTestClick muestra que esto funciona (durante mucho tiempo, con docenas de interfaces) en Win32. En Win64, llamar a procedimientos funciona, cuando llamamos a funciones obtenemos una excepción (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

Cómo lograr resultados en Win64

sstvit avatar Feb 16 '24 20:02 sstvit
Aceptado

Para ser precisos: el AV no ocurre en la línea que marcó sino después durante el epílogo del método cuando la LImplementsInterfacevariable está a punto de borrarse.

Revisar el código me hace creer que se trata de un problema del compilador, pero no estoy completamente seguro.

De todos modos: la implementación de IImplementsInterfaceen esta línea es superflua y conduce a este problema:

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

La interfaz ya se implementó en la TCustomImplementator<T>clase genérica y el código simplemente funcionará (*) cuando lo elimines de TImplementator.

(*) ya que no habrá un AV - todavía tienes una pérdida de memoria porque al usar la delegación de interfaz también estás delegando las llamadas _AddRef/ _Releasey las estás delegando a una TComponentinstancia - eso significa que estás filtrando la TComponentAggregatorinstancia que envuelve tu TComponent.

Stefan Glienke avatar Feb 16 '2024 15:02 Stefan Glienke