4
\$\begingroup\$

Lightweight Objects implementation in VBA7 (32/64-bit)

As shownhere, VB* class instance deallocation becomes exponentially slower the more instances of a particular class module there are.Cristian Buse has done excellent work by overcoming the VB design and implemented a much faster deallocation in VBA for hisVBA-FastDictionary project.

Apart from their potentially slow deallocation, the memory footprint of COM objects is another important consideration.Each object instance consumes at least64 bytes (on 32-bit VB*) or120 bytes (on 64-bit VBA), in addition to the space required for its member variables and any static variables declared within its methods.This can waste a significant amount of heap memory, especially when the extra space required for member variables is small. Such objects are common in classes like tree nodes, linked list elements, or simple structures such as point coordinates. In practice, you may need hundreds of thousands of these objects in memory simultaneously.

Instead of class modules, VB* developers can useuser-defined types (UDTs) to mitigate these issues. However, UDTs come with their own limitations:

  • They cannot be directly stored in Variants, and therefore cannot be added toCollection orDictionary objects.
  • They do not encapsulate methods and properties like classes (i.e., no OOP support).
  • UDTs are value types, not reference types.

An alternative is the use oflightweight COM objects. Although the VB* language does not natively support them, it is possible to implement this technique by leveraging direct memory manipulation functions.


What are lightweight objects?

In the context of VB*, a lightweight object is a simple COM object that implements only the bare minimum: theIUnknown interface.

Advantages of lightweight objects

  • They can be used in many of the same scenarios as class module instances.
  • They can be assigned to Variant variables and added to VB*’sCollection andScripting.Dictionary objects.
  • They have a much smaller base memory footprint:8 bytes (on 32-bit VBA) or16 bytes (on 64-bit VBA). This makes them highly efficient when working with large numbers of small objects.
  • They don’t suffer from slow deallocation speeds.
  • Although they do not support events, it is possible to include construction and termination code (equivalent toInitialize andTerminate event procedures).

Drawbacks in VBA

  • They are not type-safe, as they only support theIUnknown interface.
  • They cannot be assigned to genericObject variables, since they are not derived fromIDispatch. Late-bound method access is therefore not possible.
  • They cannot implement interfaces or raise/receive events.
  • Accessing member variables and calling methods is slightly slower than with class modules.
  • Their syntax for calling methods and properties is somewhat unfamiliar.
  • If not used carefully they might crash your application.
  • Debugging support is limited.

Because of these limitations, lightweight objects are not a full replacement for class module instances. Nevertheless, they can be very useful in specific scenarios.


Declaring lightweight objects

The difference between a UDT and a lightweight COM object is minimal. A lightweight object is essentially a UDT whose first element points to anIUnknown-derived virtual function table. To transform the structure into a COM object, you must:

  1. Lay out an array of function pointers.
  2. Point the first element of the structure to the beginning of this function pointer array.Once the first element of the structure points to a validvtable, assigning the pointer to anIUnknown-type object variable effectively turns the structure into a VB*-usable COM object.

This may sound abstract, so let’s look at a concrete example: implementing of aQueue class that internally uses a linked list of lightweight node objects.


Example: Queue implementation

To begin, create a new VBA project in Excel (or any other VBA host). This approach works in all VB* versions, including VB6, but for testing I used VBA7 on 64-bit Excel.

First, declare a standard moduleLwListNodeFactory and add the following lines. Ensure that the reference toOLE Automation remains enabled in the VBA IDE.

Option ExplicitOption Private ModulePublic Type TLwListNodeMembers    Value As Variant    NextNode As IUnknown        ' LwListNodeEnd Type

This are the member variables of the lightweight node object to be used in our linked list.

Next we need a predeclared class moduleLwListNode. Please note we need the global instance i.e.Attribute VB_PredeclaredId = True. So, place the below code in aLwListNode.cls text file and then import that file:

VERSION 1.0 CLASSBEGIN  MultiUse = -1  'TrueENDAttribute VB_Name = "LwListNode"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False'@PredeclaredIdOption ExplicitFriend Function Create(Value As Variant) As IUnknown    Set Create = LwListNodeFactory.CreateNode(Value)End FunctionFriend Property Get Value(This As IUnknown) As Variant    Static ma As TLwListNodeMemberAccessor: Bind This, ma    With ma.ac(0)        If IsObject(.Value) Then Set Value = .Value Else Value = .Value    End With    ma.sa.pvData = NULL_PTREnd PropertyFriend Property Get NextNode(This As IUnknown) As IUnknown    Static ma As TLwListNodeMemberAccessor: Bind This, ma    Set NextNode = ma.ac(0).NextNode    ma.sa.pvData = NULL_PTREnd PropertyFriend Property Set NextNode(This As IUnknown, Node As IUnknown)    Static ma As TLwListNodeMemberAccessor: Bind This, ma    Set ma.ac(0).NextNode = Node    ma.sa.pvData = NULL_PTREnd Property

You may wonder why the member variables are not declared in theLwListNode class module, where they would normally belong. This is intentional: we do not want to create instances ofLwListNodes itself, but rather instances of our lightweight objects.

TheLwListNodes class is used only to declare the necessary methods and properties. Each method receives an injected instance of the lightweight object (parameterThis).

The default instance ofLwListNode is then used to call these methods and properties, while internally the injected members are accessed via a memory accessor array variable.

To make this work, we first need to import Cristian's brilliant moduleLibMemory, which contains the needed memory access and manipulation functions.

Then, add the following code lines to moduleLwListNodeFactory:

' Combines an array accessor ac(0) and its SafeArray Descriptor' to provide access to the members declared in TLwListNodeMembersPublic Type TLwListNodeMemberAccessor    ac() As TLwListNodeMembers    sa   As SAFEARRAY_1DEnd Type' Lightweight COM object layoutPrivate Type TLwListNode    pVTable  As LongPtr    refCount As Long#If Win64 Then    ' Due to aligning 64-bit VBA inserts 4 extra bytes here anyway    Reserved As Long#End If    Members  As TLwListNodeMembersEnd Type' The lightweight object instances will occupy only 8 (32-bit VB*)' or 16 Bytes (64-bit VBA) + space needed for their member variables#If Win64 Then    Private Const MEMBERS_OFFSET As LongLong = 16#Else    Private Const MEMBERS_OFFSET As Long = 8#End IfPrivate Declare PtrSafe Function CoTaskMemAlloc Lib "ole32" (ByVal cBytes As LongPtr) As LongPtrPrivate Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal pMem As LongPtr)' The 3 function pointers of the IUnknown InterfacePrivate Type TIUnknownVTable    QueryInterface As LongPtr    AddRef         As LongPtr    Release        As LongPtrEnd TypePrivate Type TPointerAccessor    dPtr() As LongPtr    sa As SAFEARRAY_1DEnd TypePrivate Type TModuleMembers    VTable As TIUnknownVTable   ' Preallocated (static, non-Heap) space for the VTable    pVTable As LongPtr          ' Pointer to the VTable    NullObject As TLwListNode   ' Contains zeroed member variables to release reference types on deallocationEnd TypePrivate m As TModuleMembersPublic Function CreateNode(Value As Variant) As IUnknown    ' Make sure we have a VTable    If m.pVTable = NULL_PTR Then        ' Initialize only, when not already done        InitVTable        m.pVTable = VarPtr(m.VTable)    End If                                   ' Initialize the (stack allocated) lightweight object structure    Dim newLw As TLwListNode    With newLw        .pVTable = m.pVTable        .refCount = 1        If IsObject(Value) Then Set .Members.Value = Value Else .Members.Value = Value    End With    ' Allocate heap memory for the lightweight object    Dim pMem As LongPtr: pMem = CoTaskMemAlloc(LenB(newLw))    If pMem = NULL_PTR Then Err.Raise 7 ' Out of memory    Dim pNewLw As LongPtr: pNewLw = VarPtr(newLw)    ' Copy the bytes of the initialized structure into the allocated memory    LibMemory.MemCopy pMem, pNewLw, LenB(newLw)    ' Fill the initialized structure with zeroes to prevent    ' VBA releasing internal reference types like strings, arrays    ' or objects when the structure goes out of scope.    LibMemory.MemFill pNewLw, LenB(newLw), 0    ' Create the lightweight object by assigning the memory pointer    ' into the function return value. The result is a COM object    ' of type IUnknown.    LibMemory.MemLongPtr(VarPtr(CreateNode)) = pMemEnd FunctionPrivate Sub InitVTable() ' This method will be called only once    m.VTable.QueryInterface = VBA.CLngPtr(AddressOf IUnknown_QueryInterface)    m.VTable.AddRef = VBA.CLngPtr(AddressOf IUnknown_AddRef)    m.VTable.Release = VBA.CLngPtr(AddressOf IUnknown_Release)End Sub' ----- IUnknown Implementation -----Private Function IUnknown_QueryInterface(This As TLwListNode, ByVal pReqIID As LongPtr, ByRef ppObj As LongPtr) As Long    Const E_NOINTERFACE As Long = &H80004002    ppObj = NULL_PTR    IUnknown_QueryInterface = E_NOINTERFACEEnd FunctionPrivate Function IUnknown_AddRef(This As TLwListNode) As Long    This.refCount = This.refCount + 1    IUnknown_AddRef = This.refCountEnd FunctionPrivate Function IUnknown_Release(This As TLwListNode) As Long    This.refCount = This.refCount - 1    IUnknown_Release = This.refCount    If This.refCount = 0 Then        ' Release reference types in This.Members        This = m.NullObject                CoTaskMemFree VarPtr(This)    End IfEnd Function

This code is essentially all that’s required to create a lightweight node object and implement theIUnknown interface. The comments should provide enough guidance to make the implementation clear.

To enable efficient access to the injected member variables of the lightweight object within the methods and properties of theLwListNode class module, a bit more code is needed. Add the following lines to the existingLwListNodeFactory module:

' Bind the member accessor struct to the lightweight object instancePublic Sub Bind(This As IUnknown, ByRef ma As TLwListNodeMemberAccessor)    If This Is Nothing Then Err.Raise 91    ' object variable not set    Static dPtr() As LongPtr: Static sa As SAFEARRAY_1D    If sa.cDims = 0 Then InitTypeAccessor LibMemory.VarPtrArr(dPtr), sa    If ma.sa.cDims = 0 Then InitMemberAccessor ma    ' Get the pointer to the member variables of the lightweight object    sa.pvData = VarPtr(This)    ma.sa.pvData = dPtr(0) + MEMBERS_OFFSET    sa.pvData = NULL_PTREnd Sub' Initialize the member accessor by binding an dynamic array accessor' variable to our own SafeArray struct, which gives us the ability to' access any given memory address as a TLwListNodeMembers struct.Private Sub InitMemberAccessor(ByRef ma As TLwListNodeMemberAccessor)    Const FADF_AUTO      As Integer = &H1    Const FADF_FIXEDSIZE As Integer = &H10    With ma.sa        .cDims = 1        .fFeatures = FADF_AUTO Or FADF_FIXEDSIZE        .cLocks = 1        .rgsabound0.cElements = 1    End With    LibMemory.MemLongPtr(VarPtr(ma)) = VarPtr(ma.sa)End Sub' Helper functions which belong into their own module (should be part of LibMemory)Public Sub InitTypeAccessor(ByVal accVarPtrArr As LongPtr, ByRef sa As SAFEARRAY_1D)    Static pa(0) As TPointerAccessor    With pa(0)        If .sa.cDims = 0 Then InitPointerAccessor pa        .sa.pvData = accVarPtrArr        .dPtr(0) = VarPtr(sa)        .sa.pvData = NULL_PTR    End With    sa = InitSafeArray()End SubPrivate Sub InitPointerAccessor(ByRef pa() As TPointerAccessor)    pa(0).sa = InitSafeArray(PTR_SIZE)    WritePtrNatively pa, VarPtr(pa(0).sa) ' https://github.com/WNKLER/RefTypesEnd Sub' LONG_PTR is not an object, but is a typelib definition of VBA7 itself!' See also https://github.com/WNKLER/RefTypes/discussions/3Private Sub WritePtrNatively(ByRef ptrs() As LONG_PTR, ByVal ptr As LongPtr)    ptrs(0) = ptrEnd SubPrivate Function InitSafeArray(Optional ByVal cbElements As Long) As SAFEARRAY_1D    Const FADF_AUTO As Long = &H1    Const FADF_FIXEDSIZE As Long = &H10    Static mSA As SAFEARRAY_1D    If mSA.cDims = 0 Then        With mSA            .cDims = 1            .fFeatures = FADF_AUTO Or FADF_FIXEDSIZE            .cLocks = 1            .cbElements = cbElements            .rgsabound0.cElements = 1        End With    End If    InitSafeArray = mSAEnd Function

I won’t go into the details of this memory access technique, as it goes beyond the scope of this CodeReview question. If some parts aren’t immediately clear, feel free to simply skip over them.

What is missing? TheQueue class, which utilizes the lightweight node objects in a linked list.Add a new class moduleQueue and insert the follwing lines:

' Queue class implemented with a linked list of lightweight object nodesOption ExplicitPrivate Type TClassMembers    Count     As Long    FirstNode As IUnknown    LastNode  As IUnknownEnd TypePrivate m As TClassMembers' Get the number of elements in the queuePublic Property Get Count() As Long    Count = m.CountEnd Property' Indicate whether the queue is emptyPublic Property Get IsEmpty() As Boolean    IsEmpty = (m.Count = 0)End Property' Add an element to the queuePublic Sub Enqueue(Value As Variant)    Dim newNode As IUnknown    Set newNode = LwListNode.Create(Value)    m.Count = m.Count + 1        If m.FirstNode Is Nothing Then        Set m.FirstNode = newNode        Set m.LastNode = newNode    Else        Set LwListNode.NextNode(m.LastNode) = newNode        Set m.LastNode = newNode    End IfEnd Sub' Return the first element from the queue without removingPublic Function Peek() As Variant    If m.Count = 0 Then Exit Function   ' return Empty    AssignVar Peek, LwListNode.Value(m.FirstNode)End Function' Remove and return the first element from the queuePublic Function Dequeue() As Variant    If m.Count = 0 Then Exit Function   ' return Empty    AssignVar Dequeue, LwListNode.Value(m.FirstNode)    Set m.FirstNode = LwListNode.NextNode(m.FirstNode)    m.Count = m.Count - 1End Function' Return an array of Variant containing all elements of the queuePublic Function ToArray() As Variant()    If m.Count = 0 Then ToArray = Array(): Exit Function        Dim Values() As Variant    ReDim Values(m.Count - 1)    Dim i As Long    Dim currentNode As IUnknown    Set currentNode = m.FirstNode    Do While Not currentNode Is Nothing        AssignVar Values(i), LwListNode.Value(currentNode)        i = i + 1        Set currentNode = LwListNode.NextNode(currentNode)    Loop    ToArray = ValuesEnd Function' Clear the queuePublic Sub Clear()    Dim currentNode As IUnknown, tmpNode As IUnknown    Set currentNode = m.FirstNode    Set m.FirstNode = Nothing    Do While Not currentNode Is Nothing        Set tmpNode = LwListNode.NextNode(currentNode)        Set LwListNode.NextNode(currentNode) = Nothing        Set currentNode = tmpNode    Loop    Set m.LastNode = Nothing    m.Count = 0End SubPrivate Sub Class_Terminate()    ' Important to clear up lightweight object references in the correct order, otherwise VB* might crash    Me.ClearEnd SubPrivate Sub AssignVar(ByRef Dest As Variant, Source As Variant)    If IsObject(Source) Then Set Dest = Source Else Dest = SourceEnd Sub

You may notice that the methods of theLwListNode class are invoked in an unusal way. Instead of writingcurrentNode.Value, the call takes the formLwListNode.Value(currentNode).

As explained earlier, the lightweight object instancecurrentNode is injected into theValue property and executed against the default instance of theLwListNode class.In this setup, the default instance acts as a placeholder, since a direct call likecurrentNode.Value would not work. This is becausecurrentNode is of typeIUnknown, which does not permit direct access to any of our methods and properties.

With that clarified, it’s time to test the newQueue class. Add the following code to a new standard module namedTest and runTestQueue:

Option ExplicitSub TestQueue()    Dim q As Queue    Set q = New Queue        q.Enqueue 10    q.Enqueue 20    q.Enqueue 30    q.Enqueue 40    Debug.Print q.Dequeue() ' 10    Debug.Print q.Count     ' 3    Debug.Print q.Peek()    ' 20        Debug.Print Join(q.ToArray(), ", ")  ' output: 20, 30, 40End Sub

Why go through this complexity?

Why bother with this approach instead of simply declaring aListNode class module and using VB* in the way it was designed?Because lightweight node objects arethree times more memory-efficient, and their deallocation speed is only a fraction of the time required for class module instances.


Performance comparison

In my tests, I compared creating aQueue with 200,000 elements:

  • Using the lightweightQueue class: ~1 second to create and deallocate.
  • Using a corresponding class module: ~11 seconds.

With 1 million elements, the difference was even more striking:

  • Lightweight objects: ~5 seconds.
  • Class module: 345 seconds.

Unexpected behaviour

Certain object-related functions in VB* behave in unexpected ways when used on lightweight objects. To demonstrate this, add the following code to theTest module:

Sub TestLwListNode()    Dim node As IUnknown    Set node = LwListNode.Create("Test")    Debug.Print LwListNode.Value(node)                  ' prints "Test"'    Debug.Print "TypeName(node): " & TypeName(node)     ' runtime error 13 (type mismatch)'    Debug.Print "VarType(node) : " & VarType(node)      ' runtime error 13 (type mismatch)'    Debug.Print "IsObject(node): " & IsObject(node)     ' runtime error 13 (type mismatch)    Debug.Print "node is " & IIf(node Is Nothing, "Nothing", "not Nothing")    Debug.Print "ObjPtr(node)  : " & ObjPtr(node)    Debug.Print TypeOf node Is IUnknown                 ' prints False, although should be True        Dim node2 As IUnknown    Set node2 = node    Debug.Print node2 Is node                           ' prints False, although should be True    Debug.Print "ObjPtr(node2) = ObjPtr(node): " & (ObjPtr(node2) = ObjPtr(node))   ' prints True        Dim obj As Object'    Set obj = node                                      ' runtime error 13 (type mismatch)    Dim v As Variant    Set v = node                                        ' works    Debug.Print "TypeName(v)   : " & TypeName(v)        ' "Unknown"    Debug.Print "VarType(v)    : " & VarType(v)         ' "13" (vbDataObject)        Dim col As Collection    Set col = New Collection'    col.Add node                                        ' runtime error 13 (type mismatch)'    col.Add CVar(node)                                  ' crashes host application!!    col.Add v                                           ' works    Debug.Print col.Count        AcceptIUnknownParameterByRef node                   ' prints "AcceptIUnknownParameterByRef: Test"    AcceptIUnknownParameterByVal node                   ' prints "AcceptIUnknownParameterByVal: Test"End Sub

Conclusion

My question is: Can this approach be improved, especially in terms of the unexpected behaviour, which is probably related toIUnknown_QueryInterface() in moduleLwListNodeFactory returning an error number?

Any other feedback or suggestions are welcome.

askedOct 19 at 15:35
MDragon's user avatar
\$\endgroup\$
1
  • 1
    \$\begingroup\$Have been studying this for the last week and, by far, the biggest issue is the memory leak when state is lost. I could not find a reliable way to deallocate memory, without resorting to custom assembly. Custom asm works but would be difficult to tailor for new use cases, especially when it comes to deallocating sub-references: strings, arays and objects contained in the main UDT e.g.TLwListNodeMembers.NextNode. Might revisit this in a few weeks, if time allows, but for now thanks again for sharing this.\$\endgroup\$CommentedOct 27 at 11:00

1 Answer1

5
\$\begingroup\$

Thanks for the shoutout!

The idea of lightweight objects is interesting and I remember seeing some cool projects over at VBForums related to it. Well done for making this work nicely in VBA.

I think this particularQueue class example works beautifully but it's not the best use case. By no means my below suggestion is trying to minimize the nice work you've done here but all I am saying is that we probably need a better real-world use scenario for this concept.

I would suggest a simpleCollection wrapper which achieves the exact same thing, because of the following:

  1. Since the nodes themselves are not going to be used directly, they don't really need to be a class (lightweight or not), nor UDT
  2. The deallocation speed issues will still apply to theQueue itself
  3. The built-inCollection already is a linked-list and we can wrap it
Option ExplicitPrivate m As New Collection' Get the number of elements in the queuePublic Property Get Count() As Long    Count = m.CountEnd Property' Indicate whether the queue is emptyPublic Property Get IsEmpty() As Boolean    IsEmpty = (m.Count = 0)End Property' Add an element to the queuePublic Sub Enqueue(ByRef Value As Variant)    m.Add ValueEnd Sub' Return the first element from the queue without removingPublic Function Peek() As Variant    If m.Count = 0 Then Exit Function   ' return Empty    AssignVar Peek, m.Item(1)End Function' Remove and return the first element from the queuePublic Function Dequeue() As Variant    If m.Count = 0 Then Exit Function   ' return Empty    AssignVar Dequeue, m.Item(1)    m.Remove 1End Function' Return an array of Variant containing all elements of the queuePublic Function ToArray() As Variant()    If m.Count = 0 Then ToArray = Array(): Exit Function        Dim Values() As Variant    ReDim Values(0 To m.Count - 1)    Dim i As Long    Dim v As Variant        For Each v In m        If IsObject(v) Then Set Values(i) = v Else Values(i) = v        i = i + 1    Next v    ToArray = ValuesEnd Function' Clear the queuePublic Sub Clear()    Set m = NothingEnd SubPrivate Sub AssignVar(ByRef Dest As Variant, ByRef Source As Variant)    If IsObject(Source) Then Set Dest = Source Else Dest = SourceEnd Sub
answeredOct 20 at 12:01
Cristian Buse's user avatar
\$\endgroup\$
3
  • \$\begingroup\$Thanks for your answer! I agree that in a real-world project I wouldn’t use lightweight objects to implement a Queue class, since VB*’s Collection object is far better suited for that purpose. I only used the Queue class as a simple example to illustrate the concept of lightweight objects. In practice, your Collection-based implementation is certainly the better choice for building a queue.\$\endgroup\$CommentedOct 20 at 13:29
  • \$\begingroup\$My main point, however, is that the lightweight object concept becomes valuable in scenarios where a very large number of relatively small object instances is required. For example, I’ve implemented a GeoLocation class to represent a geographic point. It contains only 2 member variables (Latitude and Longitude), along with a few properties/methods. This type of class is a much more suitable candidate for a lightweight implementation. Imagine a VBA Collection holding a million GeoLocation objects—using standard class module objects as Collection items could become problematic in such a case.\$\endgroup\$CommentedOct 20 at 13:32
  • 1
    \$\begingroup\$Completely agree. I immediately see the value in having a smaller memory footprint and avoiding the deallocation speed issue. Will return with a second answer when I get more time later in the week - I think we can drastically improve on the 5 seconds for 1m objects.\$\endgroup\$CommentedOct 20 at 14:00

You mustlog in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.