MODULE ComPhoneBook;
(**

   project   = "BlackBox"
   organization   = "www.oberon.ch"
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""

**)

   IMPORT COM, WinApi, WinOle, ComTools;

   
   CONST
      CLSID* = "{E67D346C-2A5B-11D0-ADBA-00C01500554E}";
      E_NotFound* = 80004005H;
   
   TYPE
      ILookup* = POINTER TO ABSTRACT RECORD
            ["{C4910D71-BA7D-11CD-94E8-08001701A8A3}"] (COM.IUnknown) END;
      CLookup = POINTER TO RECORD (ILookup)

         phoneBook: Entry
      END;
      
      LookupFactory = POINTER TO RECORD (WinOle.IClassFactory) END;
   
      Entry = POINTER TO RECORD
         next: Entry;
         name, number: ARRAY 32 OF CHAR
      END;
   
   VAR
      locks: INTEGER;
      token: INTEGER;
      phoneBook: Entry;
   
   (* ---------- ILookup ---------- *)
   PROCEDURE (this: ILookup) LookupByName*(

      name: WinApi.PtrWSTR; OUT number: WinApi.PtrWSTR): COM.RESULT, NEW, ABSTRACT;
   
   PROCEDURE (this: ILookup) LookupByNumber*(
      number: WinApi.PtrWSTR; OUT name: WinApi.PtrWSTR): COM.RESULT, NEW, ABSTRACT;
   (* ---------- CLookup ---------- *)

   
   PROCEDURE (this: CLookup) LookupByName(name: WinApi.PtrWSTR;
         OUT number: WinApi.PtrWSTR): COM.RESULT;
      VAR e: Entry;
   BEGIN e := this.phoneBook;
      WHILE (e # NIL) & (e.name # name^) DO e := e.next END;
      IF e # NIL THEN number := ComTools.NewString(e.number); RETURN WinApi.S_OK
      ELSE RETURN E_NotFound
      END
   END LookupByName;
   
   PROCEDURE (this: CLookup) LookupByNumber(number: WinApi.PtrWSTR;
            OUT name: WinApi.PtrWSTR): COM.RESULT;
      VAR e: Entry;
   BEGIN e := this.phoneBook;
      WHILE (e # NIL) & (e.number # number^) DO e := e.next END;
      IF e # NIL THEN name := ComTools.NewString(e.name); RETURN WinApi.S_OK
      ELSE RETURN E_NotFound
      END
   END LookupByNumber;
   
   (* ---------- LookupFactory ---------- *)
   
   PROCEDURE (this: LookupFactory) CreateInstance (outer: COM.IUnknown;
            IN [iid] iid: COM.GUID; OUT [new] int: COM.IUnknown): COM.RESULT;
      VAR new: CLookup;
   BEGIN
      IF outer # NIL THEN RETURN WinApi.CLASS_E_NOAGGREGATION END;
      NEW(new);
      IF new # NIL THEN new.phoneBook := phoneBook;RETURN new.QueryInterface(iid, int)
      ELSE RETURN WinApi.E_OUTOFMEMORY
      END
   END CreateInstance;
   
   PROCEDURE (this: LookupFactory) LockServer (lock: WinApi.BOOL): COM.RESULT;
   BEGIN
      IF lock # 0 THEN INC(locks) ELSE DEC(locks) END;
      RETURN WinApi.S_OK
   END LockServer;
   
   (* ---------- registration ---------- *)
   
   PROCEDURE Register*;
      VAR res: COM.RESULT; factory: LookupFactory;
   BEGIN
      NEW(factory);
      res := WinOle.CoRegisterClassObject(CLSID, factory,
               WinOle.CLSCTX_LOCAL_SERVER, WinOle.REGCLS_MULTIPLEUSE, token)
   END Register;
   
   PROCEDURE Unregister*;
      VAR res: COM.RESULT;
   BEGIN
      IF (locks = 0) & (token # 0) THEN res := WinOle.CoRevokeClassObject(token); token := 0 END
   END Unregister;
   
   PROCEDURE NewEntry(name, number: ARRAY 32 OF CHAR);
      VAR e: Entry;
   BEGIN
      NEW(e); e.next:= phoneBook; phoneBook := e; e.name := name$; e.number := number$
   END NewEntry;
   
BEGIN
   locks := 0;
   NewEntry("Daffy Duck", "310-555-1212");
   NewEntry("Wile E. Coyote", "408-555-1212");
   NewEntry("Scrogge McDuck", "206-555-1212");
   NewEntry("Huey Lewis", "415-555-1212");
   NewEntry("Thomas Dewey", "617-555-1212")
END ComPhoneBook.