uintfclass.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

unit uIntfClass;

interface

uses SysUtils, uInterfaces, Windows;

type
  TIntfClass = class(TObject, IMyInterface1{, IMyInterface2, IMyInterface4})
  private
    FRefCount : Integer;
    //IMyInterface1
    function GetName(const sStr : String) : String; stdcall;
  public
    //IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; virtual; stdcall;
{
    //IMyInterface2
    function GetDate : String; stdcall;
    //IMyInterface4
    function GetGUID : String; stdcall;
}
  end;

  TDerivedIntfClass = class(TIntfClass, IMyInterface2)
  public
    //IMyInterface2
    function GetDate : String; stdcall;
    function _Release: Integer; override; stdcall;
  end;



  TIntf1Class = class(TInterfacedObject, IMyInterface4)
  public
    function GetGUID : String; stdcall;
  end;

  TDupInterface = class(TObject, IMyInterface1, IDupInterface1, IDupInterface2)
  private
    FRefCount : Integer;

    //IMyInterface1
    function IMyInterface1.GetName = GetName1;
    //IDupInterface1
    function IDupInterface1.GetName = GetName2;
    //IDupInterface2
    function IDupInterface2.GetName = GetName3;
  public
    //IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    function GetName1(const sStr : String) : String; stdcall;
    function GetName2 : String;
    function GetName3 : String;
  end;

  TGUIDClass = class(TObject, IGUIDIntf1, IGUIDIntf2, IGUIDIntf3)
  private
    FRefCount : Integer;

    //IGUIDIntf1
    function IGUIDIntf1.GetGUID = GetGUID1;
    //IGUIDIntf2
    function IGUIDIntf2.GetGUID = GetGUID2;
    //IGUIDIntf3
    function IGUIDIntf3.GetGUID = GetGUID3;
  public
    Destructor Destroy; override;
    //IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    function GetGUID1 : String; stdcall;
    function GetGUID2 : String; stdcall;
    function GetGUID3 : String; stdcall;
    function GetInterfaceCount : Integer;
  end;

  TIntfClass2 = class(TInterfacedObject, IGUIDIntf1)
  public
    //IMyInterface1
    function GetGUID : String; stdcall;
    Destructor Destroy; override;
  end;


implementation

uses fmMain;

{ TIntfClass }

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

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

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

function TIntfClass.GetName(const sStr: String): String;
begin
  Result := 'Hi ' + sStr + ' , I am IMyInterface1';
end;


//function TIntfClass.GetGUID: String;
//begin
//  Result := '{AA884AA1-274B-4F63-B946-19D6AA354D66}';
//end;

{
function TIntfClass.GetDate: String;
begin
  Result := DateTimeToStr(Now);
end;
}

function TIntf1Class.GetGUID: String;
begin
  Result := '{AA884AA1-274B-4F63-B946-19D6AA354D66}';
end;

{ TDerivedIntfClass }

function TDerivedIntfClass.GetDate: String;
begin
  Result := DateTimeToStr(Now);
end;

function TDerivedIntfClass._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
end;

{ TDupInterface }

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

function TDupInterface._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
end;

function TDupInterface.GetName1(const sStr: String): String;
begin
  Result := 'Hi ' + sStr + ' , I am IMyInterface1';
end;

function TDupInterface.GetName2: String;
begin
  Result := 'Hi I am IDupInterface1.GetName';
end;

function TDupInterface.GetName3: String;
begin
  Result := 'Hi I am IDupInterface2.GetName';
end;

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

{ TGUIDClass }

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

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

destructor TGUIDClass.Destroy;
begin
  Form1.AppMsg('TGUIDClass对象被释放于' + DateTimeToStr(now));
  inherited;
end;

function TGUIDClass.GetGUID1: String;
begin
  Result := GUIDTOString(Self.GetInterfaceTable.Entries[2].IID);
end;

function TGUIDClass.GetGUID2: String;
begin
  Result := GUIDTOString(Self.GetInterfaceTable.Entries[1].IID);
end;

function TGUIDClass.GetGUID3: String;
begin
  Result := GUIDTOString(Self.GetInterfaceTable.Entries[0].IID);
end;

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

function TGUIDClass.GetInterfaceCount: Integer;
var
  aPtr : Pointer;
begin
//  Result := Self.GetInterfaceTable.EntryCount;

  aPtr := PPointer(Integer((Pointer(Self))^) + vmtIntfTable)^;
  Result := Integer(aPtr^);
end;

{ TIntfClass2 }

destructor TIntfClass2.Destroy;
begin
  Form1.AppMsg('TIntfClass2对象被释放于' + DateTimeToStr(now));
  inherited;
end;

function TIntfClass2.GetGUID: String;
begin
  Result := GUIDTOString(Self.GetInterfaceTable.Entries[0].IID);
end;

end.