` Printed Icetips Article

Icetips Article



COM: Starting an instance on NET from Clarion using COM
2003-05-14 -- Jim Kane
 
Newsgroups: softvelocity.products.c55ee


You need to start an instance of the .net run time.  the only way I know to
do this is via com and using IDispatch.  Here is some sample code where I
called the system.collection.arraylist class from clarion.  The problem is I
do not know of a place where the prototypes and data types for each method
in runtime are listed.  Some of what I did was trial by error until I
figured out how some .net data types like object are passed. the stdcom2
class is from clarion mag and dotnetlib.inc and dotnetcore.inc are obtained
by running my interface generator from Clarion Magazine on the .net dlls of
similar name.  There is a good book on .Net and COM by Adam Nathan of
microsoft that would be a big help if you want to do more with this.
Jim Kane

  program
_abcdllmode_ equate(0)
_abclinkmode_ equate(1)
  map
    module('api')
      variantinit(long),pascal,proc,Raw
      variantClear(long),long,pascal,proc,raw
    end
  end

include('STDCOM2.inc')
include('dotnetlib.inc')
include('dotnetcore.inc')

return:benign equate(0)
return:notify equate(5)
return:fatal  equate(3)

stdcom2  class(stdcom2cltype)

Idisp           &IDispatchType
dispid          long
CallType        long
ParamArray      &string
paramcount      long
varresult       like(varianttype)
varSecondary    like(varianttype)

InvokeSetup     procedure(long lpDispatch, |
                          string pMethodname, |
                          long pParamCount, |
                          string pCallType),byte
InvokeCall      procedure(),byte
InvokeCleanUp   procedure()
AddParamLong    procedure(long pParamIdx, |
                          ushort pVarType, |
                          long pVarValue),byte
AddParamString  procedure(long pParamIdx, string pCWStr),byte
AddParamVariant procedure(long pParamIdx, |
                          ushort pVarType, |
                          long pVarValue),byte !variant by ref
AddParamVariantStr procedure(long pParamIdx, |
                             string pVarValue),byte !variant by ref
GetParamString  procedure(long pParamIdx,<*byte pres>),*string
GetParamLong    procedure(long pParamIdx, |
                          *ushort pVarType, |
                          *long pVarValue),byte
                end


ICorRunTimeHost     &ICorRuntimeHosttype
IAppDomain          &_AppDomaintype
IUnk                &IUnknowntype
IDotNet             &IDispatchType
_objectHandle       &_ObjectHandleType
varObj              like(VariantType)
DotNetStarted       byte(False)
lpInterface         long
lpbstr1             long
lpbstr2             long
Idisp               &IDispatchtype
vt                  ushort
thelong             long
CwStr               &string
  code
  DotNetStarted=false
  stdcom2.initcom(1)

  ICorRunTimeHost &= stdcom2.getinterface(address(CLSID:CorRuntimeHost), |
                                          address(IID:ICorRuntimeHost))
  If ICorRunTimeHost&=NULL then
    StdCom2.TakeError('Cannot create an instance of the .NET runtime.','DotNet prj')
    return
  end

  if StdCom2.TakeHR(ICorRunTimeHost.StartIt(),'Start Runtime') then 
    do procret Else DotNetStarted=true.

  Message('DotNet is running')
  if stdcom2.takehr(ICorRunTimeHost.GetDefaultDomain(lpInterface),|
                    'GetDefaultDomain') or ~lpInterface then do procret.
  Iunk &= (lpInterface)

  if stdcom2.TakeHR(Iunk.QueryInterface(address(iid:_AppDomain),lpInterface),|
                    'QI for appdomain') then Iunk.release();do procret.
  Iunk.release
  IAppDomain&=(lpInterface)

  if StdCom2.ToBstr('mscorlib',lpbstr1) or |
     StdCom2.ToBstr('System.Collections.ArrayList',lpbstr2) then do procret.
  if
StdCom2.takehr(IAppDomain.CreateInstance(lpbstr1,lpbstr2,lpInterface),'CreateInstance') or
|
     ~lpInterface then do procret.
  StdCom2.strcl.BstrFree(lpbstr1);StdCom2.strcl.BstrFree(lpbstr2)
  _ObjectHandle&=(lpInterface)

  if StdCom2.takehr(_ObjectHandle.Unwrap(VarObj),'Unwrap') then do procret.
  if varobj.vt<>VT_Dispatch then
    variantclear(address(varobj))
    StdCom2.TakeHR('unvalid dispatch pointer','')
    do procret
  end
  lpInterface=VarObj.value
  Idotnet&=(lpInterface) !released in kill

  !get the count
  if Stdcom2.InvokeSetup(lpInterface,'COUNT',0,'GET') or |
     StdCom2.InvokeCall() then
     StdCom2.InvokeCleanup()
  else
    if stdcom2.GetParamLong(0,vt,TheLong) then do procret.
    message('The count before is ' & theLong)
    StdCom2.InvokeCleanup()
  end


  !get dispid for capacity
  if Stdcom2.InvokeSetup(lpInterface,'CAPACITY',0,'GET') or |
     StdCom2.InvokeCall() then
    StdCom2.InvokeCleanup()
    do procret
  else
    if stdcom2.GetParamLong(0,vt,TheLong) then do procret.
    message('The capacity is ' & theLong)
    StdCom2.InvokeCleanup()
  end


  !Call the add method
  if StdCom2.InvokeSetup(lpInterface,'ADD',1,'METHOD') or |
    StdCom2.AddParamVariantStr(1, 'Hello there unmanaged world.  I''m from planet .NET!')
or |
    StdCom2.InvokeCall() then
    Stdcom2.InvokeCleanup()
    do procret
  else
    Message('add worked.  Added at index 0 the string: Hello there unmanaged world.  I''m
from planet .NET!')
    StdCom2.InvokeCleanup()
  end


  !get the count
  if Stdcom2.InvokeSetup(lpInterface,'COUNT',0,'GET') or |
     StdCom2.InvokeCall() then
     StdCom2.InvokeCleanup()
  else
    if stdcom2.GetParamLong(0,vt,TheLong) then do procret.
    message('The count after is ' & theLong)
    StdCom2.InvokeCleanup()
  end

  !call the item get method
  if StdCom2.InvokeSetup(lpInterface, 'ITEM', 1, 'GET') or |
    StdCom2.AddParamlong(1,VT_I4,0) or | !set an integer index of 0
    StdCom2.InvokeCall() then
    StdCom2.InvokeCleanUp()
  else
    cwstr&=StdCom2.GetParamString(0) !get the returned string
    message(cwstr,'Item[0]')
    dispose(cwstr)
  end

  do procret
  Message('back after procret!')

procret routine
  StdCom2.strcl.BstrFree(lpbstr1);StdCom2.strcl.BstrFree(lpbstr2)
  if ~IDotNet&=null then
    IDotNet.release()
    IDotNet&=NULL
  end
  if ~_ObjectHandle&=NULL then
    _ObjectHandle.Release()
    _ObjectHandle&=NULL
  end
  if ~IAppDomain &= NULL then
    IAppDomain.Release()
    IAppDomain&=NULL
  end
  if ~ICorRuntimeHost&=NULL then
    if DotNetStarted then
      StdCom2.TakeHR(ICorRunTimeHost.StopIt(),'Stop Runtime')
      clear(DotNetStarted)
      Message('Stopped runtime')
    end
    ICorRunTimeHost.Release()
    ICorRunTimeHost&=NULL
  end
  stdcom2.killcom()
  message('Experiment done')
  return



StdCom2.GetParamLong procedure(long pParamIdx, |
                               *ushort pVarType, |
                               *long pVarValue)!, byte
v &variantType
  code
  if pParamidx=0 then
    pVarType=SELF.VarResult.VT
    pVarValue=SELF.VarResult.Value
    Return return:benign
  end
  if pParamIdx<1 or pParamIdx>SELF.ParamCount then
    SELF.TakeError('AddParamLong called with an out of range paramidx.','')
    return Return:Fatal
  end
  v &=(Address(SELF.paramArray) + (SELF.ParamCount-pParamIdx)*size(varianttype))
  pVarType=SELF.VarResult.VT
  pVarValue=SELF.VarResult.Value
  return Return:Benign



StdCom2.GetParamString procedure(long pParamIdx,<*byte pRes>)
cwstrdummy &string
v &variantType
  code
  if pParamidx=0 then
    if SELF.VarResult.Vt<>VT_Bstr then
      if ~omitted(3) then pRes=return:notify.
      return cwStrDummy
    end

    cwStrDummy&=SELF.FromBstrAlloc(SELF.VarResult.Value,1)
    if ~omitted(3) then pRes=Return:benign.
    Return CWStrDummy
  end
  if pParamIdx<1 or pParamIdx>SELF.ParamCount then
    SELF.TakeError('AddParamLong called with an out of range paramidx.','')
    if ~omitted(3) then pRes=Return:fatal.
    return cwstrdummy
  end
  v &=(Address(SELF.paramArray) + (SELF.ParamCount-pParamIdx)*size(varianttype))
  if v.vt<>vt_bstr then
    if ~omitted(3) then pRes=return:notify.
    return CwStrDummy
  end
  CWStrDummy&=SELF.FromBstrAlloc(v.Value,1)
  if ~omitted(3) then pRes=Return:benign.
  return cwstrdummy

StdCom2.AddParamString  procedure(long pParamIdx, string pCWStr)!,byte
v   &VariantType
res byte(return:fatal)
lpbstr long
  code
  if pParamIdx<1 or pParamIdx>SELF.ParamCount then
    SELF.TakeError('AddParamLong called with an out of range paramidx.','')
    return res
  end
  v &=(Address(SELF.paramArray) + (SELF.ParamCount-pParamIdx)*size(varianttype))
  if SELF.ToBstr(pCWStr,lpbstr) then return res.

  v.vt=vt_bstr
  v.value=lpbstr
  return return:benign

StdCom2.AddParamLong    procedure(long pParamIdx, ushort pVarType, long
pVarValue) !,byte
v  &varianttype
res byte(return:Fatal)
  code
  if pParamIdx<1 or pParamIdx>SELF.ParamCount then
    SELF.TakeError('AddParamLong called with an out of range paramidx.','')
    return res
  end
  v &=(Address(SELF.paramArray) + (SELF.ParamCount-pParamIdx)*size(varianttype))
  v.Vt=pVarType
  v.Value=pVarValue
  return return:benign

StdCom2.AddParamVariant procedure(long pParamIdx, ushort pVarType, long
pVarValue)  !,byte !variant by ref
v &varianttype
  code
  VariantInit(Address(SELF.VarSecondary))
  if pParamIdx<1 or pParamIdx>SELF.ParamCount then
    SELF.TakeError('AddParamvariant called with an out of range paramidx.','')
    return return:fatal
  end
  v &=(Address(SELF.paramArray) + (SELF.ParamCount-pParamIdx)*size(varianttype))
  v.Vt=VT_Variant + VT_ByRef
  v.Value=Address(SELF.VarSecondary)
  SELF.VarSecondary.Vt=pVarType
  SELF.VarSecondary.Value=pVarValue
  return return:benign

StdCom2.AddParamVariantStr procedure(long pParamIdx, string pVarValue)
!,byte !variant by ref
v &varianttype
  code
  VariantInit(Address(SELF.VarSecondary))
  if pParamIdx<1 or pParamIdx>SELF.ParamCount then
    SELF.TakeError('AddParamVariantStr called with an out of range paramidx.','')
    return return:fatal
  end
  v &=(Address(SELF.paramArray) + (SELF.ParamCount-pParamIdx)*size(varianttype))
  v.Vt=VT_Variant + VT_ByRef
  v.Value=Address(SELF.VarSecondary)
  SELF.VarSecondary.Vt=vt_bstr
  if SELF.ToBstr(pVarValue, SELF.VarSecondary.Value) then return return:fatal.
  return return:benign


StdCom2.InvokeSetup    procedure(long lpDispatch, string pmethodname,long
pParamCount, string pCallType)
!purpose setup for a IDispatch.Invoke call - save the interface, dispid,
paramcount, make a blank list of variants
lpMethodname            long(0)
Locale_system_default   equate(0)
res                     byte(return:fatal)
DISPATCH_METHOD         equate(1)
DISPATCH_PROPERTYGET    equate(2)
DISPATCH_PROPERTYPUT    equate(4)
DISPATCH_PROPERTYPUTREF equate(8)
I                       long,auto
  code
  SELF.IDisp&=NULL
  clear(SELF.dispid)
  Clear(SELF.ParamCount)
  CLEAR(SELF.CallType)

  !SETUP DISPATCH INTERFACE
  if ~lpDispatch then
    SELF.TakeError('GetDispID called with a null interface pointer','Fatal Error')
    return res
  end
  SELF.IDisp&=(lpDispatch)
  SELF.paramCount=pParamCount

  !save call type
  case upper(pCallType)
  of 'G'
  orof 'GET'
    SELF.CallType=DISPATCH_PROPERTYGET
  of 'P'
  orof 'PUT'
    SELF.CallType=DISPATCH_PROPERTYPUT
  of 'M'
  orof 'METHOD'
    SELF.CallType=DISPATCH_METHOD
  of 'R'
  orof 'PUTREF'
    SELF.CallType=DISPATCH_PROPERTYPUTREF
  else
    SELF.TakeError('Unknown call type calling ' & clip(pMethodname),'Fatal Error')
    return res
  end

  !GET THE DISPID
  if SELF.StrCl.cWToBstrAlloc(pmethodname,lpMethodname) then
    return res
  end
  res=SELF.TakeHr(SELF.IDisp.GetIdsOfNames(address(iid:null), |
                  address(lpMethodname),1, locale_system_default, SELF.dispid),|
                  'GetIdOfNames')
  SELF.StrCl.Bstrfree(lpMethodname)

  if SELF.ParamCount>0 then
    SELF.ParamArray&=New string(size(variantType)*SELF.ParamCount)
    if SELF.ParamArray &=NULL then
      SELF.TakeError('Out of memory','Fatal Error')
      return res
    end

    loop i=0 to SELF.paramcount-1
      variantinit(address(SELF.paramArray) + Size(VariantType)*I )
    end
  else
    dispose(SELF.paramArray)
  end
  VariantInit(address(SELF.VarResult))
  res = Return:Benign
  return res


StdCom2.InvokeCall      procedure() !,byte
dispparms               group           !used to pass parameters to a Idispatch invoke
method
lparrOfargs               long
lpdispofargs              long  !0
NumArgs                   long
numNamedArgs              long  !0
                        end
ExcepInfo               group
wCode                     ushort
wReserved                 ushort
lpBstrSource              long
lpBstrDescription         long
lpBstrHelpFile            long
dwHelpContext             long
pvReserved                long
pFnDeferredFillin         long
Scode                     long
                        end
disp_E_Exception        equate(80020009H)
paramindex              long
loc:cwstr               &string
Res                     byte(Return:Fatal)
Disp_E_TypeMismatch     equate(80020005H)
Disp_E_ParamNotFound    equate(80020004H)
    code
    dispparms.lparrofargs=address(SELF.paramArray)
    dispparms.numArgs=SELF.ParamCount
    if SELF.Takehr(SELF.IDisp.Invoke(SELF.DispID, address(iid:null), 0,|
         SELF.CallType,address(dispparms), address(Self.VarResult), |
         address(excepinfo), paramindex),'getcount') then
      if ExcepInfo.lpBstrDescription then
        loc:cwstr&=SELF.FromBstrAlloc(ExcepInfo.lpBstrDescription,1)
        SELF.TakeError(loc:CWStr,'')
        dispose(loc:cwstr)
      elsif ExcepInfo.pfnDeferredFillIn then
        if SELF.calldllcl.callbyAddress(ExcepInfo.pfnDeferredFillIn,|
                                        address(ExcepInfo))>=0 then
          loc:cwstr&=SELF.FromBstrAlloc(ExcepInfo.lpBstrDescription,1)
          SELF.TakeError(loc:CWStr,'')
          dispose(loc:cwstr)
        end
      end
      SELF.StrCl.bstrFree(ExcepInfo.lpBstrSource)
      SELF.StrCl.BstrFree(ExcepInfo.lpBstrHelpfile)
      if SELF.Lasthr=Disp_E_TypeMismatch or SELF.LastHr=Disp_E_ParamNotFound then
        SELF.TakeError(choose(SELF.LastHR=Disp_E_Typemismatch,|
                       'Parameter type mismatch. ',|
                       'Parameter not found. ') & |
                       ' Error is with parameter number ' & |
                       SELF.ParamCount - paramindex,'Parameter Error')
      end
    else
      res=return:benign
    end
    return res



StdCom2.InvokeCleanUp   procedure()
I   long,auto
res byte(return:benign)
  code
  if SELF.ParamCount>0 and ~SELF.ParamArray&=NULL then
    loop i=0 to SELF.paramcount-1
      variantclear(address(SELF.paramArray) + Size(VariantType)*I )
    end
  end
  VariantClear(Address(SELF.varResult))
  variantClear(Address(SELF.VarSecondary))
  Dispose(SELF.ParamArray)
  return

> I've written a Windows DLL in C# (Visual Studio .NET 2002). Now I want to
> link this DLL to an existing Clarion C55ee project so I can call the methods
> in the DLL from my Clarion application.
>
> I opened this - rather tried - in LibMaker in order to produce a Topspeed
> .LIB, but apparently LibMaker finds nothing.
>
> Help!



Printed May 10, 2024, 6:28 am
This article has been viewed/printed 35126 times.
Google search has resulted in 503 hits on this article since January 25, 2004.