Visual Basic Programming Code Examples

Visual Basic > API and Miscellaneous Code Examples

Returning the reference count on an object

Returning the reference count on an object

Since VB is a COM based language all objects created in it will be a COM object. However, objects are relatively new to most VB programmers and as a result they have a habit of doing silly things with objects, like making circular references and not explicitly breaking them before unloading. This means VB my GPF during unloading or leak memory. The following routine lets you clearly identify how many references your object has to it and as such is a starting point on that long road to unravelling the mess you have created for yourself!

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal nbytes As Long)


'Purpose     :  Returns the refence count for any VB created object (COM objects)
'Inputs      :  oObject                     The object to return the reference count on.
'Outputs     :  Returns the refence count or -1 on error
'Notes       :  Generally useful when debugging unloaded of class objects.
'               Forms will always start with at least 6 references as they are loaded
'               into the global name space and the Me keyword


Function ObjectReferenceCount(oObject As IUnknown) As Long
    On Error GoTo ErrFailed
    If (oObject Is Nothing) = False Then
        'Reference count is offset 4 bytes from object pointer
        'and is 4 bytes wide (a long)
        CopyMemory ObjectReferenceCount, ByVal (ObjPtr(oObject)) + 4, 4
        ObjectReferenceCount = ObjectReferenceCount - 2
    Else
        ObjectReferenceCount = 0
    End If
    
    If Err.LastDllError Then
        'Error calling DLL
        ObjectReferenceCount = -1
        Err.Clear
    End If
    
    Exit Function

ErrFailed:
    Debug.Print "Error in ObjectReferenceCount: " & Err.Description
    ObjectReferenceCount = -1
End Function


'Demonstration routine. Add a blank class called Class1 to a project and run the following
'code.

Sub Test()
    Dim oObject1 As Class1
    Dim oObject2 As Class1
    'Make a single reference to class
    Set oObject1 = New Class1
    Debug.Print ObjectReferenceCount(oObject1)
    'Make another reference to class
    Set oObject2 = oObject1
    Debug.Print ObjectReferenceCount(oObject1)
    'Release a reference to class
    Set oObject2 = Nothing
    Debug.Print ObjectReferenceCount(oObject1)
    'Release last reference to class
    Set oObject1 = Nothing
    Debug.Print ObjectReferenceCount(oObject1)
End Sub