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.

asked Aug 24, 2018 at 16:06
\$\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\$ Commented Aug 24, 2018 at 16:19
  • 1
    \$\begingroup\$ Credit should really go to Bruce McKinney, not me. His code, my memory. ;-) \$\endgroup\$ Commented 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\$ Commented Aug 24, 2018 at 16:22
  • 3
    \$\begingroup\$ @this that's answer material right there ;-) \$\endgroup\$ Commented 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\$ Commented 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

answered Apr 1, 2020 at 3:13
\$\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\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented 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
answered Aug 25, 2018 at 9:08
\$\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\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented Sep 1, 2018 at 3:47

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.