Solution for Parent/Child circular references: WeakReference class Sometimes in advanced OOP scenarios, a class needs to hold instances of another class which needs to hold a reference to the "parent". For example when you have a dynamic UserForm control that needs to "call back" to the parent form that created it, or when you have a ViewAdapter that talks to some UI, which in turn needs to "call back" to the adapter.

Such relationships create circular references, and if nothing is done to solve this, the objects don't get cleaned up and you're looking at what's essentially a memory leak.

With the help of Comintern I've written a class that solves this problem, and called it WeakReference - in order to make the API as simple to use as possible, I wrapped it with an IWeakReference interface:

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

Public Property Get Object() As Object
End Property


Here's the WeakReference class:

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
    Address As Long
End Type

Private this As TReference

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

Public Property Get Address() As Long
    Address = this.Address
End Property

Public Property Let Address(ByVal value As Long)
    this.Address = value
End Property

Private Property Get IWeakReference_Object() As Object
    ' Bruce McKinney's code for getting an Object from the object pointer:
    Dim objT As Object
    CopyMemory objT, this.Address, 4
    Set IWeakReference_Object = objT
    CopyMemory objT, 0&amp;, 4
End Property


Can this class be improved? Is the interface &amp; factory method overkill?



Here's a simple example usage scenario:

Class: TheParent

Option Explicit

Private child As TheChild

Private Sub Class_Initialize()
    Set child = New TheChild
    Set child.Parent = Me
End Sub

Private Sub Class_Terminate()
    Set child = Nothing
End Sub


And the TheChild class:

Option Explicit

Private ref As IWeakReference

Public Property Get Parent() As TheParent
    Set Parent = ref.Object
End Property

Public Property Set Parent(ByVal value As TheParent)
    Set ref = WeakReference.Create(value)
End Property

Private Sub Class_Terminate()
    Stop ' expected break here when TheParent is terminated
    Set ref = Nothing
End Sub


And a little procedure to test everything:

Public Sub Test()
    Dim p As TheParent
    Set p = New TheParent
    Debug.Print ObjPtr(p)
    Set p = Nothing
End Sub


As expected, the Stop statement is hit in TheChild, and if you put a breakpoint in TheParent's Class_Terminate handler, it's also hit - whereas if you replace the IWeakReference with TheParent in TheChild, none of the two Class_Terminate handlers run.
Amazing code as always, Mathieu and Comintern; many thanks.

I'm here only two add two cents:

Probably you tested it in a 32 bits setup; to compile in a 64 bits you need to (only differences):

    #If Win64 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As LongPtr)
    Private Type TReference
        Address As LongPtr
    End Type
    #Else
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Private Type TReference
        Address As Long
    End Type
    #End If
         ...
    #If Win64 Then
    Public Property Get Address() As LongPtr
        Address = this.Address
    End Property
    Public Property Let Address(ByVal value As LongPtr)
        this.Address = value
    End Property
    #Else
    Public Property Get Address() As Long
        Address = this.Address
    End Property
    Public Property Let Address(ByVal value As Long)
        this.Address = value
    End Property
    #End If


And your test works:

Public Sub Test()
    Dim p As TheParent
    Set p = New TheParent
    Debug.Print ObjPtr(p)
    Set p = Nothing
End Sub


And now things seems to be OK. But...

Now, try to do something useful with Parent property of Child class, not only assure GC:

Slightly modified Parent Class; Child class the same:

 Option Explicit
Private Type tTheParent
    Child As TheChild
    CollectionName As String
End Type
Private this As tTheParent

Private Sub Class_Initialize()
    Set this.Child = New TheChild
    Set this.Child.Parent = Me
    Debug.Print this.Child.Parent.CollectionName
End Sub
Public Property Get GetChild() As TheChild
    Set GetChild = this.Child
End Property
Private Sub Class_Terminate()
    Set this.Child = Nothing
End Sub

Public Property Get CollectionName() As String
    CollectionName = IIf(this.CollectionName = vbNullString, "COLLECTION", this.CollectionName)
End Property


New Test:

 Public Sub TestChildParent()
    Dim p As TheParent
    Set p = New TheParent
    Dim c As TheChild
    Set c = p.GetChild
    Debug.Print c.Parent.CollectionName
    Debug.Print ObjPtr(p)

    Set p = Nothing
 End Sub


And what we get? I crashed Excel, Word and the Video driver!

And now the @this's comment shines; now I got illuminated by his (this?) words:


  Please don't hard-code the size... ever. LenB is to VBA what sizeof is
  to C. Use it to size the allocation for the copy memory API. – this


I was directed here because yesterday I posted at SO an error 53 getting kernel, and until I crash windows I didn't understood that the correct Bruce McKinney's code for getting an Object from the object pointer is:

Dim objT As Object
CopyMemory objT, this.Address, LenB(this.Address) 'not 4
Set IWeakReference_Object = objT
CopyMemory objT, 0&amp;, LenB(this.Address) 'not 4


And this answer my question at SO too, because the kernel 53 error gone...

PS: Please, don't be surprised at this enigmatic approach using this as Private Type
someone that I follow teached me ;)

PS2: And this, thanks for that! sorry, couldn't hold myself