VB6 LightWeight COM and vbFriendly-BaseInterfaces

[Schmidt]

Some stuff for the advanced VB-users among the community (or the curious) ...

I was recently working on some things in this area (preparations for the
C-Emitter of a new VB6-compiler, with regards to "C-style defined Classes") -
and this Tutorial is more or less a "by-product".

I've just brought parts of it into shape, since I think this stuff can be
useful for the community even whilst working with the old compiler.

To gain more IDE-safety (and keep some noise out of the Tutorial-Folders),
I've decided to implement the Base-stuff in its own little Dll-Project:
vbInterfaces.dll

The sources for this Helper-Dll are contained in an appropriate Folder
(vbFriendlyInterfaces\vbInterfaces-Dll\...) in this Tutorial-Zip here:
vbFriendlyInterfaces.zip

The Dll-Project currently contains vbFriendly (Callback-) Interfaces for:
- IUnknown
- IDispatch
- IEnumVariant
- IPicture

Feel free to contribute stuff you think would be useful to include in the
Dll-Project itself - although what it currently contains with regards to
IUnknown and IDispatch, allows to develop your own vtMyInterface-stuff
already "separately" (in a normal VB-StdExe-project for example).

Before entering the Tutorial-Folder and start running the Examples, please make
sure, that you compile the vbInterfaces.dll first from the above mentioned Folder.

The above Zip contains currently a set of 10 Tutorial-Apps, all in their own Folders
(numbered from 0 to 9, from "easy to more advanced") - and here is the
Tutorial-FolderList:
.. 0 - LightWeight COM without any Helpers
.. 1 - LightWeight LateBound-Objects
.. 2 - LightWeight EarlyBound-Objects
.. 3 - LightWeight Object-Lists
.. 4 - Enumerables per vbIEnumVariant
.. 5 - MultiEnumerations per vbIEnumerable
.. 6 - Performance of vbIDispatch
.. 7 - Dynamic usage of vbIDispatch
.. 8 - Simple SOAPDemo with vbIDispatch
.. 9 - usage of vbIPictureDisp

For the last two Tutorial-Demos above I will post separate CodeBank articles,
since they are larger ones - and deserve a few Extra-comments.

Maybe some explanations for NewComers to the topic, who want to learn what
the terms "LightWeight COM", or "C-style Class-implementation" mean:

First, there's a clear separation to be made between "a Class" and "an Object",
since these terms mean two different things really, which we need to look at separately.

- "a Class" is the "BluePrint", which lives in the static Memory of our running Apps or Dlls
- "an Object" (aka "an Instance of a Class") lives as a dynamic Memory-allocation (which refers back to the "BluePrint").

And VB-Objects (the ones we create as Instances from a VB-ClassModules "BluePrint" per New) are quite "large animals" -
since they will take up roughly 116 Bytes per instance-allocation, even when they don't contain any Private Variable Definitions.

A Lightweight COM-Object can be written in VB6 (later taking up only as few as 8Bytes per Instance),
when we resort to *.bas-Modules (similar to the code-modules one would write in plain C).

Here's some Code, how one would implement that (basically the same, as contained in Tutorial-Folder #0):

Let's say we want to implement a lightweight COM-Class (MyClass), which has only a single
Method (AddTwoLongs) in its Public Interface (IMyClass).

We start with the "BluePrint", and the VB-Module which implements that "C-style" would contain only:

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 mVTable As tMyCOMcompatibleVTable 'preallocated (static, non-Heap) Space for the VTable

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 = FuncPtr(AddressOf modMyClassFactory.QueryInterface)
  mVTable.AddRef = FuncPtr(AddressOf modMyClassFactory.AddRef)
  mVTable.Release = FuncPtr(AddressOf modMyClassFactory.Release)
  
  mVTable.AddTwoLongs = FuncPtr(AddressOf modMyClassFactory.AddTwoLongs)
End Sub

I assume, the above is not that difficult to understand (most "static things" are easy this way) -
what it ensures is, that it "gathers things in one static place" - in this case:
"Function-Pointers in a certain Order" - this "List of Function-Pointers" remains (in its defined order)
behind the static UDT-variable mVTable - and that was it already...

What remains (perhaps a bit more difficult to understand to "make the leap") is,
how the above code-definition will interact, when we now come to the "dynamic part"
(the Objects and their instantiations from a BluePrint).

To have the dynamic part more separated, let's use an additional module (modMyClassFactory):

And as the choosen name (modMyClassFactory) suggests, this is the part which finally hands out
the new Instances (similar to one of the 4 exported Functions, which any ActiveX-Dll needs to support,
which is named 'DllGetClassFactory' for a reason).

So let's show the ObjectCreation-Function in that *.bas Module first:
Note, that UDT struct-definitions are only there for the compiler to "have info about needed space" -
(I've marked these Length-Info parts in light orange below - and the dynamic allocation part in magenta)...

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
 
'Factory Helper-Function to create a new Class-Instance (a new Object) of type IMyClass
Public Function CreateInstance() As IMyClass '<- 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 = modMyClassDef.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) 'copy-over the Data from our local MyObj-UDT-Variable
    Assign CreateInstance, pMem 'assign the new initialized Object-Reference to the Function-Result
End Function

What remains now, is to provide the Implementation-code for the 4 VTable-methods (which is contained in that same Module)

'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
  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
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)
End Function

Finally (to have it complete) a Helper-Function and a few APIs, which are contained in another small *.bas Module

Declare Function CoTaskMemAlloc& Lib "ole32" (ByVal sz&)
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pMem&)
Declare Sub Assign Lib "kernel32" Alias "RtlMoveMemory" (Dst As Any, Src As Any, Optional ByVal CB& = 4)
 
Function FuncPtr(ByVal Addr As Long) As Long 'just a small Helper for the AddressOf KeyWord
  FuncPtr = Addr
End Function

So, what was (codewise) posted above, is complete - and how a bare-minimum-implementation
for a lightweight "8-Byte large COM-object" could look like in VB6 (and not much different in C) -
no need to copy it over into your own Modules because as said, this is all part of the first little
Demo (in Tutorial-Folder #0, which also includes the needed TypeLib to run the thing).

Happy studying and experimenting...

Olaf

[jpbro]

Hi Olaf,

Thanks for this demo, I've been experimenting with it and it has been very interesting. I have a couple of questions/observations:

In addition to the memory savings, your light-weight COM method also appears to be much faster to instantiate. For example, I tried creating 100,000 lightweight COM objects and it took about 30ms. Creating the same # of VB6 Class module objects took almost 200ms. This is nice if you are creating a lot of objects

I have one situation where this is indeed the case - I have a paper form layout engine that use objects extensively, sometimes many thousands of them for representing different pages, object types, properties, etc...so if I can get a bit of a performance boost by refactoring it to use lightweight COM, then that would be great.

The problem I've run into is that I use your RC5 collection (and collections of collections) to hold references to the layout objects, but if I try to add the lightweight COM object to the RC5 collection I get a type mismatch error. Is there any solution for this?

Next as a warning to others - don't press END while debugging in the IDE using this lightweight COM method, or you'll blow up real good

Thanks again!

[jpbro]

I've just taken a look at the LightWeight Object-Lists demo, and I think it may have the answers to my question re: adding lightweight COM objects to a collection. I'll study it and see.

[Schmidt]

The problem I've run into is that I use your RC5 collection (and collections of collections) to hold references to the layout objects, but if I try to add the lightweight COM object to the RC5 collection I get a type mismatch error. Is there any solution for this?

I guess, you used the Demo #0 (which constructs a "naked" COM-Object,
and comes - for brevity's sake - without a decent QueryInterface-Handling...)
That would explain the type-mismatch error (due to the HResult I've returned there).

Next as a warning to others - don't press END while debugging in the IDE using this lightweight COM method, or you'll blow up real good

That also seems related to Demo #0 (the one I've explained in the opener-post).

The other Demos (1 to 9) should behave with proper IDE-safety - and survive a few
IDE-End-Button-Clicks.

That's because I work through the vbInterfaces.dll in these cases (1 to 9).

As for "large Object-Lists" (in Collection- or Array-Containers)...

You are right, Demo #3 contains an example with some performance-comparisons...
And whilst it's true, that it is (slightly) faster when doing instantiations, compared
with the "classic VB-Objects", the even larger advantage comes when Objects
need to be destroyed.

A larger bunch of VB-Object-Instances (no matter if those sit in an Array - or a Collection)
will take *significantly* more time for destroying than the lightweight ones.

In case of Demo #3 (with 100000 Objects) the time for construction is:
- in case of the classic Method roughly 320msec
- with the lightweight method roughly 250msec

But more importantly, the timing for desctruction is:
- in case of the classic Method roughly 1550msec
- with the lightweight method roughly 35msec

The latter case (aside from less memory-consumption) is the main-reason,
why someone might want to "go lightweight"...

Regards,

Olaf

[georgekar]

lightweight objects list demo:
548 sec, 198sec to destroy,1129 to find 273 persons from 10000 objects
classic:
609 sec, 1150sec to destroy, 1062 to find 273 persons from 10000 objects

Run on a VirtualBox with XP. I have Ubuntu Studio, with AMD 6100 3.3 Mhz, and I have 1 GByte for XP from total 4Gbyte.

[jpbro]

Thanks Olaf - I've been away for a few days, but I am going to take a closer look at the other demos today. I ran (compiled) your demo #3 and here are my results (to compare with georgekar's).

Classic:
Create: 329ms
Destroy: 1638ms
Find: 608ms

Lightweight:
Create: 218ms
Destroy: 53ms
Find: 662ms

So a huge "destroy" improvement, a modest "create" improvement, and equal "find" performance means an overall win for the lightweight COM approach. Thanks again for posting these demos!

[Schmidt]

Thanks for the feedback with regards to the timings guys...

@JPBro
Yep, that basically matches with what I measure here too.

@George
Yours are a bit "off" (although the relations are roughly the same too) - did you compile natively?
Though maybe it's the AMD-CPU (I measured on a relative modern Intel-CPU).

The (slightly) slower performance of the lightweight-list in the "Find Birthdays" method
is caused by the QueryInterface-calls when doing a:

For Each ConcreteObjType In Col
...
Next

It's not that the early-Bound calls on the lighweight-instances are
slower somehow - no, the difference is only caused by the way
"For Each Enumerations work" in VBClassic.

In VBs (IEnumVariant-based) Enumerations on Object-Containers,
there's always a (QueryInterface-based) cast involved (from the
Variant-Value of IUnknown which the Enumerator returns, to the concrete Object-Type.

And these casts have to run through the (String-IID based)
QueryInterface-callbacks in case of the lightweight-instances -
whilst the VBRuntime does these QueryInterface-IID-compares
on the "native GUID-struct" without IID-String-Conversions.

I've optimized my current vbInterfaces-Dll-project already in this regard,
but it's nothing "critical" at the moment - so I'll wait a bit with an update -
maybe some other things or ideas come up in addition after a few more
weeks in the wild...

Olaf

[georgekar]

Olaf,
Yesterday I boot from another hard disk with XP (original). As I see when my language run uses only 17% of CPU power, because only one thread can be used from six. When XP run on VirtualBox I gave to it only two from six processors, and there can run faster because the main program VirtualBox who handles graphics and I/O runs on the other side.
If I run two instances of m2000.exe (the interpreter of M2000) and put a graphics program with rendering screen then I can get 99%. So The numbers, in your example, are not quite good because one thread is used, in an environment with two infront and 4 hidden, used from Ubuntu (I can run Windows 7 and Xp on Ubuntu, and I can make an internal network, to check pipes...and they work). So check your program how much CPU use when you get those numbers. (And how many cpu have your machine...can you tell that??)

[Chidhakwa]

Thank you Olaf for yet another well structured insightful tutorial! Can't over state how much help you've been in my development process. Also, for any of those interested this will work in VBA with very few modifications (mostly just the obvious one; changing the form objects to userforms).

[dreammanor]

I'm trying to convert some TypeScript interfaces into VB6 code, I'd like to know if vbFriendlyInterfaces could do something here.

/*---------------------------------------------------------
 * Copyright (C) Microsoft Corporation. All rights reserved.
 *--------------------------------------------------------*/
'use strict';

// -- raw grammar typings

export interface ILocation {
	readonly filename: string;
	readonly line: number;
	readonly char: number;
}

export interface ILocatable {
	readonly $vscodeTextmateLocation?: ILocation;
}

export interface IRawGrammar extends ILocatable {
	repository: IRawRepository;
	readonly scopeName: string;
	readonly patterns: IRawRule[];
	readonly injections?: { [expression: string]: IRawRule };
	readonly injectionSelector?: string;

	readonly fileTypes?: string[];
	readonly name?: string;
	readonly firstLineMatch?: string;
}

export interface IRawRepositoryMap {
	[name: string]: IRawRule;
	$self: IRawRule;
	$base: IRawRule;
}

export type IRawRepository = IRawRepositoryMap & ILocatable;

export interface IRawRule extends ILocatable {
	id?: number;

	readonly include?: string;

	readonly name?: string;
	readonly contentName?: string;

	readonly match?: string;
	readonly captures?: IRawCaptures;
	readonly begin?: string;
	readonly beginCaptures?: IRawCaptures;
	readonly end?: string;
	readonly endCaptures?: IRawCaptures;
	readonly while?: string;
	readonly whileCaptures?: IRawCaptures;
	readonly patterns?: IRawRule[];

	readonly repository?: IRawRepository;

	readonly applyEndPatternLast?: boolean;
}

export interface IRawCapturesMap {
	[captureId: string]: IRawRule;
}

export type IRawCaptures = IRawCapturesMap & ILocatable;


export interface IOnigLib {
	createOnigScanner(sources: string[]): OnigScanner;
	createOnigString(sources: string): OnigString;
}

export interface IOnigCaptureIndex {
	start: number;
	end: number;
	length: number;
}

export interface IOnigMatch {
    index: number;
    captureIndices: IOnigCaptureIndex[];
    scanner: OnigScanner;
}

export interface OnigScanner {
	findNextMatchSync(string: string | OnigString, startPosition: number): IOnigMatch;
}

export interface OnigString {
	readonly content: string;
	readonly dispose?: () => void;
}

[SearchingDataOnly]

Deleted ...

[AngelV]

Note: I am actually the same member as JAAFAR but I lost the email I initially registered with so I had to register a second time under a new name.

Thanks for sharing this nice tutorial.

I am trying to adapt the basic code example shown in post#1 so that it works similar to the Implements VB keyword .

I have this Interface class (IMyInterface):

Option Explicit

Public Function AddTwoLongs(ByVal x As Long, ByVal y As Long) As Long
'
End Function

An then, in a Bas module I have this 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. The followng Test sub is supposed to create a new instance of IMyInterface and call its only public Method.

Sub Test()
    Dim x As IMyInterface
    
    Set x = CreateInstance
    MsgBox x.AddTwoLongs(2, 8)
End Sub

The above works for creating the new light weight instance of IMyInterface BUT crashes at the call of the AddTwoLongs Method.

Can someone explain the reason why the code crashes when it reaches AddTwoLongs ?

Regards.

[Schmidt]

The above works for creating the new light weight instance of IMyInterface BUT crashes at the call of the AddTwoLongs Method.

Can someone explain the reason why the code crashes when it reaches AddTwoLongs ?

This is a duplicate of the question, which was answered in the main-VB6-forum here:
https://www.vbforums.com/showthread....=1#post5570399

Olaf

[xiaoyao]

how to make Lightweight com with methodpen,close

like ,make ado class like cRecordset:

Dim RS As New cRecordset
        RS.OpenRecordset "select top 1 * from WxMyFenSi where FSuserid='13647' and FSBgFg=54 ", Cnn
        RS.open "select top 1 * from WxMyFenSi where FSuserid='13647' and FSBgFg=54 ", Cnn,1,3
      MsgBox RS.RecordCount

I want to completely replace ADO with cconnection and CRecordset objects.
I hope you can replace the data type of each variable without modifying the code.
For example, rs.Close is required after adding ADO, but CRecordset does not Close method.
Openf method of ADO recordset: rs.open SQL, CNN, 1,3
But CRecordset only needs rs.open SQL
If some interfaces can be masked in the virtual COM object, or two call parameters can be ignored, the four parameters can be forcibly changed to only one parameter.
Suppose I forge a new lightweight COM object:
dim Drs as dRecordset
In fact, DRS is equivalent to CRecordset, but the interface name is different.
Drs.open=cRecordset. OpenRecordset
Drs.close, in fact, is ignored directly, and crecordset Close (he does not have this interface)

[Arnoutdv]

Is there a specific reason for doing this?
I assumed light weight objects are particularly useful when adding thousands of them to a collection, not when having a single instance.

[SearchingDataOnly]

how to make Lightweight com with methodpen,close

like ,make ado class like cRecordset:

Dim RS As New cRecordset
        RS.OpenRecordset "select top 1 * from WxMyFenSi where FSuserid='13647' and FSBgFg=54 ", Cnn
        RS.open "select top 1 * from WxMyFenSi where FSuserid='13647' and FSBgFg=54 ", Cnn,1,3
      MsgBox RS.RecordCount

I want to completely replace ADO with cconnection and CRecordset objects.
I hope you can replace the data type of each variable without modifying the code.
For example, rs.Close is required after adding ADO, but CRecordset does not Close method.
Openf method of ADO recordset: rs.open SQL, CNN, 1,3
But CRecordset only needs rs.open SQL
If some interfaces can be masked in the virtual COM object, or two call parameters can be ignored, the four parameters can be forcibly changed to only one parameter.
Suppose I forge a new lightweight COM object:
dim Drs as dRecordset
In fact, DRS is equivalent to CRecordset, but the interface name is different.
Drs.open=cRecordset. OpenRecordset
Drs.close, in fact, is ignored directly, and crecordset Close (he does not have this interface)

MyRecordSet.cls

Option Explicit

Implements RC6.cRecordset

Private mRS As RC6.cRecordset

Public Sub Close_()
    Set mRS = Nothing
End Sub

...
...
...

[xiaoyao]

Note: I am actually the same member as JAAFAR but I lost the email I initially registered with so I had to register a second time under a new name.

Thanks for sharing this nice tutorial.

I am trying to adapt the basic code example shown in post#1 so that it works similar to the Implements VB keyword .

I have this Interface class (IMyInterface):

Option Explicit

Public Function AddTwoLongs(ByVal x As Long, ByVal y As Long) As Long
'
End Function

An then, in a Bas module I have this 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. The followng Test sub is supposed to create a new instance of IMyInterface and call its only public Method.

Sub Test()
    Dim x As IMyInterface
    
    Set x = CreateInstance
    MsgBox x.AddTwoLongs(2, 8)
End Sub

The above works for creating the new light weight instance of IMyInterface BUT crashes at the call of the AddTwoLongs Method.

Can someone explain the reason why the code crashes when it reaches AddTwoLongs ?

Regards.

it's run err

[Schmidt]

Please stop spamming discussion-threads, you did not read (or understand).

The problem of AngelV was addressed in post #13 already.

Olaf

[loquat]

i have tried to transport this code to twinbasic but x64 not work. a little difficult for me.

[Schmidt]

i have tried to transport this code to twinbasic but x64 not work. a little difficult for me.

Perhaps Wayne himself can help you with that?

I say this, because support for such a "COM-instance-subclassing" (that's what it basically is) -
would ideally sit at a lower level (e.g. where Wayne currently creates the COM-instances for TBs own Classes).

The "extended SubClassing-Events" as demonstrated here, could then be made available e.g.:
- parallel (in addition) to the already existing Class_Initialize/Class_Terminate-events in the TB-IDE

I'd consider such "Object-SubClassing-features" or the support for "Lightweight-" or "Weak-referenced" Objects
(which comes along with that) - a very useful addition to this heavily COM-based language,
when integrated at Compiler-Level (and exposed via additional Class_Events).

Olaf