VB and VBA Users Source Code: Returning the reference count on an object
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Returning the reference count on an object
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, September 19, 2001
Hits:
802
Category:
Windows API
Article:
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 'Author : Andrew Baker 'Date : 19/Sep/2001 15:50 '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 'Revisions : 'Assumptions : 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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
