umyinterface.pas

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

unit uMyInterface;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, PMyInterface_TLB, StdVcl;

type
  TMyInterface = class(TTypedComObject, IMyInterface)
  protected
    function GetInterfaceAge(out iAge: Integer): HResult; stdcall;
    function GetName(out sName: WideString): HResult; stdcall;
    function GetInterfaceCount(var iCount: Integer): HResult; stdcall;
    function GetAllInterfaces(var vVariant: OleVariant): HResult; stdcall;
    {Declare IMyInterface methods here}
  end;

implementation

uses ComServ, Variants;

function TMyInterface.GetInterfaceAge(out iAge: Integer): HResult;
begin
  iAge := 1000;
  Result := S_OK;
end;

function TMyInterface.GetName(out sName: WideString): HResult;
begin
  sName := 'IMyInterface';
  Result := S_OK;
end;

function TMyInterface.GetInterfaceCount(var iCount: Integer): HResult;
var
  aTbl : PInterfaceTable;
begin
  aTbl := Self.GetInterfaceTable;
  if (aTbl <> nil) then
  begin
    iCount := aTbl.EntryCount;
  end
  else
    iCount := 0;
  Result := S_OK;
end;

function TMyInterface.GetAllInterfaces(var vVariant: OleVariant): HResult;
var
  aTbl : PInterfaceTable;
  idx : Integer;
  anEntry : TInterfaceEntry;
begin
  aTbl := Self.GetInterfaceTable;
  vVariant := VarArrayCreate([0, aTbl.EntryCount - 1], varVariant);
  for idx := 0 to aTbl.EntryCount - 1 do    // Iterate
  begin
    anEntry := aTbl.Entries[idx];
    vVariant[idx] :=  GUIDToString(anEntry.IID);
  end;    // for
  Result := S_OK;
end;

initialization
  TTypedComObjectFactory.Create(ComServer, TMyInterface, Class_MyInterface,
    ciMultiInstance, tmApartment);
end.