Counting the number of instances of a class module in VB*

In VBForums I found the following post: Is there a way of retrieving the number of instances of a VB* class from within the class itself?

One could store an instance counter in a Public variable in a standard module, like shown here:

Option Explicit Option Private Module Public Class1InstanceCount As Long 

The class module (name it Class1) would look like

Option Explicit Private Sub Class_Initialize() Class1InstanceCount = Class1InstanceCount + 1 Debug.Print "Initialized. InstanceCount = " & Class1InstanceCount End Sub Private Sub Class_Terminate() Class1InstanceCount = Class1InstanceCount - 1 Debug.Print "Terminated. InstanceCount = " & Class1InstanceCount End Sub Public Property Get InstanceCount() As Long InstanceCount = Class1InstanceCount End Function 

To test this simple approach, you can use the following procedure in a standard module:

Public Sub TestClass1() Dim instance(1 To 3) As Class1 Debug.Print "Creating 3 new instances:" Dim i As Long For i = LBound(instance) To UBound(instance) Set instance(i) = New Class1 Next i Debug.Print "Set instance(1) = Nothing:" Set instance(1) = Nothing Debug.Print "instance(2) and instance(3) are getting out of scope:" End Sub 

The output in the Debug window:

Creating 3 new instances: Initialized. InstanceCount = 1 Initialized. InstanceCount = 2 Initialized. InstanceCount = 3 Set instance(1) = Nothing: Terminated. InstanceCount = 2 instance(2) and instance(3) are getting out of scope: Terminated. InstanceCount = 1 Terminated. InstanceCount = 0 

This works, but there seems to be no obvious way to integrate the instance counter into the class module itself, nicely encapsulated, without a dependency to another module.

Solution

In VB* it's possible to generate a global default instance of a class, using the Attribute VB_PredeclaredId = True. The idea is to use this global default instance to store the instance counter as a member variable, and to increase/decrease this counter on object creation/termination like in the simple example above.

Place the below code in a SelfCountingClass.cls text file and then import that file:

VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "SelfCountingClass" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '@PredeclaredID Option Explicit Const APP_NAME As String = "MyAppName" Const SECTION As String = "SelfCountingClass" Const KEY As String = "InstanceCount" Const IC_CAPTION As String = "InstanceCount = " Private Type TClassMembers InstanceCount As Long ID As Long ' Only used for debug output, but could be any other member variable End Type Private m As TClassMembers Public Function InstanceCount() As Long InstanceCount = SelfCountingClass.AddInstance() End Function Private Sub Class_Initialize() If Me Is SelfCountingClass Then ' for default instance ReadInstanceCount m.InstanceCount = m.InstanceCount + 1 Else ' for all other instances SelfCountingClass.AddInstance 1 m.ID = InstanceCount() End If Debug.Print InstanceName() & " initialized. ", , _ IC_CAPTION & SelfCountingClass.InstanceCount() End Sub Private Sub Class_Terminate() Dim InstCount As Long If m.InstanceCount Then ' for default instance InstCount = m.InstanceCount - 1 SaveInstanceCount InstCount Else ' for all other instances InstCount = SelfCountingClass.AddInstance(-1) End If Debug.Print InstanceName() & " terminated. ", , _ IC_CAPTION & InstCount End Sub Friend Function AddInstance(Optional ByVal Value As Long) As Long If Value Then m.InstanceCount = m.InstanceCount + Value AddInstance = m.InstanceCount End Function Private Sub SaveInstanceCount(ByVal InstCount As Long) SaveSetting APP_NAME, SECTION, KEY, CStr(InstCount) End Sub Private Sub ReadInstanceCount() Dim savedCount As String savedCount = GetSetting(APP_NAME, SECTION, KEY) If Len(savedCount) Then m.InstanceCount = CLng(savedCount) DeleteSetting APP_NAME End If End Sub Private Function InstanceName() As String Select Case m.ID Case 0: InstanceName = "Default Instance" Case Else: InstanceName = "instance(" & m.ID - 1 & ")" End Select End Function 

The code above might look a bit bloated compared to the first example Class1, but the additional procedures SaveInstanceCount and ReadInstanceCount exist only to make sure, destroying the default instance in code with

Set SelfCountingClass = Nothing 

has no negative effect on the instance counting mechanism, by saving the instance counter value in the Registry and restoring it after the default instance gets recreated automatically on next use.

Function InstanceName is only a small helper for the output in the Debug console, used by the Debug.Print commands.

To test the above solution, use the following procedure in a standard module:

Public Sub TestSelfCountingClass() Dim instance(1 To 3) As SelfCountingClass Debug.Print "Creating 3 new instances:" Dim i As Long For i = LBound(instance) To UBound(instance) Set instance(i) = New SelfCountingClass Next i ' Debug.Print "Set SelfCountingClass = Nothing:" ' Set SelfCountingClass = Nothing Debug.Print "Set instance(1) = Nothing:" Set instance(1) = Nothing ' Debug.Print "Set SelfCountingClass = Nothing:" ' Set SelfCountingClass = Nothing Debug.Print "instance(2) and instance(3) are getting out of scope:" End Sub 

After the first run of TestSelfCountingClass, the output should look like

Creating 3 new instances: Default Instance initialized. InstanceCount = 1 instance(1) initialized. InstanceCount = 2 instance(2) initialized. InstanceCount = 3 instance(3) initialized. InstanceCount = 4 Set instance(1) = Nothing: instance(1) terminated. InstanceCount = 3 instance(2) and instance(3) are getting out of scope: instance(2) terminated. InstanceCount = 2 instance(3) terminated. InstanceCount = 1 

Run TestSelfCountingClass again and compare the output:

Creating 3 new instances: instance(1) initialized. InstanceCount = 2 instance(2) initialized. InstanceCount = 3 instance(3) initialized. InstanceCount = 4 Set instance(1) = Nothing: instance(1) terminated. InstanceCount = 3 instance(2) and instance(3) are getting out of scope: instance(2) terminated. InstanceCount = 2 instance(3) terminated. InstanceCount = 1 

The global default instance doesn't get re-created as it already exists.

Now uncomment the commented lines in TestSelfCountingClass and run the procedure again. Output will change to:

Creating 3 new instances: instance(1) initialized. InstanceCount = 2 instance(2) initialized. InstanceCount = 3 instance(3) initialized. InstanceCount = 4 Set SelfCountingClass = Nothing: Default Instance terminated. InstanceCount = 3 Set instance(1) = Nothing: Default Instance initialized. InstanceCount = 4 instance(1) terminated. InstanceCount = 3 Set SelfCountingClass = Nothing: Default Instance terminated. InstanceCount = 2 instance(2) and instance(3) are getting out of scope: Default Instance initialized. InstanceCount = 3 instance(2) terminated. InstanceCount = 2 instance(3) terminated. InstanceCount = 1 

Although the default instance has been destroyed 2 times, the automatic resurrection has recovered the lost instance counter which has been temporarily saved in the Registry. The instance counter still shows the correct number of instances.

Disadvantage of the above solution

Apart from minimal performance loss on creating/terminating objects of the SelfCountingClass, the member variable m.InstanceCount is stored in every instance of this class, not only in the default instance. While the value of m.InstanceCount shows the current number of instances in the default instance, it's set to 0 in all other instances.

Question

Can this approach be improved?

Any other feedback or suggestions are welcome.