dksystem.pas

EXE+BPL+DLL+Interface項目解決方案演示 經典

unit dkSystem;

interface

uses
  SysUtils, windows, Classes;

const
  BoolToHResult: array[False..True] of HRESULT = (S_FALSE, S_OK);
  HResultToBool: array[S_OK..S_FALSE] of Boolean = (True, False);

type
  TArrayInteger = array of Integer;

type

  TdkObject = class(TObject)
  private
  protected
  end;

  TdkObjectA = class(TObject)
  protected
    FOwner: TComponent;
    procedure Init(); virtual;
  public
    constructor Create(AComponent: TComponent);
    destructor Destroy(); override;
  end;

  TdkVCLAapter = class(TdkObject)
  private
  protected
    FComponent: TComponent;
    procedure Init(); virtual;
  public
    constructor Create(AComponent: TComponent);
    destructor Destroy(); override;
  end;

  TdkInterfacedObject = class(TObject, IInterface)
  protected
    FObjectFree: Boolean; //对象是否用由对象自己来释放,而不采用接口引用计数器来释放
    FRefCount: Integer;
  public
    {IInterface Implment}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; virtual; stdcall;
    {IInterface Implment}

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

  TdkObjectFreeInterfacedObject = class(TdkInterfacedObject, IInterface)
  public
    class function NewInstance: TObject; override;
  end;

implementation

{ TdkInterfacedObject }

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

function TdkInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount); //
  if not FObjectFree then //如果由对象来释放，引用计数器到0时不调用Destroy
    if Result = 0 then
      Destroy;
end;

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

procedure TdkInterfacedObject.BeforeDestruction;
begin
  //加上时，如果接口对象没有释放干净时会引用出错
//  if RefCount <> 0 then //
//      System.Error(reInvalidPtr);
end;

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

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

{ TdkVCLAapter }

constructor TdkVCLAapter.Create(AComponent: TComponent);
begin
  FComponent := AComponent;
  Init();
end;

destructor TdkVCLAapter.Destroy;
begin

  inherited;
end;

procedure TdkVCLAapter.Init;
begin

end;

{ TdkObjectA }

constructor TdkObjectA.Create(AComponent: TComponent);
begin
  FOwner := AComponent;
  Init();
end;

destructor TdkObjectA.Destroy;
begin

  inherited;
end;

procedure TdkObjectA.Init;
begin

end;

{ TdkObjectFreeInterfacedObject }




{ TdkObjectFreeInterfacedObject }

class function TdkObjectFreeInterfacedObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TdkInterfacedObject(Result).FObjectFree := true;
end;

end.