面向对象: 接口与对象生存周期,接口自动释放

相关资料：

https://www.baidu.com/link?url=yYEHJesIUg6HguekaIW-U0HtjtLn430Dh0NXSc7ej5ixppqcq21rsYMvlCo_qNOP&wd=&eqid=87bf080a00000c50000000035e83f9e4

实例：

接口单元（UnInterface.pas）：

unit UnInterface;

interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ToolWin, Vcl.ActnMan;

type
  IFormInterface = interface(IInterface)
  ['{51869234-9F24-4409-A61D-C6A1A47E7E53}']
  procedure ShowForm stdcall;
  procedure HideForm stdcall;
  end;

  TFormInterface = class(TForm, IInterface, IFormInterface)
//  TFormInterface = class(TForm, IFormInterface)
  private
    { Private declarations }
    protected FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    function _AddRef: Integer stdcall;
    function _Release: Integer stdcall;
    procedure ShowForm stdcall;
    procedure HideForm stdcall;
  public
    constructor Create(AOwner: TComponent); override;

    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
  property RefCount: Integer read FRefCount;
  end;

implementation


procedure TFormInterface.AfterConstruction;
begin
  InterlockedDecrement(FRefCount);
end;

procedure TFormInterface.BeforeDestruction;
begin
  if RefCount <> 0 then
  raise EInvalidPointer.Create('Invalid ptr');
end;

constructor TFormInterface.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);
end;

function TFormInterface._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TFormInterface._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
  Destroy;
end;

class function TFormInterface.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TFormInterface(Result).FRefCount := 1;
end;

function TFormInterface.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
  Result := 0
  else
  Result := E_NOINTERFACE;
end;

procedure TFormInterface.HideForm;
begin
  Hide;
end;

procedure TFormInterface.ShowForm;
begin
  Show;
end;

end.

 

调用单元（Unit1.pas）：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ToolWin, Vcl.ActnMan,
  IdGlobal,
  UnShare,
  UnInterface;

type
  TForm1 = class(TForm)
    Button1: TButton;
  procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FIForm: IFormInterface;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  iForm: IFormInterface;
begin
//  运行程序,按下Button1,会看到一个窗体出现,2秒钟后它消失了，这就实现了自动释放的功能
//  iForm := TFormInterface.Create(nil) as IFormInterface;
//  iForm.ShowForm;
//  Sleep(2000);
//  在Form1中定义一个成员变量,是一个IFormInterface型的接口，则对象能保持到程序退出时,Form1被释放时自动释放
//  写成TFormInterface.Create(Self)的话会出现释放的问题
  iForm := TFormInterface.Create(nil) as IFormInterface;
  iForm.ShowForm;
  FIForm := iForm;
end;
end.

 之前遇到过的一段代码没有理解意思，留下来方便以后学习：

//功能: 直接解读对象内存结构，返回自身实现的对象
//参数：
//注意：对 x64 的修改，参考 https://forums.embarcadero.com/thread.jspa?threadID=62328
////////////////////////////////////////////////////////////////////////////////
function GetImplObject(const AIntf: IInterface): TObject;
{$IFDEF CPUX64}
begin
  try
    Result := AIntf as TObject;
  except
    Result := nil;
  end;
end;
{$ELSE}
const
  AddByte = $04244483; // opcode for ADD DWORD PTR [ESP+4], Shortint
  AddLong = $04244481; // opcode for ADD DWORD PTR [ESP+4], Longint
type
  PAdjustSelfThunk = ^TAdjustSelfThunk;
  TAdjustSelfThunk = packed record
    case AddInstruction: Longint of
      AddByte: (AdjustmentByte: ShortInt);
      AddLong: (AdjustmentLong: Longint);
  end;
  PInterfaceMT = ^TInterfaceMT;
  TInterfaceMT = packed record
    QueryInterfaceThunk: PAdjustSelfThunk;
  end;
  TInterfaceRef = ^PInterfaceMT;
var
  QueryInterfaceThunk: PAdjustSelfThunk;
begin
  try
    Result := Pointer(AIntf);
    if Assigned(Result) then
    begin
      QueryInterfaceThunk := TInterfaceRef(AIntf)^.QueryInterfaceThunk;
      case QueryInterfaceThunk.AddInstruction of
        AddByte:
          Inc(PAnsiChar(Result), QueryInterfaceThunk.AdjustmentByte);
        AddLong:
          Inc(PAnsiChar(Result), QueryInterfaceThunk.AdjustmentLong);
      else
        Result := nil;
      end;
    end;
  except
    Result := nil;
  end;
end;
{$ENDIF}