How can I get a reference count to an ADODB recordset object? - vb6

Question

I'm investigating a memory leak in some old VB6 code that seems to be related to recordset objects, so I'm trying to get the reference counts on the objects. I found some code online that will give a count of references to an object, and it works for a home-grown class. But when I try to apply it to ADODB recordset objects, the count is always 1492925242. I've tried this in the existing app and then in a dummy app - always comes back with the same number (unless there are no references, then it's 0).
Here's the code that gets the reference count:
Private Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal nbytes As Long)
Function objRefCnt(obj As IUnknown) As Long
If Not obj Is Nothing Then
RtlMoveMemory objRefCnt, ByVal ObjPtr(obj) + 4, 4
objRefCnt = objRefCnt - 2
Else
objRefCnt = 0
End If
End Function
Here's the code that calls it on ADODB recordsets:
Sub main()
Dim obj_1 As ADODB.Recordset
Dim obj_2 As ADODB.Recordset
Debug.Print objRefCnt(obj_1) ' 0
Set obj_1 = New ADODB.Recordset
Debug.Print objRefCnt(obj_1) ' 1
Set obj_2 = obj_1
Debug.Print objRefCnt(obj_1) ' 2
Debug.Print objRefCnt(obj_2) ' 2
Set obj_2 = New ADODB.Recordset
Debug.Print objRefCnt(obj_1) ' 1
Debug.Print objRefCnt(obj_2) ' 1
End Sub
This returns the following:
0
1492925242
1492925242
1492925242
1492925242
1492925242
But when I added a dummy class called Class1 that has a single property (an integer), and create obj_1 and obj_2 as Class1 objects, I get this:
0
1
2
2
1
1
Any ideas on how I can get a reference count on the ADODB recordsets?
Thanks in advance.

Answer 1

The code you found assumes the reference count is stored inside the object at offset 4. There is no such requirement. IUnknown defines methods, not where private variables must be stored (and the reference count is a private variable of an object).
The way to get the reference count (for testing purposes only) is to call IUnknown.Release.
In order to do that from VB6, find olelib.tlb on the Internet (Edanmo's OLE interfaces & functions), reference it, and have
Public Function GetRefCount(ByVal obj As olelib.IUnknown) As Long
obj.AddRef
GetRefCount = obj.Release - 2
End Function
Dim r1 As ADODB.Recordset
Dim r2 As ADODB.Recordset
Set r1 = New ADODB.Recordset
Set r2 = r1
MsgBox GetRefCount(r1) ' 2

Answer 2

It appears m_dwRefCount member variable of ADODB.Recordset instances is at offset 16.
Try this objRefCnt replacement:
Private Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal nbytes As Long)
Function RecordsetRefCnt(rs As Recordset) As Long
If Not rs Is Nothing Then
RtlMoveMemory RecordsetRefCnt, ByVal ObjPtr(rs) + 16, 4
RecordsetRefCnt = RecordsetRefCnt - 1
Else
RecordsetRefCnt = 0
End If
End Function
JFYI, here is a AddRef/Release based GetRefCount impl without additional typelibs
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
Public Function GetRefCount(pUnk As IUnknown) As Long
Const CC_STDCALL As Long = 4
Dim vResult As Variant
Call DispCallFunc(ObjPtr(pUnk), 1 * 4, CC_STDCALL, vbLong, 0, ByVal 0, ByVal 0, 0)
Call DispCallFunc(ObjPtr(pUnk), 2 * 4, CC_STDCALL, vbLong, 0, ByVal 0, ByVal 0, vResult)
GetRefCount = vResult - 2
End Function

Answer 3

And here is the AddRef/Release based GetRefCount implementation without additional typelibs which also works with 64-bit VBA:
#If VBA7 Then
Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal cc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, ByRef prgVt As Any, ByRef prgpVarg As Any, ByRef pvargResult As Variant) As Long
#Else
Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, ByRef prgVt As Any, ByRef prgpVarg As Any, ByRef pvargResult As Variant) As Long
#End If
Public Function GetRefCount(ByRef pUnk As IUnknown) As Long
Const CC_STDCALL As Long = 4
#If Win64 Then
Const PTR_SIZE As Long = 8
#Else
Const PTR_SIZE As Long = 4
#End If
If pUnk Is Nothing Then Exit Function
Dim vResult As Variant
Call DispCallFunc(ObjPtr(pUnk), 1 * PTR_SIZE, CC_STDCALL, vbLong, 0, ByVal 0, ByVal 0, 0)
Call DispCallFunc(ObjPtr(pUnk), 2 * PTR_SIZE, CC_STDCALL, vbLong, 0, ByVal 0, ByVal 0, vResult)
GetRefCount = vResult - 2
End Function