OpenEuphoria

Re: EuCOM 2.08 + WinXP Pro SP3

• Posted by mattlewis (admin) Feb 19, 2010
• 1790 views

OK, this code is completely untested, but I think it does what you need.

 
include std/dll.e 
include eucom.ew 
include w32support.e 
 
 
constant 
	CoGetClassObject = define_c_func( ole32, "CoGetClassObject",  
		{C_POINTER, C_INT, C_POINTER, C_POINTER, C_POINTER }) 
		 
 
global constant 
  CLSCTX_INPROC_SERVER            = #1, 
  CLSCTX_INPROC_HANDLER           = #2, 
  CLSCTX_LOCAL_SERVER             = #4, 
  CLSCTX_INPROC_SERVER16          = #8, 
  CLSCTX_REMOTE_SERVER            = #10, 
  CLSCTX_INPROC_HANDLER16         = #20, 
  CLSCTX_RESERVED1                = #40, 
  CLSCTX_RESERVED2                = #80, 
  CLSCTX_RESERVED3                = #100, 
  CLSCTX_RESERVED4                = #200, 
  CLSCTX_NO_CODE_DOWNLOAD         = #400, 
  CLSCTX_RESERVED5                = #800, 
  CLSCTX_NO_CUSTOM_MARSHAL        = #1000, 
  CLSCTX_ENABLE_CODE_DOWNLOAD     = #2000, 
  CLSCTX_NO_FAILURE_LOG           = #4000, 
  CLSCTX_DISABLE_AAA              = #8000, 
  CLSCTX_ENABLE_AAA               = #10000, 
  CLSCTX_FROM_DEFAULT_CONTEXT     = #20000, 
  CLSCTX_ACTIVATE_32_BIT_SERVER   = #40000, 
  CLSCTX_ACTIVATE_64_BIT_SERVER   = #80000, 
  CLSCTX_ENABLE_CLOAKING          = #100000, 
  CLSCTX_PS_DLL                   = #80000000  
 
constant  
	IClassFactory_clsid  = "00000001-0000-0000-C000-000000000046", 
	IClassFactory_clsid_ix = add_clsid( IClassFactory ), 
	IClassFactory_CreateInstance = 3, 
	IClassFactory_LockServer = 4, 
	 
	IClassFactory2_clsid = "B196B28F-BAB4-101A-B69C-00AA00341D07", 
	IClassFactory2_clsid_ix = add_clsid( IClassFactory2_clsid ), 
	IClassFactory2_GetLicInfo = 5, 
	IClassFactory2_RequestLicKey = 6, 
	IClassFactory2_CreateInstanceLic = 7 
 
 
function get_class_object( integer clsid_ix, atom dwClsContext, atom pServerInfo, integer iid ) 
	atom mset, ppv, rclsid, riid, ok 
	atom pclass 
	 
	mset = w32new_memset() 
	ppv = w32acquire_mem( mset, 4 ) 
	rclsid = w32acquire_mem( mset, clsid_table[CLSID_BYTES][clsid_ix] ) 
	riid = w32acquire_mem( mset, iid_table[IID_BYTES][iid] ) 
	 
	ok = c_func( CoGetClassObject, { rclsid, dwClsContext, pServerInfo, riid, ppv }) 
	if ok then 
		err:print_com_error( sprintf( "CoGetclassOjbect Error: %x\n",ok)) 
		err:com_error( ok ) 
		pclass = 0 
	else 
		pclass = peek4u( ppv ) 
	end if 
	w32release_mem( mset ) 
	return pclass 
end function 
 
global function create_licensed_object( integer clsid_ix, atom dwClsContext, atom pServerInfo ) 
	atom cf2, bstr_p, bstr, ok, riid 
	integer id 
	 
	cf2 = get_class_object( clsid, dwClsContext, pServerInfo, IClassFactory2_clsid_ix ) 
	if not cf2 then 
		return 0 
	end if 
	 
	mset = w32new_memset() 
	bstr_p = w32acquire_mem( mset, 4 ) 
	ok = call_interface_ptr( cf2, peek4u( cf2),  IClassFactory2_RequestLicKey, { 0, bstr_p }) 
	 
	if ok then 
		err:com_error( ok ) 
		w32release_mem( mset ) 
		return 0 
	end if 
	 
	bstr = peek4u( bstr_p ) 
	riid = w32acquire_mem( 16 ) 
	poke( riid, IUnknown_bytes ) 
	ppv = w32acquire_mem( 4 ) 
	ok = call_interface_ptr( cf2, peek4u( cf2 ), IClassFactory2_CreateInstanceLic, 
		{0, 0, riid, bstr, ppv}) 
	 
	ppv = peek4u( ppv ) 
	free_bstr( bstr ) 
	w32release_mem( mset ) 
	 
	if ok then 
		id = 0 
		err:com_error( ok ) 
	else 
		id = ref_com_object( clsid_ix, ppv ) 
	end if 
	return id 
end function 
 

Matt