Using Lightweight Objects in VBA

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

As shown here, 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 his VBA-FastDictionary project.

Apart from their potentially slow deallocation, the memory footprint of COM objects is another important consideration. Each object instance consumes at least 64 bytes (on 32-bit VB*) or 120 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 use user-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 to Collection or Dictionary 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 of lightweight 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: the IUnknown 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*’s Collection and Scripting.Dictionary objects.
• They have a much smaller base memory footprint: 8 bytes (on 32-bit VBA) or 16 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 to Initialize and Terminate event procedures).

Drawbacks in VBA

• They are not type-safe, as they only support the IUnknown interface.
• They cannot be assigned to generic Object variables, since they are not derived from IDispatch. 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 an IUnknown-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 valid vtable, assigning the pointer to an IUnknown-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 a Queue 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 module LwListNodeFactory and add the following lines. Ensure that the reference to OLE Automation remains enabled in the VBA IDE.

Option Explicit
Option Private Module

Public Type TLwListNodeMembers
    Value As Variant
    NextNode As IUnknown        ' LwListNode
End Type

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

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "LwListNode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'@PredeclaredId
Option Explicit

Friend Function Create(Value As Variant) As IUnknown
    Set Create = LwListNodeFactory.CreateNode(Value)
End Function

Friend 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_PTR
End Property

Friend 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_PTR
End Property
Friend 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_PTR
End Property

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

The LwListNodes class is used only to declare the necessary methods and properties. Each method receives an injected instance of the lightweight object (parameter This).

The default instance of LwListNode 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 module LibMemory, which contains the needed memory access and manipulation functions.

Then, add the following code lines to module LwListNodeFactory:

' Combines an array accessor ac(0) and its SafeArray Descriptor
' to provide access to the members declared in TLwListNodeMembers
Public Type TLwListNodeMemberAccessor
    ac() As TLwListNodeMembers
    sa   As SAFEARRAY_1D
End Type

' Lightweight COM object layout
Private 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 TLwListNodeMembers
End 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 If

Private Declare PtrSafe Function CoTaskMemAlloc Lib "ole32" (ByVal cBytes As LongPtr) As LongPtr
Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal pMem As LongPtr)

' The 3 function pointers of the IUnknown Interface
Private Type TIUnknownVTable
    QueryInterface As LongPtr
    AddRef         As LongPtr
    Release        As LongPtr
End Type

Private Type TPointerAccessor
    dPtr() As LongPtr
    sa As SAFEARRAY_1D
End Type

Private 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 deallocation
End Type

Private m As TModuleMembers

Public 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)) = pMem
End Function

Private 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_NOINTERFACE
End Function

Private Function IUnknown_AddRef(This As TLwListNode) As Long
    This.refCount = This.refCount + 1
    IUnknown_AddRef = This.refCount
End Function

Private 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 If
End Function

This code is essentially all that’s required to create a lightweight node object and implement the IUnknown 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 the LwListNode class module, a bit more code is needed. Add the following lines to the existing LwListNodeFactory module:

' Bind the member accessor struct to the lightweight object instance
Public 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_PTR
End 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 Sub

Private Sub InitPointerAccessor(ByRef pa() As TPointerAccessor)
    pa(0).sa = InitSafeArray(PTR_SIZE)
    WritePtrNatively pa, VarPtr(pa(0).sa) ' https://github.com/WNKLER/RefTypes
End Sub

' LONG_PTR is not an object, but is a typelib definition of VBA7 itself!
' See also https://github.com/WNKLER/RefTypes/discussions/3
Private Sub WritePtrNatively(ByRef ptrs() As LONG_PTR, ByVal ptr As LongPtr)
    ptrs(0) = ptr
End Sub

Private 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 = mSA
End 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? The Queue class, which utilizes the lightweight node objects in a linked list. Add a new class module Queue and insert the follwing lines:

' Queue class implemented with a linked list of lightweight object nodes

Option Explicit

Private Type TClassMembers
    Count     As Long
    FirstNode As IUnknown
    LastNode  As IUnknown
End Type

Private m As TClassMembers

' Get the number of elements in the queue
Public Property Get Count() As Long
    Count = m.Count
End Property

' Indicate whether the queue is empty
Public Property Get IsEmpty() As Boolean
    IsEmpty = (m.Count = 0)
End Property

' Add an element to the queue
Public 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 If
End Sub

' Return the first element from the queue without removing
Public 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 queue
Public 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 - 1
End Function

' Return an array of Variant containing all elements of the queue
Public 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 = Values
End Function

' Clear the queue
Public 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 = 0
End Sub

Private Sub Class_Terminate()
    ' Important to clear up lightweight object references in the correct order, otherwise VB* might crash
    Me.Clear
End Sub

Private Sub AssignVar(ByRef Dest As Variant, Source As Variant)
    If IsObject(Source) Then Set Dest = Source Else Dest = Source
End Sub

You may notice that the methods of the LwListNode class are invoked in an unusal way. Instead of writing currentNode.Value, the call takes the form LwListNode.Value(currentNode).

As explained earlier, the lightweight object instance currentNode is injected into the Value property and executed against the default instance of the LwListNode class. In this setup, the default instance acts as a placeholder, since a direct call like currentNode.Value would not work. This is because currentNode is of type IUnknown, which does not permit direct access to any of our methods and properties.

With that clarified, it’s time to test the new Queue class. Add the following code to a new standard module named Test and run TestQueue:

Option Explicit

Sub 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, 40
End Sub

Why go through this complexity?

Why bother with this approach instead of simply declaring a ListNode class module and using VB* in the way it was designed? Because lightweight node objects are three 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 a Queue with 200,000 elements:

• Using the lightweight Queue 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 the Test 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 to IUnknown_QueryInterface() in module LwListNodeFactory returning an error number?

Any other feedback or suggestions are welcome.