MODULE ComPhoneBookActiveX;
(**
	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, WinOleAut;
	
	CONST
		CLSID* = "{E67D346B-2A5B-11D0-ADBA-00C01500554E}";
		E_NotFound = -2147467259;
		typelibrary = "C:\BlackBox\Com\Interfaces\DPhoneBook\phone.tlb";
	
	TYPE
		ILookup* = POINTER TO ABSTRACT RECORD
			["{C4910D72-BA7D-11CD-94E8-08001701A8A3}"] (WinOleAut.IDispatch)
		END;
	
		CLookup = POINTER TO RECORD (ILookup) END;
		
		LookupFactory = POINTER TO RECORD (WinOle.IClassFactory) END;
	
		Entry = POINTER TO EntryDesc;
		EntryDesc = RECORD
			next: Entry;
			name, number: ARRAY 32 OF CHAR
		END;
	
	VAR
		locks: INTEGER;
		objects: 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 ---------- *)
		
	(* use default QueryInterface implementation *)
	(* AddRef & Release implemented implicitly by the compiler *)
	
	PROCEDURE (this: CLookup) LookupByName(name: WinApi.PtrWSTR;
			OUT number: WinApi.PtrWSTR): COM.RESULT;
		VAR e: Entry; ustr: ARRAY [untagged] 32 OF CHAR; i: INTEGER;
	BEGIN
		e := phoneBook;
		WHILE (e # NIL) & (e.name # name^) DO e := e.next END;
		IF e # NIL THEN i := 0;
			REPEAT ustr[i] := e.number[i]; INC(i) UNTIL e.number[i-1] = 0X;
			number := ComTools.NewString(ustr);
			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; 
			ustr: ARRAY [untagged] 32 OF CHAR; i: INTEGER;
	BEGIN 
		e := phoneBook;
		WHILE (e # NIL) & (e.number # number^) DO e := e.next END;
		IF e # NIL THEN i := 0;
			REPEAT ustr[i] := e.name[i]; INC(i) UNTIL e.name[i-1] = 0X;
			name := ComTools.NewString(ustr);
			RETURN WinApi.S_OK
		ELSE
			RETURN E_NotFound
		END
	END LookupByNumber;
	
	PROCEDURE (this: CLookup) Invoke (dispIdMember: WinOleAut.DISPID;
		IN riid: COM.GUID;
		lcid: WinOle.LCID; wFlags: SHORTINT; VAR [nil] pDispParams: WinOleAut.DISPPARAMS; 
		OUT [nil] pVarResult: WinOleAut.VARIANT; OUT [nil] pExcepInfo: WinOleAut.EXCEPINFO;
		OUT [nil] puArgErr: INTEGER
	): COM.RESULT;
		VAR wstr: WinApi.PtrWSTR; res: INTEGER; (* bstr: WinOle.BSTR; *)
	BEGIN
		IF (dispIdMember = 1) OR (dispIdMember = 2) THEN
			IF pDispParams.cArgs = 1 THEN
				IF pDispParams.rgvarg[0].vt = WinOle.VT_BSTR THEN
					IF dispIdMember = 1 THEN 
						res := this.LookupByName(pDispParams.rgvarg[0].u.bstrVal, wstr)
					ELSE
						res := this.LookupByNumber(pDispParams.rgvarg[0].u.bstrVal, wstr)
					END;
					IF res = 0 THEN
						pVarResult.vt := WinOle.VT_BSTR;
						pVarResult.u.bstrVal := WinOleAut.SysAllocString(wstr^);
						RETURN WinApi.S_OK
					ELSE
						pExcepInfo.wCode := 0;
						pExcepInfo.wReserved := 0;
						pExcepInfo.bstrSource := WinOleAut.SysAllocString("PhoneBook.Lookup");
						pExcepInfo.bstrDescription := WinOleAut.SysAllocString("Entry not found");
						pExcepInfo.bstrHelpFile := NIL;
						pExcepInfo.pfnDeferredFillIn := NIL;
						pExcepInfo.scode := res;
						RETURN WinApi.DISP_E_EXCEPTION
					END
				ELSE RETURN WinApi.DISP_E_BADVARTYPE
				END
			ELSE RETURN WinApi.DISP_E_BADPARAMCOUNT
			END;
		ELSE RETURN WinApi.DISP_E_MEMBERNOTFOUND
		END		
	END Invoke;

	PROCEDURE (this: CLookup) GetIDsOfNames (IN [nil] riid: COM.GUID (* NULL *);
		IN [nil] rgszNames: WinApi.PtrWSTR;  cNames: INTEGER; lcid: WinOle.LCID;
		OUT [nil] rgDispId: WinOleAut.DISPID
	): COM.RESULT;
		VAR lib: WinOleAut.ITypeLib; ptinfo: WinOleAut.ITypeInfo; names: WinApi.PtrWSTR;res: INTEGER;
	BEGIN
		res := WinOleAut.LoadTypeLib(ComTools.NewString(typelibrary), lib);
		res := lib.GetTypeInfoOfGuid(COM.ID(ILookup), ptinfo);
		names := ComTools.NewString(rgszNames^);
		res := WinOleAut.DispGetIDsOfNames(ptinfo, names, cNames, rgDispId);
		RETURN 0
	END GetIDsOfNames;
	
	PROCEDURE (this: CLookup) GetTypeInfo (iTInfo: INTEGER; lcid: WinOle.LCID; 
											OUT [nil] ppTInfo: WinOleAut.ITypeInfo): COM.RESULT;
		VAR lib: WinOleAut.ITypeLib; res: INTEGER;
	BEGIN
		res := WinOleAut.LoadTypeLib(ComTools.NewString(typelibrary), lib);
		RETURN lib.GetTypeInfo(iTInfo, ppTInfo)
	END GetTypeInfo;
	
	PROCEDURE (this: CLookup) GetTypeInfoCount (OUT [nil] pctinfo: INTEGER): COM.RESULT;
	BEGIN 
		pctinfo := 1;	(* type info available *)
		RETURN 0 
	END GetTypeInfoCount;

	PROCEDURE (this: CLookup) RELEASE;	(* called when last com reference is removed *)
	BEGIN
		DEC(objects)
	END RELEASE;
	
	(* ---------- LookupFactory ---------- *)
	
	(* use default QueryInterface implementation *)
	(* AddRef & Release implemented implicitly by the compiler *)
	
	PROCEDURE (this: LookupFactory) CreateInstance (outer: COM.IUnknown;
				IN [iid] iid: COM.GUID; OUT [new] int: COM.IUnknown): COM.RESULT;
		VAR res: COM.RESULT; new: CLookup;
	BEGIN
		IF outer # NIL THEN RETURN WinApi.CLASS_E_NOAGGREGATION END;
		NEW(new);
		IF new # NIL THEN 
			res := new.QueryInterface(iid, int);
			IF res >= 0 THEN INC(objects) END;
			RETURN res
		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;
	
	(* ---------- dll interface ---------- *)
	
	PROCEDURE DllGetClassObject* (IN clsid: COM.GUID;
												IN [iid] iid: COM.GUID; OUT [new] int: COM.IUnknown): COM.RESULT;
		VAR obj: LookupFactory;
	BEGIN
		IF clsid = CLSID THEN
			NEW(obj);
			IF obj # NIL THEN RETURN obj.QueryInterface(iid, int)
			ELSE RETURN WinApi.E_OUTOFMEMORY;
			END
		ELSE RETURN WinApi.E_FAIL
		END
	END DllGetClassObject;
	
	PROCEDURE DllCanUnloadNow* (): COM.RESULT;
	BEGIN
		IF (objects = 0) & (locks = 0) THEN RETURN WinApi.S_OK ELSE RETURN WinApi.S_FALSE END
	END DllCanUnloadNow;


	PROCEDURE NewEntry(name, number: ARRAY OF CHAR);
		VAR e: Entry;
	BEGIN
		NEW(e); e.next  := phoneBook; phoneBook := e; e.name := name$; e.number := number$
	END NewEntry;

BEGIN	
	locks := 0; objects := 0;
	NewEntry("Daffy Duck", "310-555-1212");
	NewEntry("Wile E. Coyote", "408-555-1212");
	NewEntry("Scrooge McDuck", "206-555-1212");
	NewEntry("Huey Lewis", "415-555-1212");
	NewEntry("Thomas Dewey", "617-555-1212");
END ComPhoneBookActiveX.

 DevLinker.LinkDll "Com/phone.dll" := Kernel+ ComTools ComPhoneBookActiveX# ~


REGEDIT
HKEY_CLASSES_ROOT\PhoneBook = PhoneBook ActiveX Control
HKEY_CLASSES_ROOT\PhoneBook\CLSID = {E67D346B-2A5B-11D0-ADBA-00C01500554E}
HKEY_CLASSES_ROOT\PhoneBook\TypeLib = {C4910D73-BA7D-11CD-94E8-08001701A8A3}

HKEY_CLASSES_ROOT\CLSID\{E67D346B-2A5B-11D0-ADBA-00C01500554E} = PhoneBook ActiveX Control
HKEY_CLASSES_ROOT\CLSID\{E67D346B-2A5B-11D0-ADBA-00C01500554E}\ProgID = PhoneBook1.0
HKEY_CLASSES_ROOT\CLSID\{E67D346B-2A5B-11D0-ADBA-00C01500554E}\Control
HKEY_CLASSES_ROOT\CLSID\{E67D346B-2A5B-11D0-ADBA-00C01500554E}\Version = 1.0
HKEY_CLASSES_ROOT\CLSID\{E67D346B-2A5B-11D0-ADBA-00C01500554E}\VersionIndependentProgID = PhoneBook
HKEY_CLASSES_ROOT\CLSID\{E67D346B-2A5B-11D0-ADBA-00C01500554E}\TypeLib = {C4910D73-BA7D-11CD-94E8-08001701A8A3}
HKEY_CLASSES_ROOT\CLSID\{E67D346B-2A5B-11D0-ADBA-00C01500554E}\InprocServer32 = C:\BlackBox\Com\phone.dll
HKEY_CLASSES_ROOT\CLSID\{E67D346B-2A5B-11D0-ADBA-00C01500554E}\NotInsertable

HKEY_CLASSES_ROOT\TypeLib\{C4910D73-BA7D-11CD-94E8-08001701A8A3}\1.0 = PhoneBook ActiveX Control
HKEY_CLASSES_ROOT\TypeLib\{C4910D73-BA7D-11CD-94E8-08001701A8A3}\1.0\0\win32 = C:\BlackBox\Com\Interfaces\DPhoneBook\phone.tlb
HKEY_CLASSES_ROOT\TypeLib\{C4910D73-BA7D-11CD-94E8-08001701A8A3}\1.0\FLAGS = 0
HKEY_CLASSES_ROOT\TypeLib\{C4910D73-BA7D-11CD-94E8-08001701A8A3}\1.0\HELPDIR = C:\BlackBox\Com\Interfaces\DPhoneBook