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

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:

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:

Any ideas on how I can get a reference count on the ADODB recordsets? Thanks in advance.

GSerg · Accepted Answer · 2020-10-13T08:53:52.997

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

wqw · Answer 2 · 2020-10-13T06:57:26.723

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

AHeyne · Answer 3 · 2022-08-22T10:24:24.230

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

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

3 Answers3