Results 1 to 10 of 10

Thread: Class ADOFastRecord to mimic ADODB Recordset faster

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    431

    Class ADOFastRecord to mimic ADODB Recordset faster

    As always, I try to increase the speed of my applications.

    My applications are using intensively ADO Recordset to read/interpret/display... thousands of records coming from hundred of tables.

    All is working well, but after some search, using the famous ADODBRecordset.GetRows that returns an array containing the recordset it increasing drastically the speed.
    The problem is that the code becomes more unreadable.

    So I created a class that Mimic the Recordset using GetRows, and implementing nearly same functionalities as ADODB.RecordSet, including retrieving data using FieldsName.
    Then I did some speed test with a table of 14k records & 15 fields.

    Here are the timing after several run of the test code.
    I tried several ways (collections, Dictionary...)
    The tests below are done using dictionary

    ADODB.Recordset : 10,5859375
    ADODB.Recordset GetRows direct : 1,14453125
    ADOFast By Row : For with field name : 8,0234375
    ADOFast By Row : For with field number : 4,65625
    ADOFast : Mimic ADODB.Recordset Do while not EOF field name : 9,140625
    ADOFast : Mimic ADODB.Recordset Do while not EOF field number : 4,0546875

    ADODB.Recordset : 10,375
    ADODB.Recordset GetRows direct : 1,85546875
    ADOFast By Row : For with field name : 7,5
    ADOFast By Row : For with field number : 4,5234375
    ADOFast : Mimic ADODB.Recordset Do while not EOF field name : 7,48046875
    ADOFast : Mimic ADODB.Recordset Do while not EOF field number : 4,83203125

    ADODB.Recordset : 10,078125
    ADODB.Recordset GetRows direct : 1,55859375
    ADOFast By Row : For with field name : 7,703125
    ADOFast By Row : For with field number : 4,4140625
    ADOFast : Mimic ADODB.Recordset Do while not EOF field name : 8,35546875
    ADOFast : Mimic ADODB.Recordset Do while not EOF field number : 4,75390625

    ADODB.Recordset : 11,421875
    ADODB.Recordset GetRows direct : 2,23046875
    ADOFast By Row : For with field name : 8,828125
    ADOFast By Row : For with field number : 4,1484375
    ADOFast : Mimic ADODB.Recordset Do while not EOF field name : 7,87109375
    ADOFast : Mimic ADODB.Recordset Do while not EOF field number : 3,8515625

    ADODB.Recordset : 10,21484375
    ADODB.Recordset GetRows direct : 1,6953125
    ADOFast By Row : For with field name : 7,33984375
    ADOFast By Row : For with field number : 4,7265625
    ADOFast : Mimic ADODB.Recordset Do while not EOF field name : 8,8828125
    ADOFast : Mimic ADODB.Recordset Do while not EOF field number : 3,640625

    We can see the interest using GetRows
    ADOFast class is using GetRows inside, and map Fields Name.

    Using direct access to the array is the fastest way, but the less readable and maintainable code

    Using ADOFast is faster when accessing field's data using their Number than the Field's name.
    The bottleneck is the mapping between "Fields number" and "Fields Name".
    For that I used a class_collection that mimic Collection, but but it is still a bottleneck.
    Does someone has a fastest way to map a STRING to an LONG?

    I also tried using dictionary which gives a small better result timing than collections.

    At least, this class could be a start to manage big recordset faster, and with minor changes.

    All comments are welcome to make it better

    Here is the class FastADO.cls

    Here is the test routine to test the class using dictionary
    Code:
    Public Sub Test_ADOFast()
    
       Dim sSQL          As String
       Dim oRecord       As ADODB.Recordset
       
       Dim aRecords()    As Variant
       
       Dim oADOFast      As class_ADOFastRecord
       
       Dim nRows         As Long
       Dim nRow          As Long
       Dim nField        As Long
       
       Dim T             As Long
       Dim nStep         As Long
       
       Dim nJ            As Long
       Dim sTmp          As String
       
       sSQL = "Select * From TheTable"
    
       ' *** Classic ADODB.Recordset
       T = Timer
       Set oRecord = New ADODB.Recordset
       oRecord.Open sSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
       With oRecord
          For nStep = 1 To 10
             .MoveFirst
             Do While Not .EOF
                sTmp = vbNullString
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "ID")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "IDTransaction")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "IDTransactionsSyndicate")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "IDInvestor")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "OrderAmount")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "AllocationAmount")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "Limits")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "IDBank")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "Archived")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "DateAdded")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "UserAdded")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "DateModified")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "UserModified")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "OrderAmountUSD")
                sTmp = sTmp & "; " & ReadRecordsetADO(oRecord, "AllocationAmountUSD")
    
                'Debug.Print sTmp
    
                .MoveNext
             Loop
          Next
       End With
       oRecord.Close
       Set oRecord = Nothing
       Debug.Print "ADODB.Recordset : "; Timer - T
       DoEvents
    
    
       ' *** ADODB.Recordset GetRows Direct
       T = Timer
       Set oRecord = New ADODB.Recordset
       oRecord.Open sSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
       aRecords = oRecord.GetRows
    
       nRows = UBound(aRecords, 2) + 1
       For nStep = 1 To 10
          For nRow = 0 To nRows - 1
             sTmp = vbNullString
             sTmp = sTmp & "; " & aRecords(0, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(1, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(2, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(3, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(4, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(5, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(6, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(7, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(8, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(9, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(10, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(11, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(12, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(13, nRow) & vbNullString
             sTmp = sTmp & "; " & aRecords(14, nRow) & vbNullString
    
             'Debug.Print sTmp
    
          Next
       Next
       oRecord.Close
       Set oRecord = Nothing
       Debug.Print "ADODB.Recordset GetRows direct : "; Timer - T
       DoEvents
    
    
       ' *** ADOFast
       T = Timer
       Set oADOFast = New class_ADOFastRecord
       With oADOFast
          .OpenRecordset sSQL, CurrentProject.Connection
    
          nRows = .Rows
          For nStep = 1 To 10
             For nRow = 0 To nRows - 1
                sTmp = vbNullString
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "ID")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "IDTransaction")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "IDTransactionsSyndicate")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "IDInvestor")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "OrderAmount")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "AllocationAmount")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "Limits")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "IDBank")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "Archived")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "DateAdded")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "UserAdded")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "DateModified")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "UserModified")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "OrderAmountUSD")
                sTmp = sTmp & "; " & .ReadRecordsetRow(nRow, "AllocationAmountUSD")
    
                'Debug.Print sTmp
    
             Next
          Next
       End With
       Set oADOFast = Nothing
       Debug.Print "ADOFast By Row : For with field name : " & Timer - T
       DoEvents
    
       ' *** Doing directly
       T = Timer
       Set oADOFast = New class_ADOFastRecord
       With oADOFast
          .OpenRecordset sSQL, CurrentProject.Connection
    
          nRows = .Rows
          For nStep = 1 To 10
             For nRow = 0 To nRows - 1
                sTmp = vbNullString
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 0)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 1)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 2)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 3)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 4)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 5)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 6)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 7)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 8)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 9)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 10)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 11)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 12)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 13)
                sTmp = sTmp & "; " & .ReadRecordsetRowNumber(nRow, 14)
    
                'Debug.Print sTmp
    
             Next
          Next
       End With
       Set oADOFast = Nothing
       Debug.Print "ADOFast By Row : For with field number : " & Timer - T
       DoEvents
    
       ' *** Mimic ADODB.Recordset
       T = Timer
       Set oADOFast = New class_ADOFastRecord
       With oADOFast
          .OpenRecordset sSQL, CurrentProject.Connection
          For nStep = 1 To 10
             .MoveFirst
             Do While Not .EOF
                sTmp = vbNullString
                sTmp = sTmp & "; " & .ReadRecordset("ID")
                sTmp = sTmp & "; " & .ReadRecordset("IDTransaction")
                sTmp = sTmp & "; " & .ReadRecordset("IDTransactionsSyndicate")
                sTmp = sTmp & "; " & .ReadRecordset("IDInvestor")
                sTmp = sTmp & "; " & .ReadRecordset("OrderAmount")
                sTmp = sTmp & "; " & .ReadRecordset("AllocationAmount")
                sTmp = sTmp & "; " & .ReadRecordset("Limits")
                sTmp = sTmp & "; " & .ReadRecordset("IDBank")
                sTmp = sTmp & "; " & .ReadRecordset("Archived")
                sTmp = sTmp & "; " & .ReadRecordset("DateAdded")
                sTmp = sTmp & "; " & .ReadRecordset("UserAdded")
                sTmp = sTmp & "; " & .ReadRecordset("DateModified")
                sTmp = sTmp & "; " & .ReadRecordset("UserModified")
                sTmp = sTmp & "; " & .ReadRecordset("OrderAmountUSD")
                sTmp = sTmp & "; " & .ReadRecordset("AllocationAmountUSD")
                
                'Debug.Print sTmp
                            
                .MoveNext
             Loop
          Next
       End With
       Set oADOFast = Nothing
       Debug.Print "ADOFast : Mimic ADODB.Recordset Do while not EOF field name : " & Timer - T
       DoEvents
    
       ' *** Mimic ADODB.Recordset by field number
       T = Timer
       Set oADOFast = New class_ADOFastRecord
       With oADOFast
          .OpenRecordset sSQL, CurrentProject.Connection
          For nStep = 1 To 10
             .MoveFirst
             Do While Not .EOF
                sTmp = .ReadRecordsetNumber(0)
                sTmp = .ReadRecordsetNumber(1)
                sTmp = .ReadRecordsetNumber(2)
                sTmp = .ReadRecordsetNumber(3)
                sTmp = .ReadRecordsetNumber(4)
                sTmp = .ReadRecordsetNumber(5)
                sTmp = .ReadRecordsetNumber(6)
                sTmp = .ReadRecordsetNumber(7)
                sTmp = .ReadRecordsetNumber(8)
                sTmp = .ReadRecordsetNumber(9)
                sTmp = .ReadRecordsetNumber(10)
                sTmp = .ReadRecordsetNumber(11)
                sTmp = .ReadRecordsetNumber(12)
                sTmp = .ReadRecordsetNumber(13)
                sTmp = .ReadRecordsetNumber(14)
                
                'Debug.Print sTmp
                            
                .MoveNext
             Loop
          Next
       End With
       Set oADOFast = Nothing
       Debug.Print "ADOFast : Mimic ADODB.Recordset Do while not EOF field number : " & Timer - T
       DoEvents
          
       Debug.Print
    
    End Sub

  2. #2

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    431

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    Of course for your tests, modify the SQL Query, and fields names.

    And I forgot the FormatDate Function

    Public Function FormatDate(sDate As String) As String
    On Error Resume Next

    FormatDate = Format$(sDate, "DD/MM/YYYY")

    End Function

  3. #3
    Member
    Join Date
    Sep 2016
    Location
    Texas panhandle
    Posts
    55

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    Thanks for sharing.
    The download actually loads in vb6 as a module. Since it has Class_initialize & terminate, it appears to be class code.
    I copied all the code into a new class module.

    Got an error on the object class_FieldInfos


    Is this a separate class?

  4. #4

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    431

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    I just paste the code as a text.
    OI forgot to attach the class itself

    Here is the file itself
    class_ADOFastRecord.cls

    And the class (I also forgot) that is used to mimic fields
    class_FieldInfos.cls

  5. #5
    Member
    Join Date
    Sep 2016
    Location
    Texas panhandle
    Posts
    55

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    Many thanks.
    I'm haven't gotten out of my dinosaur DAO ways.
    Can you give the definition for the
    ReadRecordsetADO routine?

  6. #6

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    431

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    Sorry, taken from several bas files

    Public Function ReadRecordsetADO (oRecord As ADODB.Recordset, sField As String) As String
    On Error GoTo ReadRecordsetError

    With oRecord(sField)
    If IsNull(.Value) Or IsEmpty(.Value) Then
    Select Case .Type
    Case vbString, adVarWChar, adLongVarWChar: ReadRecordset = vbNullString
    Case vbLong, adSmallInt: ReadRecordsetADO = 0
    Case vbDouble: ReadRecordsetADO = 0
    Case vbDate, vbDateTime: ReadRecordsetADO = vbNullString
    Case vbBoolean: ReadRecordsetADO = False
    Case Else: ReadRecordsetADO = vbNullString
    End Select
    Else
    Select Case .Type
    Case vbString, adVarWChar, adLongVarWChar: ReadRecordsetADO = .Value
    Case vbLong, adSmallInt: ReadRecordsetADO = .Value
    Case vbDouble: ReadRecordsetADO = Format$(.Value, "0.000")
    Case vbDate, vbDateTime: ReadRecordsetADO = FormatDate(.Value)
    Case vbBoolean: ReadRecordsetADO = CBool(.Value)
    Case Else: ReadRecordsetADO = .Value
    End Select
    End If
    End With

    ReadRecordsetError:
    Exit Function

    End Function

  7. #7

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    431

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    NB : Everything is exracted from a bigger project, so sorry again if a method was missing

  8. #8
    Member
    Join Date
    Sep 2016
    Location
    Texas panhandle
    Posts
    55

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    Many thanks - got it working.
    I have a db table with about 10,000 music files, with 15 fields.
    I've been using the GetRows function to speed up loading a Listview.
    This will, I think, speed it up even more.

  9. #9

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    431

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    The main purpose, is to speed up the loading, and minimizing modifications in the code.

    The class could be update by adding more methods, and maybe speed up more, byt reducing bottleneck

  10. #10
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    505

    Re: Class ADOFastRecord to mimic ADODB Recordset faster

    Quote Originally Posted by Thierry69 View Post
    Sorry, taken from several bas files

    Public Function ReadRecordsetADO (oRecord As ADODB.Recordset, sField As String) As String
    On Error GoTo ReadRecordsetError

    With oRecord(sField)
    If IsNull(.Value) Or IsEmpty(.Value) Then
    Select Case .Type
    Case vbString, adVarWChar, adLongVarWChar: ReadRecordset = vbNullString
    Case vbLong, adSmallInt: ReadRecordsetADO = 0
    Case vbDouble: ReadRecordsetADO = 0
    Case vbDate, vbDateTime: ReadRecordsetADO = vbNullString
    Case vbBoolean: ReadRecordsetADO = False
    Case Else: ReadRecordsetADO = vbNullString
    End Select
    Else
    Select Case .Type
    Case vbString, adVarWChar, adLongVarWChar: ReadRecordsetADO = .Value
    Case vbLong, adSmallInt: ReadRecordsetADO = .Value
    Case vbDouble: ReadRecordsetADO = Format$(.Value, "0.000")
    Case vbDate, vbDateTime: ReadRecordsetADO = FormatDate(.Value)
    Case vbBoolean: ReadRecordsetADO = CBool(.Value)
    Case Else: ReadRecordsetADO = .Value
    End Select
    End If
    End With

    ReadRecordsetError:
    Exit Function

    End Function
    If you can upload a complete demo, it would be better. Thank you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width