What's the best performing database for Windows NT? To find out and get a free evaluation copy...click here.

PC Magazine

  PC Tech

COM Objects in Delphi, Part 1

Introduction

COM object essentials

Satellites and Containers

Satellite objects

Container objects

The Class Factory

GUIDs, CLSIDs, and IIDs

Figure 1

 
  Categories:
Programming
COM Objects in Delphi, Part 1
Figure 1

Continued from GUIDs, CLSIDs, and IIDs

    FIGURE 1: These generic COM interface objects aid in creating Delphi-based
    COM objects that support multiple interfaces.

    unit DelphCom;
    // "generic" objects for creating COM objects in Delphi.
    // ISatelliteUnknown is an interface object that's meant
    // to be contained by IContainerUnknown. Each actual COM
    // object that needs to support more than one interface
    // will descend from IContainerUnknown, and will implement
    // QueryInterface.
    interface
    USES Windows, Ole2, Classes, SysUtils, ShellApi, ShlObj;
    VAR DllRefCount : Integer;
    type
    IContainerUnknown = class;
    ISatelliteUnknown = class(IUnknown)
    // Meant to be contained by an IContainerUnknown
    // Reflects the three IUnknown functions to its // container.
    protected
    fContainer : IContainerUnknown;
    public
    constructor Create(vContainer: IContainerUnknown);
    function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
    function AddRef: Longint; override;
    function Release: Longint; override;
    end;
    IContainerUnknown = class(IUnknown)
    protected
    FRefCount     : Integer;
    public
    Constructor Create;
    destructor Destroy; override;
    {IUnknown functions}
    function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
    function AddRef: LongInt; override;
    function Release: LongInt; override;
    end;
    IMyClassFactory = Class(IClassFactory)
    private
    FRefCount : Integer;
    public
    constructor Create;
    destructor Destroy; override;
    function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
    function AddRef: LongInt; override;
    function Release: LongInt; override;
    // descendant MUST implement CreateInstance
    function LockServer(fLock: BOOL): HResult; override;
    end;
    function DLLCanUnloadNow : HResult; StdCall; Export;
    implementation
    (****** ISatelliteUnknown ******)
    constructor ISatelliteUnknown.Create(vContainer: IContainerUnknown);
    begin
    fContainer := vContainer;
    end;
    function ISatelliteUnknown.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;
    begin
    Result := fContainer.QueryInterface(WantIid, ReturnedObject);
    end;
    function ISatelliteUnknown.AddRef: LongInt;
    begin
    Result := fContainer.AddRef;
    end;
    function ISatelliteUnknown.Release: LongInt;
    begin
    Result := fContainer.Release;
    end;
    (****** IContainerUnknown ******)
    constructor IContainerUnknown.Create;
    begin
    Inherited Create;
    FRefCount := 0;
    Inc(DllRefCount);
    end;
    destructor IContainerUnknown.Destroy;
    begin
    Dec(DllRefCount);
    Inherited Destroy;
    end;
    function IContainerUnknown.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;
    VAR P : IUnknown;
    begin
    IF IsEqualIID(WantIID, IID_IUnknown) THEN
    P := Self
    ELSE P := nil;
    Pointer(ReturnedObject) := P;
    IF P = NIL THEN Result := E_NOINTERFACE
    ELSE
    begin
    P.AddRef;
    Result := S_OK;
    end;
    end;
    function IContainerUnknown.AddRef: LongInt;
    begin
    Inc(FRefCount);
    Result := FRefCount;
    end;
    function IContainerUnknown.Release: LongInt;
    begin
    Dec(FRefCount);
    Result := FRefCount;
    IF FRefCount = 0 THEN Free;
    end;
    (****** IMyClassFactory ******)
    constructor IMyClassFactory.Create;
    begin
    Inherited Create;
    Inc(DllRefCount);
    FRefCount := 0;
    end;
    destructor IMyClassFactory.Destroy;
    begin
    Dec(DllRefCount);
    Inherited Destroy;
    end;
    function IMyClassFactory.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;
    begin
    IF IsEqualIID(WantIid, IID_IUnknown) OR
    IsEqualIID(WantIid, IID_IClassFactory) THEN
    begin
    Pointer(ReturnedObject) := Self;
    AddRef;
    Result := S_OK;
    end
    ELSE
    begin
    Pointer(ReturnedObject) := NIL;
    Result := E_NOINTERFACE;
    end;
    end;
    function IMyClassFactory.AddRef: LongInt;
    begin
    Inc(FRefCount);
    Result := FRefCount;
    end;
    function IMyClassFactory.Release: LongInt;
    begin
    Dec(FRefCount);
    Result := FRefCount;
    IF FRefCount = 0 THEN Free;
    end;
    function IMyClassFactory.LockServer(fLock: Bool): HResult;
    begin
    Result := E_NOTIMPL;
    end;
    (****** exported function ******)
    function DLLCanUnloadNow: hResult; StdCall; Export;
    begin
    IF DllRefCount=0 THEN Result := S_OK
    ELSE                  Result := S_FALSE;
    end;
    initialization
    DllRefCount := 0;
    end.
 

Published as Power Programming in the 01/07/97 issue of PC Magazine.


 SPONSORED LINKS
Finance   Save now, save later - 9.99% Visa card - NOT an intro rate.
Shopping   Buy a 56K modem for $19.95 after rebate from NetMarket!
Software   X10.com -- The SuperSite for Home Automation
 ZDNET FEATURED LINKS
Freeware   It's a software free for all - 100 FREE downloads!
Contests   Enter to win a FREE multimedia PC from ZDNet!
 MAGAZINE OFFERS
Free Trial   Try the next issue of Computer Gaming World FREE!

TOP
Copyright (c) 1997 Ziff-Davis Inc.