MODULE ComPhoneBookActiveX;
(**
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, 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