Stavm
Stavm

Reputation: 8131

vb6 ADODB recordset size retrieval

Using ADODB - is there a function to retrieve the actual size of the result query ? (vb6)

I do not mean it's count i mean its actual size, I would like to know how much data was needed to be used through the network to retrieve my query result.

if no such thing exists I guess I can always take all the data retrieved, turn it to bytes, and start calculating, but i would like to avoid it if there's something already built in (which should be).

Thanks !

p.s Using an .mdb file , using adodb 2.0 library

Upvotes: 1

Views: 770

Answers (1)

wqw
wqw

Reputation: 11991

Here is a sample that reports WorkingSetSize after fetching a client-side recordset using ADO

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function GetProcessMemoryInfo Lib "psapi" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long

Private Type PROCESS_MEMORY_COUNTERS
    cb                      As Long
    PageFaultCount          As Long
    PeakWorkingSetSize      As Long
    WorkingSetSize          As Long
    QuotaPeakPagedPoolUsage As Long
    QuotaPagedPoolUsage     As Long
    QuotaPeakNonPagedPoolUsage As Long
    QuotaNonPagedPoolUsage  As Long
    PagefileUsage           As Long
    PeakPagefileUsage       As Long
    PrivateUsage            As Long
End Type

Private Function pvGetWorkingSetSize() As String
    Dim uCounters       As PROCESS_MEMORY_COUNTERS

    On Error GoTo QH
    If GetProcessMemoryInfo(GetCurrentProcess(), uCounters, Len(uCounters)) <> 0 Then
        pvGetWorkingSetSize = Format$(pvToUnsigned(uCounters.WorkingSetSize) / 1024 / 1024, "0.00") & "MB"
    End If
QH:
End Function

Private Function pvToUnsigned(ByVal lValue As Long) As Currency
    Call CopyMemory(pvToUnsigned, lValue, 4)
    pvToUnsigned = pvToUnsigned * 10000@
End Function

'--- UI stuff

Private Sub Command1_Click()
    Const CONN_STR  As String = "Provider=SQLOLEDB;Data Source=UCSDB\R2;Initial Catalog=Dreem15_IVB_2;Integrated Security=SSPI"
    Dim rs          As ADODB.Recordset

    pvLog "Starting"
    Set rs = New ADODB.Recordset
    pvLog "After loading ADO"

    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open "SELECT 1 AS ID", CONN_STR, adOpenStatic, adLockBatchOptimistic
    pvLog "After loading SQLOLEDB"

    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open "SELECT TOP 10000 * FROM inv_Docs", CONN_STR, adOpenStatic, adLockBatchOptimistic
    pvLog "After fetching 10000 records"
    With New PropertyBag
        .WriteProperty "rs", rs
        pvLog "Propbag size: " & Format$(UBound(.Contents) / 1024 / 1024, "0.00") & "MB"
    End With
    pvLog "After destroy propbag"
    Set rs = Nothing
    pvLog "After destroy recordset"
End Sub

Private Sub Command2_Click()
    pvLog "Ping"
End Sub

Private Sub pvLog(sText As String)
    Text1.Text = Text1.Text & Format$(Timer, "0.00") & ": " & pvGetWorkingSetSize() & ", " & sText & vbCrLf
    Text1.SelStart = &H7FFF
    Refresh
End Sub

Here are the results after three consecutive executions

60366.48: 17.71MB, Starting
60366.48: 18.04MB, After loading ADO
60366.51: 22.00MB, After loading SQLOLEDB
60366.74: 48.49MB, After fetching 10000 records
60368.34: 62.81MB, Propbag size: 6.04MB
60368.34: 50.73MB, After destroy propbag
60368.34: 28.63MB, After destroy recordset

60369.45: 28.67MB, Starting
60369.45: 28.68MB, After loading ADO
60369.47: 28.90MB, After loading SQLOLEDB
60369.71: 53.28MB, After fetching 10000 records
60371.30: 67.41MB, Propbag size: 6.04MB
60371.30: 55.33MB, After destroy propbag
60371.30: 33.88MB, After destroy recordset

60371.95: 33.88MB, Starting
60371.95: 33.88MB, After loading ADO
60371.96: 33.91MB, After loading SQLOLEDB
60372.20: 56.37MB, After fetching 10000 records
60373.80: 69.11MB, Propbag size: 6.04MB
60373.80: 57.03MB, After destroy propbag
60373.80: 34.09MB, After destroy recordset

Upvotes: 0

Related Questions