|
|
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.
|