如何获取对ADODB记录集对象的引用计数

Question

我正在调查一些旧VB6代码中的内存泄漏，该代码似乎与记录集对象有关，因此我正在尝试获取对象的引用计数。我在网上找到了一些代码，这些代码会给出对对象的引用数，它适用于自制的类。但是，当我尝试将其应用于ADODB记录集对象时，计数总是1492925242。我在现有的应用程序中尝试过，然后在一个伪应用程序中也尝试过——总是返回相同的数字(除非没有引用，否则为0(。

以下是获得引用计数的代码：

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

以下是在ADODB记录集上调用它的代码：

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

这将返回以下内容：

0
1492925242 
1492925242 
1492925242 
1492925242 
1492925242

但是，当我添加了一个名为Class1的具有单个属性(整数(的伪类，并将obj_1和obj_2创建为Class1对象时，我得到了以下内容：

0 
1 
2 
2 
1 
1 

关于如何获得ADODB记录集的引用计数，有什么想法吗？提前谢谢。

Answer 1

您找到的代码假设引用计数存储在偏移量为4的对象内部。没有这样的要求。IUnknown定义方法，而不是必须存储私有变量的地方(引用计数是对象的私有变量(。

获取引用计数的方法(仅用于测试目的(是调用IUnknown.Release。

为了从VB6中做到这一点，在互联网上找到olelib.tlb(Edanmo的OLE接口和函数(，引用它，并使用

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

ADODB.Recordset实例的m_dwRefCount成员变量的偏移量为16。

尝试此objRefCnt替换：

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，这里是一个基于AddRef/Release的GetRefCountimpl，没有额外的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

这是一个基于AddRef/Release的GetRefCount实现，不需要额外的typelib，它也可以与64位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