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
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
'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
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
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
Module1.Test produces the expected output, and the memory leak is fixed:
Class1 is terminating
Class2 is terminating