Lazy Object / Weak Reference

Sometimes a class needs to hold a reference to the object that “owns” it – i.e. the object that created it. When this happens, the owner object often needs to hold a reference to all the “child” objects it creates. If we say Class1 is the “parent” and Class2 is the “child”, we get something like this:

'Class1
Option Explicit
Private children As VBA.Collection

Public Sub Add(ByVal child As Class2)
    Set child.Owner = Me
    children.Add child
End Sub

Private Sub Class_Initialize()
    Set children = New VBA.Collection
End Sub

Private Sub Class_Terminate()
    Debug.Print TypeName(Me) & " is terminating"
End Sub

And Class2 might look like this:

'Class2
Option Explicit
Private parent As Class1

Public Property Get Owner() As Class1
    Set Owner = parent
End Property

Public Property Set Owner(ByVal value As Class1)
    Set parent = value
End Property

Private Sub Class_Terminate()
    Debug.Print TypeName(Me) & " is terminating"
End Sub

The problem might not be immediately apparent to untrained eyes, but this is a memory leak bug – this code produces no debug output, despite the Class_Terminate handlers:

'Module1
Option Explicit

Public Sub Test()
    Dim foo As Class1
    Set foo = New Class1
    foo.Add New Class2
    Set foo = Nothing
End Sub

Both objects remain in memory and outlive the Test procedure scope! Depending on what the code does, this could easily go from “accidental sloppy object management” to a serious bug leaving a ghost process running, with Task Manager being the only way to kill it! How do we fix this?

Not keeping a reference to Class1 in Class2 would fix it, but then Class2 might not be working properly. Surely there’s another way.

Suppose we abstract away the very notion of holding a reference to an object. Suppose we don’t hold an object reference anymore, instead we hold a Long integer that represents the address at which we’ll find the object pointer we’re referencing. To put it in simpler words, instead of holding the object itself, we hold a ticket that tells us where to go find it when we need to use it. We can do this in VBA.

First we define an interface that encapsulates the idea of an object reference – IWeakReference, that simply exposes an Object get-only property:

'@Description("Describes an object that holds the address of a pointer to another object.")
'@Interface
Option Explicit

'@Description("Gets the object at the held pointer address.")
Public Property Get Object() As Object
End Property

Then we implement it with a WeakReference class. The trick is to use CopyMemory from the Win32 API to take the bytes at a given address and copy them into an object reference we can use and return.

For an easy-to-use API, we give the class a default instance by toggling the VB_PredeclaredId attribute, and use a factory method to create and return an IWeakReference given any object reference: we take the object’s object pointer using the ObjPtr function, store/encapsulate that pointer address into a private instance field, and implement the IWeakReference.Object getter such that if anything goes wrong, we return Nothing instead of bubbling a run-time error.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "WeakReference"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Implements IWeakReference

#If Win64 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
#End If

Private Type TReference
#If VBA7 Then
    Address As LongPtr
#Else
    Address As Long
#End If
End Type

Private this As TReference

'@Description("Default instance factory method.")
Public Function Create(ByVal instance As Object) As IWeakReference
    With New WeakReference
        .Address = ObjPtr(instance)
        Set Create = .Self
    End With
End Function

Public Property Get Self() As IWeakReference
    Set Self = Me
End Property

#If VBA7 Then
Public Property Get Address() As LongPtr
#Else
Public Property Get Address() As Long
#End If
    Address = this.Address
End Property

#If VBA7 Then
Public Property Let Address(ByVal Value As LongPtr)
#Else
Public Property Let Address(ByVal Value As Long)
#End If
    this.Address = Value
End Property

Private Property Get IWeakReference_Object() As Object
' Based on Bruce McKinney's code for getting an Object from the object pointer:

#If VBA7 Then
    Dim pointerSize As LongPtr
#Else
    Dim pointerSize As Long
#End If

    On Error GoTo CleanFail
    pointerSize = LenB(this.Address)

    Dim obj As Object
    CopyMemory obj, this.Address, pointerSize

    Set IWeakReference_Object = obj
    CopyMemory obj, 0&, pointerSize

CleanExit:
    Exit Property

CleanFail:
    Set IWeakReference_Object = Nothing
    Resume CleanExit
End Property

Now Class2 can hold an indirect reference to Class1, like this:

'Class2
Option Explicit
Private parent As IWeakReference

Public Property Get Owner() As Class1
    Set Owner = parent.Object
End Property

Public Property Set Owner(ByVal Value As Class1)
    Set parent = WeakReference.Create(Value)
End Property

Private Sub Class_Terminate()
    Debug.Print TypeName(Me) & " is terminating"
End Sub

Now Module1.Test produces the expected output, and the memory leak is fixed:

Class1 is terminating
Class2 is terminating