Просто пишется набор связанных типов - по одному на каждый интерфейс. Объекты этих типов ссылаются друг на друга и работают в связке. Пример - модуль ComObject, реализующий COM-объект для нескольких интерфейсов:
Код:
TYPE
IClassFactory = POINTER TO RECORD (WinOle.IClassFactory) END;
Object = POINTER TO RECORD (COM.IUnknown)
ioo: IOleObject;
ido: IDataObject;
ips: IPersistStorage;
ics: WinOle.IOleClientSite;
idah: WinOle.IDataAdviseHolder;
ioah: WinOle.IOleAdviseHolder;
isg: WinOle.IStorage;
ism: WinOle.IStream;
w, h: INTEGER
END;
IOleObject = POINTER TO RECORD (WinOle.IOleObject)
obj: Object
END;
IDataObject = POINTER TO RECORD (WinOle.IDataObject)
obj: Object
END;
IPersistStorage = POINTER TO RECORD (WinOle.IPersistStorage)
obj: Object
END;
Смотрите - Object ссылается на объекты - реализации дополнительных интерфейсов, а они в свою очередь имеют обратную ссылку на свой Object. (Ничего "некрасивого" в этом нет, т.к. инкапсуляция в Паскалях на уровне модуля, а не класса, и набор взаимодействующих типов ничем не хуже одного единственного).
Фабрика класса создает связку объектов - главный Object и вспомогательные:
Код:
PROCEDURE (this: IClassFactory) CreateInstance (outer: COM.IUnknown; IN iid: COM.GUID;
OUT int: COM.IUnknown): COM.RESULT;
VAR res: COM.RESULT; new: Object;
BEGIN
IF outer = NIL THEN
NEW(new);
IF new # NIL THEN
NEW(new.ioo, new); NEW(new.ido, new); NEW(new.ips, new);
IF (new.ioo # NIL) & (new.ido # NIL) & (new.ips # NIL) THEN
new.ioo.obj := new;
new.ido.obj := new;
new.ips.obj := new;
res := new.QueryInterface(iid, int)
ELSE res := WinApi.E_OUTOFMEMORY
END
ELSE res := WinApi.E_OUTOFMEMORY
END
ELSE res := WinApi.CLASS_E_NOAGGREGATION
END;
RETURN res
END CreateInstance;
А QueryInterface главного объекта отдает при запросах дополнительных интерфейсов указатели на вспомогательные объекты:
Код:
PROCEDURE (this: Object) QueryInterface (IN iid: COM.GUID; OUT int: COM.IUnknown): COM.RESULT;
BEGIN
IF COM.QUERY(this, iid, int)
OR COM.QUERY(this.ioo, iid, int)
OR COM.QUERY(this.ido, iid, int)
OR COM.QUERY(this.ips, iid, int) THEN RETURN WinApi.S_OK
ELSE RETURN WinApi.E_NOINTERFACE
END
END QueryInterface;
Там среди примеров в подсистеме COM много чего есть...