Hi all,

FYI, I am the smae member as JAAFAR. I forgot the forum password but couldn't recover it because I also lost the email account I first registered with .So i had to register under this new name.

Anyways, I am just trying to adapt the code from here. I was unable to post in the original thread.

Basically I have this class module named IMyInterface:
Code:
Option Explicit

Public Function AddTwoLongs(ByVal x As Long, ByVal y As Long) As Long
'
End Function
Then, I have this code in a bas module to create the light weight object based on the above class module (IMyInterface):
Code:
Option Explicit

Private Type tMyCOMcompatibleVTable
  'Space for the 3 Function-Pointers of the IUnknown-Interface
  QueryInterface As Long
  AddRef         As Long
  Release        As Long
  'followed by Space for the single Function-Pointer of our concrete Method
  AddTwoLongs    As Long
End Type

Private Type tMyObject 'the Object-Instances will occupy only 8Bytes (that's half the size of a Variant-Type)
  pVTable As Long
  RefCount As Long
End Type

Private mVTable As tMyCOMcompatibleVTable 'preallocated (static, non-Heap) Space for the VTable

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Declare Function CoTaskMemAlloc Lib "ole32" (ByVal sz As Long) As Long
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pMem As Long)
Declare Sub Assign Lib "kernel32" Alias "RtlMoveMemory" (Dst As Any, Src As Any, Optional ByVal CB& = 4)


 

Public Function VTablePtr() As Long 'the only Public Function here (later called from modMyClassFactory)
  If mVTable.QueryInterface = 0 Then InitVTable 'initializes only, when not already done
  VTablePtr = VarPtr(mVTable) 'just hand out the Pointer to the statically defined mVTable-Variable
End Function

Private Sub InitVTable() 'this method will be called only once (and is thus not "performance-critical")
  mVTable.QueryInterface = VBA.CLngLng(AddressOf QueryInterface)
  mVTable.AddRef = VBA.CLngLng(AddressOf AddRef)
  mVTable.Release = VBA.CLngLng(AddressOf Release)
  
  mVTable.AddTwoLongs = VBA.CLngLng(AddressOf AddTwoLongs)
End Sub


 
'Factory Helper-Function to create a new Class-Instance (a new Object) of type IMyClass
Public Function CreateInstance() As Class1 '<- this Type is defined in a little TypeLib, contained in TutorialFolder #0
Dim MyObj As tMyObject 'we use our UDT-based Object-Type in a Stack-Variable for more convenience
    MyObj.pVTable = VTablePtr 'whilst filling its members (as e.g. pVTable here)
    MyObj.RefCount = 1 '<- the obvious value, since we are about to create a "fresh instance"

    Dim pMem As Long
    pMem = CoTaskMemAlloc(LenB(MyObj)) 'allocate space for our little 8Byte large Object
     Assign ByVal pMem, MyObj, LenB(MyObj)
    Assign CreateInstance, pMem 'copy-over the Data from our local MyObj-UDT-Variable

End Function


'IUnknown-Implementation
Public Function QueryInterface(This As tMyObject, ByVal pReqIID As Long, ppObj As stdole.IUnknown) As Long '<- HResult
  QueryInterface = &H80004002 'E_NOINTERFACE, just for safety reasons ... but there will be no casts in our little Demo
End Function

Public Function AddRef(This As tMyObject) As Long
MsgBox "addref"
'  This.RefCount = This.RefCount + 1
'  AddRef = This.RefCount
End Function

Public Function Release(This As tMyObject) As Long
'  This.RefCount = This.RefCount - 1
'  Release = This.RefCount
'  If This.RefCount = 0 Then CoTaskMemFree VarPtr(This)  '<- here's the dynamic part again, when a Class-instance dies
'
  MsgBox "releaseref"

End Function

'IMyClass-implementation (IMyClass only contains this single method)
Public Function AddTwoLongs(This As tMyObject, ByVal L1 As Long, ByVal L2 As Long, Result As Long) As Long '<- HResult
  Result = L1 + L2 'note, that we set the Result ByRef-Parameter - not the Function-Result (which would be used for Error-Transport)
'  MsgBox Result
End Function
Now. When I run the following Test Sub , it successfully creates a new instance of IMyInterface but crashes at the call of AddTwoLongs Method:
Code:
Sub Test()
    Dim x As IMyInterface
    
    Set x = CreateInstance
    MsgBox x.AddTwoLongs(2, 8)
End Sub
Can anybody please see if the logic of I am doing is wrong and if not why does the code crashes when it reaches the AddTwoLongs Method call ?

Regards.