MODULE ComPhoneBook;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	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.


