IClassFactory2 provides an interface for requesting a license key to embed in your code. If you are on a licensed machine, the IClassFactory2::RequestLicKey function will return a License key that can be embedded in your program. When you want to create the COM object in the future you use IClassFactory2::CreateInstanceLic with the License key returned during development time and the COM object can be created for use on machines the are note licensed for development.
If you try and create a COM object that requires a license key on a machine that does not have a global license using the IClassFactory::CreateInstance (or API funciton CoCreateInstance) it will return CLASS_E_NOTLICENSED.
To compile under ObjectAda remove the pragma Linker_Options and insure that your project includes the following directories in the project search path:
with win32.objbase; use win32.objbase;
with win32.oleauto; use win32.oleauto;
with win32.winerror;
with win32.winuser;
use type HRESULT;
use type win32.bool;
with interfaces.c; use interfaces.c;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with system;
procedure GetLicense is
pragma Linker_Options("-lole32");
pragma Linker_Options("-loleaut32");
-- IID for IClassFactory
-- {B196B28F-BAB4-101A-B69C-00AA00341D07}
IID_IClassFactory2 : aliased IID := (16#B196B28F#,16#BAB4#,16#101A#,
(Char'Val(16#B6#),Char'Val(16#9C#),
Char'Val(16#00#),Char'Val(16#AA#),
Char'Val(16#00#),Char'Val(16#34#),
Char'Val(16#1D#),Char'Val(16#07#)) );
-- Interface IClassFactory2
type IClassFactory2;
type Pointer_To_IClassFactory2 is access all IClassFactory2;
-- C++ style VTBL of methods in the IBeep Interface
type IClassFactory2Vtbl;
type Pointer_To_IClassFactory2Vtbl is access all IClassFactory2Vtbl;
-- Create method prototypes for IClassFactory2
-- Don't forger that first argument of C++ methods is C++'s this pointer
-- IUnkown
-- IClassFactory2 "interface inherits" from IUnkown and therefore requires those
-- methods also.
type af_IClassFactory2_QueryInterface is access function (
This : access IClassFactory2;
riid : REFIID;
ppvObject: access Win32.PVOID)
return HRESULT;
pragma Convention(Stdcall, af_IClassFactory2_QueryInterface);
type af_IClassFactory2_AddRef is access function (
This: access IClassFactory2)
return Win32.ULONG;
pragma Convention(Stdcall, af_IClassFactory2_AddRef);
type af_IClassFactory2_Release is access function (
This: access IClassFactory2)
return Win32.ULONG;
pragma Convention(Stdcall, af_IClassFactory2_Release);
-- IClassFactory
-- IClassFactory2 "interface inherits" from IClassFactory and therefore requires those
-- methods also.
type af_IClassFactory2_CreateInstance is access function (
This : access IClassFactory2;
pUnkOuter: access IUnknown;
riid : REFIID;
ppvObject: access Win32.PVOID)
return HRESULT;
pragma Convention(Stdcall, af_IClassFactory2_CreateInstance);
type af_IClassFactory2_LockServer is access function (
This : access IClassFactory2;
fLock: Win32.BOOL)
return HRESULT;
pragma Convention(Stdcall, af_IClassFactory2_LockServer);
-- IClassFactory2 methods and structures
type LICINFO is
record
cbLicInfo : Win32.LONG;
fRuntimeKeyAvail : Win32.BOOL;
fLicVerified : Win32.BOOL;
end record;
pragma Convention(C_Pass_By_Copy, LICINFO);
type LPLICINFO is access all LICINFO;
type af_IClassFactory2_GetLicInfo is access function (
This : access IClassFactory2;
pLicInfo : access LICINFO)
return HRESULT;
pragma Convention(Stdcall, af_IClassFactory2_GetLicInfo);
type af_IClassFactory2_RequestLicKey is access function (
This : access IClassFactory2;
dwReserved : Win32.DWORD;
pLicInfo : access BSTR)
return HRESULT;
pragma Convention(Stdcall, af_IClassFactory2_RequestLicKey);
type af_IClassFactory2_CreateInstanceLic is access function (
This : access IClassFactory2;
pUnkOuter : access IUnknown;
pUnkReserved : access IUnknown;
riid : REFIID;
bstrKey : access BSTR;
ppv : access Win32.PVOID)
return HRESULT;
pragma Convention(Stdcall, af_IClassFactory2_CreateInstanceLic);
-- IClassFactory2 just contains a pointer to its VTBL
type IClassFactory2 is
record
lpVtbl: Pointer_To_IClassFactory2Vtbl;
end record;
-- IClassFactory2Vtbl contains pointers to all the methods IClassFactory2 interfaces to.
type IClassFactory2Vtbl is
record
QueryInterface : af_IClassFactory2_QueryInterface;
AddRef : af_IClassFactory2_AddRef;
Release : af_IClassFactory2_Release;
CreateInstance : af_IClassFactory2_CreateInstance;
LockServer : af_IClassFactory2_LockServer;
GetLicInfo : af_IClassFactory2_GetLicInfo;
RequestLicKey : af_IClassFactory2_RequestLicKey;
CreateInstanceLic : af_IClassFactory2_CreateInstanceLic;
end record;
-- Normally Ada passes by reference non scalar types, so we need the
-- following:
pragma Convention(C_Pass_By_Copy, IClassFactory2);
pragma Convention(C_Pass_By_Copy, IClassFactory2Vtbl);
-- Conversion functions to make the compiler happy.
function To_LPCWSTR is
new Ada.Unchecked_Conversion (system.address, Win32.LPCWSTR);
function To_LPCOLESTR is
new Ada.Unchecked_Conversion (System.Address, LPCOLESTR);
function To_Pointer_To_IClassFactory2 is
new Ada.Unchecked_Conversion (Win32.PVOID, Pointer_To_IClassFactory2);
RetPointer : aliased Win32.PVOID;
hr : HRESULT;
ClassID : aliased CLSID;
ClassFactory2Interface : Pointer_To_IClassFactory2;
refcount : Win32.ULONG;
com_error : exception;
LicString : aliased BSTR;
ClassLicInfo : aliased LICINFO;
-- Name of OLE/ActiveX/COM/DCOM object to get IClassFactory2 from
programID : wchar_array := To_C("COMCTL.TreeCtrl");
begin
put_line("Initialize Com Libraries");
hr := CoInitialize(system.null_address);
if hr /= 0 then
raise com_error;
end if;
put_line("Looking Up Class ID");
hr := CLSIDFromProgID(To_LPCOLESTR(programID'Address), ClassID'Access);
if hr /= 0 then
raise com_error;
end if;
put_line("Use CoGetClassObject to get the IClassFactory2 object");
hr := CoGetClassObject(ClassID'unchecked_access,
Win32.DWORD(CLSCTX_ALL),
System.Null_Address,
IID_IClassFactory2'unchecked_access,
RetPointer'unchecked_access);
if hr /= 0 then
put_line("This class object does not support IClassFactory2");
raise com_error;
end if;
put_line("Convert return pointer to pointer to IClassFactory2");
ClassFactory2Interface := To_Pointer_To_IClassFactory2(RetPointer);
put_line("Request license information");
hr := ClassFactory2Interface.lpVtbl.GetLicInfo(ClassFactory2Interface,
ClassLicInfo'Unchecked_Access);
if hr /= 0 then
raise com_error;
end if;
if ClassLicInfo.fRuntimeKeyAvail = Win32.TRUE then
put_line("This class has a run time key available.");
put_line("Request a license key");
hr := ClassFactory2Interface.lpVtbl.RequestLicKey(ClassFactory2Interface,
0,
LicString'Unchecked_Access);
if hr /= 0 then
raise com_error;
end if;
declare
BoxTitle : WChar_Array := To_C("The returned Lic Key is:");
RetValue : Win32.Int;
begin
RetValue:=Win32.WinUser.MessageBoxW(System.Null_Address, To_LPCWSTR(LicString'Address), To_LPCWSTR(BoxTitle'Address), 0);
end;
SysFreeString(LicString);
end if;
put_Line("Release IClassFactory2 Interface");
refcount := ClassFactory2Interface.lpVtbl.Release(ClassFactory2Interface);
put_line("Uninit COM Libs");
CoUninitialize;
end GetLicense;