La directiva implementa no funciona en la versión de 64 bits.
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
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 LImplementsInterface
variable 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 IImplementsInterface
en 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
/ _Release
y las estás delegando a una TComponent
instancia - eso significa que estás filtrando la TComponentAggregator
instancia que envuelve tu TComponent
.