uobjclasses.pas

来自「多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术」· PAS 代码 · 共 119 行

unit uObjClasses;

interface

uses
  Messages, SysUtils, Variants, Classes, Graphics, Controls;

type
  ITest = interface
    ['{1EAD38E4-0632-4267-AD87-34FFFC686769}']
    function GetObjSize : Integer; stdcall;
    function GetInterfaceName : String; stdcall;
  end;


  TBase = class(TObject, ITest)
  private
    { Private declarations }
    iRef : Integer;
  public
    { Public declarations }
    function getStaticName : string;
    function getOID : string; virtual;
    function getName : string; virtual;
    function getRC : Integer;
    { IInterface }
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    //ITest
    function GetObjSize : Integer; stdcall;
    function GetInterfaceName : String; stdcall;
  end;

  TDerived1 = class(TBase, ITest)
  public
    function getStaticName : string;
    function getOID : string; override;
    function getName : string; override;
    //ITest
    function GetObjSize : Integer; stdcall;
  end;

implementation

{ TBase }

function TBase.getStaticName: string;
begin
  Result := Self.ClassName;
end;

function TBase.getName: string;
begin
  Result := 'Base Class';
end;

function TBase.getOID: string;
begin
  Result := 'Base-OID';
end;

function TBase.GetObjSize: Integer;
begin
  Result := TBase.InstanceSize;
end;

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

function TBase._AddRef: Integer;
begin
  Inc(iRef);
  Result := iRef;
end;

function TBase._Release: Integer;
begin
  Dec(iRef);
  Result := iRef;
end;

function TBase.getRC: Integer;
begin
  Result := iRef;
end;

function TBase.GetInterfaceName: String;
begin
  Result := 'ITest';
end;

{ TDerived1 }

function TDerived1.getName: string;
begin
  Result := 'Derived1 Class';
end;

function TDerived1.GetObjSize: Integer;
begin
  Result := TDerived1.InstanceSize;
end;

function TDerived1.getOID: string;
begin
  Result := 'Derived1-OID';
end;

function TDerived1.getStaticName: string;
begin
  Result := Self.ClassName;
end;

end.