12
\$\begingroup\$

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&, 4
End Property

Can this class be improved? Is the interface & 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.

\$\endgroup\$
13
  • 1
    \$\begingroup\$ @cHao VBA isn't garbage-collected, it's reference-counted. Circular references are also a problem in garbage-collected languages (AFAIK). \$\endgroup\$ Aug 24, 2018 at 16:19
  • 1
    \$\begingroup\$ Credit should really go to Bruce McKinney, not me. His code, my memory. ;-) \$\endgroup\$
    – Comintern
    Aug 24, 2018 at 16:21
  • 2
    \$\begingroup\$ 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. \$\endgroup\$
    – this
    Aug 24, 2018 at 16:22
  • 3
    \$\begingroup\$ @this that's answer material right there ;-) \$\endgroup\$ Aug 24, 2018 at 16:22
  • 1
    \$\begingroup\$ @MathieuGuindon: Circular references are more a problem in reference-counted scenarios. Any decent GC will handle them easily, but can only clean them up once both objects are unreachable. \$\endgroup\$
    – cHao
    Aug 24, 2018 at 16:27

2 Answers 2

5
\$\begingroup\$

Amazing code as always, Mathieu and Comintern; many thanks.

I'm here only to 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&, 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

\$\endgroup\$
5
  • \$\begingroup\$ This works, but not for the reasons you think it does. #If Win64 checks whether the host application is 64-bit, true. However LongPtr automatically maps to LongLong on a 64-bit VBA instance anyway, so there is no need to check manually. You could remove the conditional compilation entirely! The only thing you might want to do to ensure robustness is to replace Win64 with VBA7 - LongPtr and PtrSafe weren't defined pre-VBA7 so you need to use long as you have done (don't worry about LongLong - there are no pre-VBA7 64-bit hosts so Long will always be big enough for the pointer) \$\endgroup\$
    – Greedo
    Apr 2, 2020 at 8:32
  • \$\begingroup\$ *"remove the conditional compilation entirely" and just use LongPtr for all the pointers, so get rid of your declarations that use plain Long. Incidentally, cbCopy does not need to be declared as LongPtr even in a 64-bit environment since it is not a pointer but a count of bytes to copy, and that count is a Long on 32 and 64 bit machines. Both will work because of the way memory is layed out - it's generally ok to pass a wider integer to an API function (LongLong instead of Long) because the function will just read only lower bytes. But not always and it's a bad habit IMO \$\endgroup\$
    – Greedo
    Apr 2, 2020 at 8:45
  • 1
    \$\begingroup\$ @Greedo: Thanks, I'll try that - but first I have to get again a 32 bits VBE to test; in few days I think I can have it, and I will update here. \$\endgroup\$ Apr 2, 2020 at 14:12
  • \$\begingroup\$ Sorry, just realised my last point is incorrect; cbCopy is declared as Size_T which is an alias for ULONG_PTR - and so we should use LongPtr to represent it in VBA code as you have done. I think I'll write a separate answer on this stuff \$\endgroup\$
    – Greedo
    Apr 4, 2020 at 11:11
  • \$\begingroup\$ @greedo, ok. I'm still on the process of clean off dust of my 10 yo 32 bits notebook to test it. \$\endgroup\$ Apr 4, 2020 at 15:58
3
\$\begingroup\$

Thank you, thank you, thank you!! I have been tortured by this very problem and never could figure out why.

I would simplify the factory by storing the Object pointer and making the IWeakReference_Object the default member of the class.

Returning a self reference is great for creating anonymous classes. But I think that it is overkill for this here because I can't think of a scenario where it would be used outside of the Create method. Basically, you are adding 3 lines of code to save one. That being said, If add it to one class I will usually added it to all my classes for consistency.

WeakReference:Class

Attribute VB_PredeclaredId = True
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

Public hValue As Long

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

Public Function Create(value As Object) As WeakReference
    Dim ref As New WeakReference
    ref.hValue = ObjPtr(value)
    Set Create = ref
End Function

TheChild:Class

Private ref As WeakReference

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

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

Private Sub Class_Terminate()
    Debug.Print TypeName(Me)
    Set ref = Nothing
End Sub

Alternate Approach

Here I just store the pointer handle (hwnd) of the objects and have a factory create weak referenced objects from the handles. The advantage of this approach is that you only need to import a single class into your project.

That being said, the Interface does seem like a more natural fit. If the VBA supported packages I would go with use the IWeakReference Interface.

ObjectFactory:Class

Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

#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

Function getObjectHwnd(Object As Object) As Long
    getObjectHwnd = ObjPtr(Object)
End Function

Function getObject(hwnd As Long) As Object
Attribute Value.VB_UserMemId = 0
' Bruce McKinney's code for getting an Object from the object pointer:
    Dim objT As Object
    CopyMemory objT, hwnd, 4
    Set getObject = objT
    CopyMemory objT, 0&, 4
End Function

Child:Class

Option Explicit

Private hParent As Long

Public Property Get Parent() As TheParent
    Set Parent = ObjectFactory.getObject(hParent)
End Property

Public Property Set Parent(ByVal value As TheParent)
    hParent = ObjectFactory.getObjectHwnd(value)
End Property

Private Sub Class_Terminate()
    Debug.Print TypeName(Me), Parent.Name
End Sub
\$\endgroup\$
8
  • \$\begingroup\$ The Self getter is never needed, indeed - I wouldn't call it overkill though: I do consistently use it in every single class that has a VB_PredeclaredId attribute set to True and that exposes a factory method - and every time, the only method that uses the Self getter is the factory method... It's becoming a habit to always write my Create methods with With New ClassName...Set Create = .Self...End With - besides it's never exposed on whatever interface the class implements, so... really just a "convenience" member to facilitate the With New syntax \$\endgroup\$ Aug 28, 2018 at 1:45
  • \$\begingroup\$ Not sure I like the "alternative approach" there though: it seems to defeat the purpose of the abstraction, by making the client code store a handle to the parent object, vs storing a reference to an IWeakReference instance. \$\endgroup\$ Aug 28, 2018 at 1:47
  • 1
    \$\begingroup\$ The use of IWeakReference in [Battleship MVC Architecture] (codereview.stackexchange.com/questions/202851/…) is really nice. Aesthetically, it is much nicer than storing the handles. I would still make Object the default member of the class. I just prefer Set ViewEvents = adapter over Set ViewEvents = adapter.Object. \$\endgroup\$
    – TinMan
    Sep 1, 2018 at 2:15
  • 1
    \$\begingroup\$ I guess it would be idiomatic, yeah. IMO default members are a language trap though: code isn't just written to be executed; it's mostly written to be read, and default members abstracts away the syntax rather than the idea. This can easily makes the reader miss what's going on... the code says one thing, and does another behind your back -- unless you know the API and you're familiar with it now.. If only there was a VBIDE add-in that could warn you about implicit member access! A good chunk of VBA questions on SO are asked because of them, and solved with explicit member access ;-) \$\endgroup\$ Sep 1, 2018 at 3:19
  • \$\begingroup\$ Default members if a Class can definitely by a trap. However, in the VBA, providing access to the default members is an intrinsic feature of an Interface. Seeing position as IGridCood for the first time, I would assume that it has X and Y members. I would also assume that I could use position.X. position.Object.X on the other hand not so much. \$\endgroup\$
    – TinMan
    Sep 1, 2018 at 3:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.