Help Needed for COM Automation

swhite · Post by **swhite** » Wed Feb 16, 2011 5:49 pm

Hi

I am attempting to access a VFP multi-threaded dll from PB and I have the following code so far. I am wondering why the CoCreateInstance_ fails. The error it reports is :

A specified class is Not registered in the registration database. Also can indicate that the type of server you requested in the CLSCTX Enumeration is Not registered Or the values For the server types in the registry are corrupt.

However I have registered the dll and it reported "succeeded". I am not sure that I have correctly setup the CoCreateInstance. The MSDN documenation says:

HRESULT CoCreateInstance(
__in REFCLSID rclsid,
__in LPUNKNOWN pUnkOuter,
__in DWORD dwClsContext,
__in REFIID riid,
__out LPVOID *ppv
);

Parameters

rclsid [in]
The CLSID associated with the data and code that will be used to create the object.

pUnkOuter [in]
If NULL, indicates that the object is not being created as part of an aggregate. If non-NULL, pointer to the aggregate object's IUnknown interface (the controlling IUnknown).

dwClsContext [in]
Context in which the code that manages the newly created object will run. The values are taken from the enumeration CLSCTX.

riid [in]
A reference to the identifier of the interface to be used to communicate with the object.

ppv [out]
Address of pointer variable that receives the interface pointer requested in riid. Upon successful return, *ppv contains the requested interface pointer. Upon failure, *ppv contains NULL.

So I any one has any suggestions about what is wrong I would appreciate it.

Code: Select all

Interface Idckardauth
   QueryInterface()
	Addref()
	Release()
	GetTypeInfoCount()
	GetTypeInfo()
	GetIDsOfNames()
	Invoke()
	PrepareResponse.s(tcRcvd.s)
EndInterface	

Define loVFP.idckardauth,lcRcvd.s

lcRcvd = "DONEY CRES  PVSystem211001.2@KT782448300000013004T01011.000201DATE02162011TIME0952060011$"

CoInitializeEx_(0,#COINIT_MULTITHREADED)

hr = CoCreateInstance_("{8DC6BA5D-6861-4F0A-A080-7DEDCC97C10F}", NULL, 0,"{4C791FAF-8649-462D-A93A-185F95C2DC0E}",@loVFP.Idckardauth)

Select hr
Case #S_OK
 Debug "Success"

Case #REGDB_E_CLASSNOTREG
Debug "A specified class is Not registered in the registration database. Also can indicate that the type of server you requested in the CLSCTX Enumeration is Not registered Or the values For the server types in the registry are corrupt."

Case #CLASS_E_NOAGGREGATION
Debug "This class cannot be created As part of an aggregate."

Case #E_NOINTERFACE
Debug "The specified class does Not implement the requested Interface, Or the controlling IUnknown does Not expose the requested Interface."

Case #E_POINTER
   Debug "The ppv parameter is NULL."
Default
   Debug hr
EndSelect

lcTxt.s = loVFP\PrepareResponse(lcRcvd)
loVFP\Release()
loVFP = 0
CoUninitialize_()

spikey · Post by **spikey** » Tue Feb 22, 2011 6:01 pm

I'm not an expert on this subject but at first sight I think you have a couple of problems with the following line:

Code: Select all

hr = CoCreateInstance_("{8DC6BA5D-6861-4F0A-A080-7DEDCC97C10F}", NULL, 0,"{4C791FAF-8649-462D-A93A-185F95C2DC0E}", @loVFP.Idckardauth)

Do a forum search with CoCreateInstance as the search term. The only examples I've seen of this call specify the CLSID's indirectly using the address of label operator '?' something like:-

Code: Select all

hr = CoCreateInstance_(?CLSID_X, NULL, 0, ?IID_Y, @loVFP.Idckardauth)

and then using a labeled data section at the end of the file to specify ID's:-

Code: Select all

DataSection

CLSID_X: 
  ; 8DC6BA5D-6861-4F0A-A080-7DEDCC97C10F
  Data.L $8DC6BA5D
  Data.W $6861, $4F0A
  Data.B $AO, $80, $7D, $ED, $CC, $97, $C1, $OF

IID_Y:
  ; 4C791FAF-8649-462D-A93A-185F95C2DC0E
  Data.L $4C791FAF
  Data.W $8649, $462D
  Data.B $A9, $3A, $18, $5F, $95, $C2, $DC, $0E

EndDataSection

Additionally I'm not sure about the 3rd argument, zero is not defined in the CLSCTX Enumeration. See http://msdn.microsoft.com/en-us/library ... s.85).aspx
As you say the DLL registered successfully - there should be an entry in the registry under the CLSID which might give you a clue. If you don't know what it should be for definite I'd try CLSCTX_INPROC_SERVER (= 1) as a lot of objects are.

ts-soft · Post by **ts-soft** » Tue Feb 22, 2011 7:07 pm

And without Datasection:

Code: Select all

EnableExplicit

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
    If SizeOf(Name) = SizeOf(GUID)
      Name\Data1    = l
      Name\Data2    = w1
      Name\Data3    = w2
      Name\Data4[0] = b1
      Name\Data4[1] = b2
      Name\Data4[2] = b3
      Name\Data4[3] = b4
      Name\Data4[4] = b5
      Name\Data4[5] = b6
      Name\Data4[6] = b7
      Name\Data4[7] = b8
    Else
      Debug "Error - variable not declared as guid"
    EndIf
  CompilerEndIf
EndMacro

Define.GUID CLSID_X, IID_Y

DEFINE_GUID(CLSID_X, $8DC6BA5D, $6861, $4F0A, $A0, $80, $7D, $ED, $CC, $97, $C1, $0F)
DEFINE_GUID(IID_Y, $4C791FAF, $8649, $462D, $A9, $3A, $18, $5F, $95, $C2, $DC, $0E)

; ...

CoCreateInstance_(@CLSID_X, NULL, 0, @IID_Y, @loVFP.Idckardauth)

swhite · Post by **swhite** » Tue Feb 22, 2011 7:36 pm

ts-soft wrote:And without Datasection:

Code: Select all

EnableExplicit

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
    If SizeOf(Name) = SizeOf(GUID)
      Name\Data1    = l
      Name\Data2    = w1
      Name\Data3    = w2
      Name\Data4[0] = b1
      Name\Data4[1] = b2
      Name\Data4[2] = b3
      Name\Data4[3] = b4
      Name\Data4[4] = b5
      Name\Data4[5] = b6
      Name\Data4[6] = b7
      Name\Data4[7] = b8
    Else
      Debug "Error - variable not declared as guid"
    EndIf
  CompilerEndIf
EndMacro

Define.GUID CLSID_X, IID_Y

DEFINE_GUID(CLSID_X, $8DC6BA5D, $6861, $4F0A, $A0, $80, $7D, $ED, $CC, $97, $C1, $0F)
DEFINE_GUID(IID_Y, $4C791FAF, $8649, $462D, $A9, $3A, $18, $5F, $95, $C2, $DC, $0E)

; ...

CoCreateInstance_(@CLSID_X, NULL, 0, @IID_Y, @loVFP.Idckardauth)

Thank-you both as this now allows me to create the COM object successfully. Now I need to find the correct way to pass a string and receive a string because presently my code reports an Invalid Memory Access using:

Code: Select all

lcTxt.s = loVFP\PrepareResponse(lcRcvd)

Simon

ts-soft · Post by **ts-soft** » Tue Feb 22, 2011 7:42 pm

Use Pseudotype in your Interface: http://www.purebasic.com/documentation/ ... types.html
and PeekS(@text, -1, #PB_UNICODE)

swhite · Post by **swhite** » Tue Feb 22, 2011 9:22 pm

ts-soft wrote:Use Pseudotype in your Interface: http://www.purebasic.com/documentation/ ... types.html
and PeekS(@text, -1, #PB_UNICODE)

Hi

I have been playing with the pseudo types but without success. I am wondering why you specified Unicode? The COM object's defined return value is string so are you implying that the actually value returned is a pointer to the string?

Thanks,
Simon

ts-soft · Post by **ts-soft** » Tue Feb 22, 2011 9:26 pm

A COM String is a OLE 32-Bit bString (unicode) or a UNICODE-String!

swhite · Post by **swhite** » Tue Feb 22, 2011 9:30 pm

ts-soft wrote:A COM String is a OLE 32-Bit bString (unicode) or a UNICODE-String!

So I should pass the string to the COM Method as unicode and expect a unicode string in return?

ts-soft · Post by **ts-soft** » Tue Feb 22, 2011 9:39 pm

Read the manual to the com object.
Is the string a bstring, set value.p-bstr in the interface, else set value.p-Unicode
For result use Peeks with #PB_UNICODE and is it a bstring give the string free with
SysFreeString_() API.

swhite · Post by **swhite** » Tue Feb 22, 2011 9:43 pm

ts-soft wrote:Read the manual to the com object.
Is the string a bstring, set value.p-bstr in the interface, else set value.p-Unicode
For result use Peeks with #PB_UNICODE and is it a bstring give the string free with
SysFreeString_() API.

The COM Object Browser say "Method PrepareResponse(tcRcvd As String) As String" and I had previously requested more detail about how "string" is defined. The manual has no explanation so I am trying to find out this information by other means.

Thanks,
Simon

ts-soft · Post by **ts-soft** » Tue Feb 22, 2011 9:51 pm

set value.p-Unicode

swhite · Post by **swhite** » Wed Feb 23, 2011 7:58 pm

Hi

I compiled this code in "Unicode" because that is the format the Wind API expects. Everything works correctly except the "CoCreateInstance_" which always reports the the class is not registered. However it is registered and can used from other software. So I am wondering what might be wrong with my code.

Thanks,
Simon

Code: Select all

Interface Idckardauth Extends IDispatch
;  QueryInterface()
; 	Addref()
; 	Release()
; 	GetTypeInfoCount()
; 	GetTypeInfo()
; 	GetIDsOfNames()
; 	Invoke()
	PrepareResponse.s(tcRcvd.p-bstr)
EndInterface	


Define *CLSID_Class,*CLSID_Interface,CLSID_Class.s,CLSID_Interface.s,lnRtn.i

lnRtn = CLSIDFromString_("{8DC6BA5D-6861-4F0A-A080-7DEDCC97C10F}",@*CLSID_Class)

Select lnRTn
   Case #NOERROR
      Debug "Success"
   Case #CO_E_CLASSSTRING
      Debug "The class string was improperly formatted."
   Case #REGDB_E_CLASSNOTREG
      Debug "The CLSID corresponding to the class string was not found in the registry."
   Case #REGDB_E_READREGDB
      Debug "The registry could not be opened for reading."
   Default
      Debug lnRtn
EndSelect

      
lnRtn =  CLSIDFromString_("{4C791FAF-8649-462D-A93A-185F95C2DC0E}",@*CLSID_Interface)
Select lnRTn
   Case #NOERROR
      Debug "Success"
   Case #CO_E_CLASSSTRING
      Debug "The class string was improperly formatted."
   Case #REGDB_E_CLASSNOTREG
      Debug "The CLSID corresponding to the class string was not found in the registry."
   Case #REGDB_E_READREGDB
      Debug "The registry could not be opened for reading."
   Default
      Debug lnRtn
EndSelect

Define loVFP.idckardauth


;hr = CoInitializeEx_(0,#COINIT_MULTITHREADED)
hr = CoInitializeEx_(0,#COINIT_APARTMENTTHREADED)

Select hr
Case #S_OK
 Debug "Success"
Case #S_FALSE
   Debug "Failed"
Case #RPC_E_CHANGED_MODE
   Debug "A previous call to CoInitializeEx specified the concurrency model for this thread as multithread apartment (MTA). This could also indicate that a change from neutral-threaded apartment to single-threaded apartment has occurred." 
EndSelect



hr = CoCreateInstance_(@*CLSID_Class, 0,5,@*CLSID_Interface,@loVFP)

Select hr
Case #S_OK
 Debug "Success"

Case #REGDB_E_CLASSNOTREG
Debug "A specified class is Not registered in the registration database. Also can indicate that the type of server you requested in the CLSCTX Enumeration is Not registered Or the values For the server types in the registry are corrupt."

Case #CLASS_E_NOAGGREGATION
Debug "This class cannot be created As part of an aggregate."

Case #E_NOINTERFACE
Debug "The specified class does Not implement the requested Interface, Or the controlling IUnknown does Not expose the requested Interface."

Case #E_POINTER
   Debug "The ppv parameter is NULL."
Default
   Debug hr
EndSelect

Trond · Post by **Trond** » Wed Feb 23, 2011 8:17 pm

Code: Select all

hr = CoCreateInstance_(@*CLSID_Class, 0,5,@*CLSID_Interface,@loVFP)

Code: Select all

*CLSID_Class

This is a pointer to the CLSID.

Code: Select all

@*CLSID_Class

This is a pointer to the pointer to the CLSID. Are you sure that's what you want?

swhite · Post by **swhite** » Thu Feb 24, 2011 1:16 am

Trond wrote:
Code: Select all
hr = CoCreateInstance_(@*CLSID_Class, 0,5,@*CLSID_Interface,@loVFP)
Code: Select all
*CLSID_Class
This is a pointer to the CLSID.
Code: Select all
@*CLSID_Class
This is a pointer to the pointer to the CLSID. Are you sure that's what you want?

I have tried it a number of ways and I get and invalid memory access error if I do not use the "@".

Simon

Project Mayu · Post by **Project Mayu** » Fri Mar 25, 2011 4:30 pm

I am trying to load dot net 4, but are getting up to load before I get stuck, hope it helps both of us
cannot get p-unicode to work, structure p does not exit?

Code: Select all

Interface ICLRMetaHost
  QueryInterface(a.l, b.l)
  AddRef()
  Release()
  GetRuntime(a.l, b.l, c.l)
  GetVersionFromFile(a.l, b.l, c.l)
  EnumerateInstalledRuntimes(a.l)
  EnumerateLoadedRuntimes(a.l, b.l)
  RequestRuntimeLoadedNotification(a.l)
  QueryLegacyV2RuntimeBinding(a.l, b.l)
  ExitProcess(a.l)
EndInterface

Interface ICLRRuntimeInfo
  QueryInterface(a.l, b.l)
  AddRef()
  Release()
  GetVersionString(a.l, b.l)
  GetRuntimeDirectory(a.l, b.l)
  IsLoaded(a.l, b.l)
  LoadErrorString(a.l, b.l, c.l, d.l)
  LoadLibrary(a.l, b.l)
  GetProcAddress(a.l, b.l)
  GetInterface(a.l, b.l, c.l)
  IsLoadable(a.l)
  SetDefaultStartupFlags(a.l, b.l)
  GetDefaultStartupFlags(a.l, b.l, c.l)
  BindAsLegacyV2Runtime()
  IsStarted(a.l, b.l)
EndInterface

Interface ICorRuntimeHost ; Common Language Runtime Hosting Interface
  QueryInterface(riid.l,ppvObj.l)
  AddRef()
  Release()
  CreateLogicalThreadState()
  DeleteLogicalThreadState()
  SwitchInLogicalThreadState(pFiberCookie.l)
  SwitchOutLogicalThreadState(pFiberCookie.l)
  LocksHeldByLogicalThread(pCount.l)
  MapFile(hFile.l,hMapAddress.l)
  GetConfiguration(pConfiguration.l)
  Start()
  Stop()
  CreateDomain(pwzFriendlyName.p-unicode,*pIdentityArray.IUnknown,pAppDomain.l)
  GetDefaultDomain(pAppDomain.l)
  EnumDomains(hEnum.l)
  NextDomain(hEnum.l,pAppDomain.l)
  CloseEnum(hEnum.l)
  CreateDomainEx(pwzFriendlyName.p-unicode,*pSetup.IUnknown,*pEvidence.IUnknown,pAppDomain.l)
  CreateDomainSetup(pAppDomainSetup.l)
  CreateEvidence(pEvidence.l)
  UnloadDomain(*pAppDomain.IUnknown)
  CurrentDomain(pAppDomain.l)
EndInterface

Interface Int__AppDomain
  QueryInterface(riid.l,ppvObj.l)
  AddRef()
  Release()
  Hidden1()
  Hidden2()
  Hidden3()
  Hidden4()
  GetToString()
  Equals(a)
  GetHashCode()
  GetType()
  InitializeLifetimeService()
  GetLifetimeService()
  GetEvidence()
  add_DomainUnload(a)
  remove_DomainUnload(a)
  add_AssemblyLoad(a)
  remove_AssemblyLoad(a)
  add_ProcessExit(a)
  remove_ProcessExit(a)
  add_TypeResolve(a)
  remove_TypeResolve(a)
  add_ResourceResolve(a)
  remove_ResourceResolve(a)
  add_AssemblyResolve(a)
  remove_AssemblyResolve(a)
  add_UnhandledException(a)
  remove_UnhandledException(a)
  DefineDynamicAssembly(a,b)
  DefineDynamicAssembly_2(a,b,c)
  DefineDynamicAssembly_3(a,b,c)
  DefineDynamicAssembly_4(a,b,c,d,e)
  DefineDynamicAssembly_5(a,b,c,d)
  DefineDynamicAssembly_6(a,b,c,d,e,f)
  DefineDynamicAssembly_7(a,b,c,d,e,f)
  DefineDynamicAssembly_8(a,b,c,d,e,f,g)
  DefineDynamicAssembly_9(a,b,c,d,e,f,g,h)
  CreateInstance(a,b)
  CreateInstanceFrom(a,b)
  CreateInstance_2(a,b,c)
  CreateInstanceFrom_2(a,b,c)
  CreateInstance_3(a,b,c,d,e,f,g,h,i)
  CreateInstanceFrom_3(a,b,c,d,e,f,g,h,i)
  Load(a)
  Load_2(a.p-unicode)
  Load_3(a)
  Load_4(a,b)
  Load_5(a,b,c)
  Load_6(a,b)
  Load_7(a,b)
  ExecuteAssembly(a,b)
  ExecuteAssembly_2(a)
  ExecuteAssembly_3(a,b,c)
  GetFriendlyName()
  GetBaseDirectory()
  GetRelativeSearchPath()
  GetShadowCopyFiles()
  GetAssemblies()
  AppendPrivatePath(a)
  ClearPrivatePath()
  SetShadowCopyPath(a)
  ClearShadowCopyPath()
  SetCachePath(a)
  SetData(a,b)
  GetData(a)
  SetAppDomainPolicy(a)
  SetThreadPrincipal(a)
  SetPrincipalPolicy(a)
  DoCallBack(a)
  GetDynamicDirectory()
EndInterface

Interface Int__Assembly
  GetToString()
  Equals(a)
  GetHashCode()
  GetType()
  CodeBase()
  EscapedCodeBase()
  GetName()
  GetName_2(a)
  GetFullName()
  GetEntryPoint()
  GetType_2(a)
  GetType_3(a,b)
  GetExportedTypes()
  GetTypes()
  GetManifestResourceStream(a,b)
  GetManifestResourceStream_2(a)
  GetFile(a)
  GetFiles()
  GetFiles_2(a)
  GetManifestResourceNames()
  GetManifestResourceInfo(a)
  GetLocation()
  GetEvidence()
  GetCustomAttributes(a,b)
  GetCustomAttributes_2(a)
  IsDefined(a,b)
  GetObjectData(a,b)
  add_ModuleResolve(a)
  remove_ModuleResolve(a)
  GetType_4(a,b,c)
  GetSatelliteAssembly(a)
  GetSatelliteAssembly_2(a,b)
  LoadModule(a,b)
  LoadModule_2(a,b,c)
  CreateInstance(a)
  CreateInstance_2(a,b)
  CreateInstance_3(a,b,c,d,e,f,g)
  GetLoadedModules()
  GetLoadedModules_2(a)
  GetModules()
  GetModules_2(a)
  GetModule(a)
  GetReferencedAssemblies()
  GetGlobalAssemblyCache()
EndInterface

pClrHost.ICLRMetaHost
pRunInfo.ICLRRuntimeInfo
pRuntimeHost.ICorRuntimeHost
pDomain.IUnknown
myAppDomain.Int__AppDomain
loadedAssembly.Int__Assembly

corlib.i = OpenLibrary(#PB_Any, "mscoree.dll")
If corlib <> 0
  MessageRequester("Test","It's Open")
  ;CLRCreateInstance.ProtoCLRCreateInstance = GetFunction(corlib,"CLRCreateInstance")
  hr.i = CallFunction(corlib,"CLRCreateInstance",?CLSID_CLRMetaHost,?IID_ICLRMetaHost,@pClrHost)
  If hr = #S_OK 
    MessageRequester("Text","Bind")
    version.s = "v4.0.30319"
    hr = pClrHost\GetRuntime(@version,?IID_ICLRRuntimeInfo,@pRunInfo)
    If hr = #S_OK
      MessageRequester("Test","Have Runtime")
      fLoadable.l
      hr = pRunInfo\IsLoadable(@fLoadable)
      If hr = #S_OK
        If fLoadable = 1
          hr = pRunInfo\GetInterface(?CLSID_CorRuntimeHost,?IID_ICorRuntimeHost,@pRuntimeHost)
          If hr = #S_OK
            MessageRequester("Test","Runtime loaded")
            hr = pRuntimeHost\Start()
            If hr = #S_OK
              hr = pRuntimeHost\GetDefaultDomain(@pDomain)
              If hr = #S_OK
                MessageRequester("Test","got domain")
                hr = pDomain\QueryInterface(?IID_AppDomain,@myAppDomain)
				        If hr = #S_OK
				          MessageRequester("Test","domain interface")
				          ;runFile.p-unicode
				          ;runFile = ".\somedotnet.dll"
				          ;hr = myAppDomain\Load_2(runFile)
				          ;If hr = #S_OK
				          ;  MessageRequester("Test","ExecuteAssembly")
				          ;EndIf
				          myAppDomain\Release()
					        myAppDomain = Null
				        EndIf
                pDomain\Release()
                pDomain = Null
              EndIf
              pRuntimeHost\Stop()
            EndIf
            pRuntimeHost\Release()
            pRuntimeHost = Null
          EndIf
        Else
          MessageRequester("Test","Dot Net 4.0 can not be loaded")
        EndIf
      EndIf
      pRunInfo\Release()
      pRunInfo = Null
    Else
      MessageRequester("Error",Hex(hr))
    EndIf
    pClrHost\Release()
    pClrHost = Null
  Else
    MessageRequester("Error",Hex(hr))
  EndIf
  CloseLibrary(corlib)
  corlib = Null
Else
  MessageRequester("Test", "Not Open")
EndIf

DataSection
  IID_ICLRMetaHost:
    Data.l $D332DB9E
    Data.w $B9B3, $4125
    Data.b $82, $07, $A1, $48, $84, $F5, $32, $16  
    
  CLSID_CLRMetaHost:  
    Data.l $9280188d
    Data.w $e8e, $4867
    Data.b $b3, $c, $7f, $a8, $38, $84, $e8, $de
    
  IID_ICLRRuntimeInfo:
    Data.l $BD39D1D2
    Data.w $BA2F, $486a
    Data.b $89, $B0, $B4, $B0, $CB, $46, $68, $91
    
  CLSID_CorRuntimeHost:
    Data.l $cb2f6723
    Data.w $ab3a, $11d2
    Data.b $9c, $40, $00, $c0, $4f, $a3, $0a, $3e  

  IID_ICorRuntimeHost:  ; {CB2F6722-AB3A-11D2-9C40-00C04FA30A3E}
    Data.l $CB2F6722
    Data.w $AB3A,$11D2
    Data.b $9C,$40,$0,$C0,$4F,$A3,$A,$3E
    
  IID_AppDomain:  ; {05F696DC-2B29-3663-AD8B-C4389CF2A713}
    Data.l $05F696DC
    Data.w $2B29,$3663
    Data.b $AD,$8B,$C4,$38,$9C,$F2,$A7,$13
  
  EndDataSection

PureBasic Forums - English

Help Needed for COM Automation

Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation

Re: Help Needed for COM Automation