MODULE ComAggregate;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
references = "adapted from Reuse sample in "Inside OLE", 2nd ed."
changes = ""
issues = ""
**)
IMPORT COM, WinApi, StdLog;
TYPE
IAnimal = POINTER TO
ABSTRACT RECORD ["{00021143-0000-0000-C000-000000000046}"] (COM.IUnknown) END;
CAnimal = POINTER TO RECORD (COM.IUnknown)
impl: CImpIAnimal
END;
CImpIAnimal = POINTER TO RECORD (IAnimal)
obj: CAnimal
END;
IKoala = POINTER TO
ABSTRACT RECORD ["{00021144-0000-0000-C000-000000000046}"] (COM.IUnknown) END;
CKoala = POINTER TO RECORD (COM.IUnknown)
impl: CImpIKoala;
animal: COM.IUnknown
END;
CImpIKoala = POINTER TO RECORD (IKoala)
obj: CKoala
END;
VAR
koala: COM.IUnknown;
(* ---------- IAnimal ---------- *)
PROCEDURE (this: IAnimal) Eat (): COM.RESULT, NEW, ABSTRACT;
PROCEDURE (this: IAnimal) Sleep (): COM.RESULT, NEW, ABSTRACT;
PROCEDURE (this: IAnimal) Procreate (): COM.RESULT, NEW, ABSTRACT;
(* ---------- CAnimal ---------- *)
PROCEDURE (this: CAnimal) QueryInterface (IN [iid] iid: COM.GUID;
OUT [new] int: COM.IUnknown): COM.RESULT;
BEGIN
IF COM.QUERY(this, iid, int) OR COM.QUERY(this.impl, iid, int) THEN RETURN WinApi.S_OK
ELSE RETURN WinApi.E_NOINTERFACE
END
END QueryInterface;
(* ---------- CImpIAnimal ---------- *)
PROCEDURE (this: CImpIAnimal) Eat (): COM.RESULT;
BEGIN
StdLog.String("Animal's IAnimal.Eat called"); StdLog.Ln;
RETURN WinApi.S_OK
END Eat;
PROCEDURE (this: CImpIAnimal) Sleep (): COM.RESULT;
BEGIN
StdLog.String("Animal's IAnimal.Sleep called"); StdLog.Ln;
RETURN WinApi.S_OK
END Sleep;
PROCEDURE (this: CImpIAnimal) Procreate (): COM.RESULT;
BEGIN
StdLog.String("Animal's IAnimal.Procreate called"); StdLog.Ln;
RETURN WinApi.S_OK
END Procreate;
(* ---------- Animal creation ---------- *)
PROCEDURE CreateAnimal (outer: COM.IUnknown; IN [iid] iid: COM.GUID;
OUT [new] int: COM.IUnknown): COM.RESULT;
VAR new: CAnimal;
BEGIN
IF (outer # NIL) & (iid # COM.ID(COM.IUnknown)) THEN RETURN WinApi.CLASS_E_NOAGGREGATION END;
NEW(new);
IF new # NIL THEN
IF outer = NIL THEN NEW(new.impl, new)
ELSE NEW(new.impl, outer)
END;
IF new.impl # NIL THEN
new.impl.obj := new;
StdLog.String("Animal allocated"); StdLog.Ln;
RETURN new.QueryInterface(iid, int)
END
END;
RETURN WinApi.E_OUTOFMEMORY
END CreateAnimal;
(* ---------- IKoala ---------- *)
PROCEDURE (this: IKoala) ClimbEucalyptusTrees (): COM.RESULT, NEW, ABSTRACT;
PROCEDURE (this: IKoala) PouchOpensDown (): COM.RESULT, NEW, ABSTRACT;
PROCEDURE (this: IKoala) SleepForHoursAfterEating (): COM.RESULT, NEW, ABSTRACT;
(* ---------- CKoala ---------- *)
PROCEDURE (this: CKoala) QueryInterface (IN [iid] iid: COM.GUID;
OUT [new] int: COM.IUnknown): COM.RESULT;
BEGIN
IF COM.QUERY(this, iid, int) OR COM.QUERY(this.impl, iid, int) THEN RETURN WinApi.S_OK
ELSIF iid = COM.ID(IAnimal) THEN RETURN this.animal.QueryInterface(iid, int)
ELSE RETURN WinApi.E_NOINTERFACE
END
END QueryInterface;
(* ---------- CImpIKoala ---------- *)
PROCEDURE (this: CImpIKoala) ClimbEucalyptusTrees (): COM.RESULT;
BEGIN
StdLog.String("Koala's IKoala.ClimbEucalyptusTrees called"); StdLog.Ln;
RETURN WinApi.S_OK
END ClimbEucalyptusTrees;
PROCEDURE (this: CImpIKoala) PouchOpensDown (): COM.RESULT;
BEGIN
StdLog.String("Koala's IKoala.PouchOpensDown called"); StdLog.Ln;
RETURN WinApi.S_OK
END PouchOpensDown;
PROCEDURE (this: CImpIKoala) SleepForHoursAfterEating (): COM.RESULT;
BEGIN
StdLog.String("Koala's IKoala.SleepForHoursAfterEating called"); StdLog.Ln;
RETURN WinApi.S_OK
END SleepForHoursAfterEating;
(* ---------- Koala creation ---------- *)
PROCEDURE CreateKoalaAggregation (OUT unk: COM.IUnknown): BOOLEAN;
VAR obj: CKoala; res: COM.RESULT;
BEGIN
NEW(obj);
IF obj # NIL THEN
NEW(obj.impl, obj);
IF obj.impl # NIL THEN
obj.impl.obj := obj;
res := CreateAnimal(obj, COM.ID(obj.animal), obj.animal);
IF res >= 0 THEN
StdLog.String("Koala allocated"); StdLog.Ln;
RETURN obj.QueryInterface(COM.ID(unk), unk) >= 0
END
END
END;
RETURN FALSE
END CreateKoalaAggregation;
(* ---------- user interface ---------- *)
PROCEDURE CreateKoala*;
BEGIN
IF CreateKoalaAggregation(koala) THEN StdLog.String("Koala created")
ELSE StdLog.String("Koala creation failed")
END;
StdLog.Ln
END CreateKoala;
PROCEDURE ReleaseKoala*;
BEGIN
IF koala # NIL THEN
koala := NIL;
StdLog.String("Koala released")
ELSE StdLog.String("no object")
END;
StdLog.Ln
END ReleaseKoala;
PROCEDURE AnimalEat*;
VAR a: IAnimal; res: COM.RESULT;
BEGIN
IF koala # NIL THEN
res := koala.QueryInterface(COM.ID(a), a);
IF res >= 0 THEN
res := a.Eat();
StdLog.String("IAnimal.Eat called")
ELSE StdLog.String("no IAnimal interface")
END
ELSE StdLog.String("no object")
END;
StdLog.Ln
END AnimalEat;
PROCEDURE AnimalSleep*;
VAR a: IAnimal; res: COM.RESULT;
BEGIN
IF koala # NIL THEN
res := koala.QueryInterface(COM.ID(a), a);
IF res >= 0 THEN
res := a.Sleep();
StdLog.String("IAnimal.Sleep called")
ELSE StdLog.String("no IAnimal interface")
END
ELSE StdLog.String("no object")
END;
StdLog.Ln
END AnimalSleep;
PROCEDURE AnimalProcreate*;
VAR a: IAnimal; res: COM.RESULT;
BEGIN
IF koala # NIL THEN
res := koala.QueryInterface(COM.ID(a), a);
IF res >= 0 THEN
res := a.Procreate();
StdLog.String("IAnimal.Procreate called")
ELSE StdLog.String("no IAnimal interface")
END
ELSE StdLog.String("no object")
END;
StdLog.Ln
END AnimalProcreate;
PROCEDURE KoalaClimbEucalyptusTrees*;
VAR a: IKoala; res: COM.RESULT;
BEGIN
IF koala # NIL THEN
res := koala.QueryInterface(COM.ID(a), a);
IF res >= 0 THEN
res := a.ClimbEucalyptusTrees();
StdLog.String("IKoala.ClimbEucalyptusTrees called")
ELSE StdLog.String("no IKoala interface")
END
ELSE StdLog.String("no object")
END;
StdLog.Ln
END KoalaClimbEucalyptusTrees;
PROCEDURE KoalaPouchOpensDown*;
VAR a: IKoala; res: COM.RESULT;
BEGIN
IF koala # NIL THEN
res := koala.QueryInterface(COM.ID(a), a);
IF res >= 0 THEN
res := a.PouchOpensDown();
StdLog.String("IKoala.PouchOpensDown called")
ELSE StdLog.String("no IKoala interface")
END
ELSE StdLog.String("no object")
END;
StdLog.Ln
END KoalaPouchOpensDown;
PROCEDURE KoalaSleepForHoursAfterEating*;
VAR a: IKoala; res: COM.RESULT;
BEGIN
IF koala # NIL THEN
res := koala.QueryInterface(COM.ID(a), a);
IF res >= 0 THEN
res := a.SleepForHoursAfterEating();
StdLog.String("IKoala.SleepForHoursAfterEating called")
ELSE StdLog.String("no IKoala interface")
END
ELSE StdLog.String("no object")
END;
StdLog.Ln
END KoalaSleepForHoursAfterEating;
END ComAggregate.
ComAggregate.CreateKoala
ComAggregate.ReleaseKoala
ComAggregate.AnimalEat
ComAggregate.AnimalSleep
ComAggregate.AnimalProcreate
ComAggregate.KoalaClimbEucalyptusTrees
ComAggregate.KoalaPouchOpensDown
ComAggregate.KoalaSleepForHoursAfterEating