ADO-ODBC

Development Platform:
Visual C++

Perf.frm：Code Content
							VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "Comctl32.ocx"
Begin VB.Form frmPerf 
   Caption         =   "ADO Performance Test"
   ClientHeight    =   7095
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9390
   LinkTopic       =   "Form1"
   ScaleHeight     =   7095
   ScaleWidth      =   9390
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtCacheSize 
      Height          =   285
      Left            =   6480
      TabIndex        =   52
      Text            =   "1"
      Top             =   3480
      Width           =   495
   End
   Begin VB.CheckBox chkNoRecords 
      Alignment       =   1  'Right Justify
      Caption         =   "adExecuteNoRecords"
      Height          =   255
      Left            =   7200
      TabIndex        =   50
      ToolTipText     =   "Will run the query asynchronously"
      Top             =   3480
      Width           =   2055
   End
   Begin VB.Frame fraCursorLocation 
      Caption         =   "Cursor Location"
      Height          =   1095
      Left            =   6840
      TabIndex        =   44
      Top             =   4680
      Width           =   2415
      Begin VB.CheckBox chkCursorLocation 
         Caption         =   "Use Client"
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   46
         Top             =   720
         Width           =   1575
      End
      Begin VB.CheckBox chkCursorLocation 
         Caption         =   "Use Server"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   45
         Top             =   360
         Width           =   1455
      End
   End
   Begin VB.Frame fraLockType 
      Caption         =   "Lock Type"
      Height          =   1095
      Left            =   3240
      TabIndex        =   39
      Top             =   4680
      Width           =   3255
      Begin VB.CheckBox chkLockType 
         Caption         =   "Batch Optimistic"
         Height          =   255
         Index           =   4
         Left            =   1680
         TabIndex        =   43
         Top             =   720
         Width           =   1455
      End
      Begin VB.CheckBox chkLockType 
         Caption         =   "Optimistic"
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   42
         Top             =   720
         Width           =   1215
      End
      Begin VB.CheckBox chkLockType 
         Caption         =   "Pessimistic"
         Height          =   255
         Index           =   2
         Left            =   1680
         TabIndex        =   41
         Top             =   360
         Width           =   1215
      End
      Begin VB.CheckBox chkLockType 
         Caption         =   "Read Only"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   40
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.Frame fraCursorType 
      Caption         =   "Cursor Type"
      Height          =   1095
      Left            =   120
      TabIndex        =   34
      Top             =   4680
      Width           =   2655
      Begin VB.CheckBox chkCursorType 
         Caption         =   "Static"
         Height          =   255
         Index           =   3
         Left            =   1680
         TabIndex        =   38
         Top             =   720
         Width           =   735
      End
      Begin VB.CheckBox chkCursorType 
         Caption         =   "Dynamic"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   37
         Top             =   720
         Width           =   1335
      End
      Begin VB.CheckBox chkCursorType 
         Caption         =   "Keyset"
         Height          =   255
         Index           =   1
         Left            =   1680
         TabIndex        =   36
         Top             =   360
         Width           =   855
      End
      Begin VB.CheckBox chkCursorType 
         Caption         =   "Forward Only"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   35
         Top             =   360
         Width           =   1335
      End
   End
   Begin VB.CheckBox chkAsync 
      Alignment       =   1  'Right Justify
      Caption         =   "Asynchronous"
      Height          =   255
      Left            =   7680
      TabIndex        =   33
      ToolTipText     =   "Will run the query asynchronously"
      Top             =   3840
      Width           =   1575
   End
   Begin VB.TextBox txtTimes 
      Height          =   285
      Left            =   6480
      TabIndex        =   26
      Text            =   "10"
      ToolTipText     =   "Number of times to run the test"
      Top             =   3840
      Width           =   495
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel Test"
      Height          =   375
      Left            =   5400
      TabIndex        =   25
      Top             =   6600
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "Close"
      Height          =   375
      Left            =   8040
      TabIndex        =   24
      Top             =   6600
      Width           =   1215
   End
   Begin VB.TextBox txtMarker 
      Height          =   285
      Left            =   6480
      TabIndex        =   22
      ToolTipText     =   "User specific text to write to the log"
      Top             =   4200
      Width           =   2775
   End
   Begin VB.Frame fraTest 
      Caption         =   "Test"
      Height          =   2295
      Left            =   5280
      TabIndex        =   15
      Top             =   960
      Width           =   3615
      Begin VB.OptionButton optTest 
         Caption         =   "Run Command (no recordset)"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   53
         Top             =   1800
         Width           =   3135
      End
      Begin VB.OptionButton optTest 
         Caption         =   "Open / GetRows (Chunked) / Close"
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   32
         Top             =   1440
         Width           =   3135
      End
      Begin VB.OptionButton optTest 
         Caption         =   "Open / GetRows / Close"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   18
         Top             =   1080
         Width           =   2175
      End
      Begin VB.OptionButton optTest 
         Caption         =   "Open / MoveNext / Close"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   17
         Top             =   720
         Width           =   2175
      End
      Begin VB.OptionButton optTest 
         Caption         =   "Open / Close"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   16
         Top             =   360
         Value           =   -1  'True
         Width           =   2175
      End
   End
   Begin VB.Frame fraTables 
      Height          =   3135
      Index           =   0
      Left            =   240
      TabIndex        =   2
      Top             =   1320
      Width           =   4695
      Begin VB.Frame fraadCmdTable 
         Caption         =   "Command Type"
         Height          =   1215
         Left            =   2400
         TabIndex        =   6
         Top             =   240
         Width           =   2055
         Begin VB.OptionButton optadCmdTableDirect 
            Caption         =   "adCmdTableDirect"
            Height          =   255
            Left            =   240
            TabIndex        =   8
            Top             =   720
            Visible         =   0   'False
            Width           =   1695
         End
         Begin VB.OptionButton optadCmdTable 
            Caption         =   "adCmdTable"
            Height          =   255
            Left            =   240
            TabIndex        =   7
            Top             =   360
            Value           =   -1  'True
            Width           =   1455
         End
      End
      Begin VB.ListBox lstTables 
         Height          =   2790
         ItemData        =   "Perf.frx":0000
         Left            =   120
         List            =   "Perf.frx":0007
         Sorted          =   -1  'True
         TabIndex        =   5
         Top             =   240
         Width           =   2055
      End
   End
   Begin VB.CommandButton cmdTest 
      Caption         =   "Test"
      Height          =   375
      Left            =   6720
      TabIndex        =   0
      Top             =   6600
      Width           =   1215
   End
   Begin VB.Frame fraTables 
      Height          =   3105
      Index           =   2
      Left            =   240
      TabIndex        =   4
      Top             =   1320
      Visible         =   0   'False
      Width           =   4695
      Begin VB.Frame fraPrepare 
         Caption         =   "Prepare"
         Height          =   735
         Left            =   2280
         TabIndex        =   19
         Top             =   2280
         Width           =   2295
         Begin VB.OptionButton optPrepareNo 
            Caption         =   "No"
            Height          =   255
            Left            =   1320
            TabIndex        =   21
            Top             =   360
            Width           =   735
         End
         Begin VB.OptionButton optPrepareYes 
            Caption         =   "Yes"
            Height          =   255
            Left            =   240
            TabIndex        =   20
            Top             =   360
            Value           =   -1  'True
            Width           =   975
         End
      End
      Begin VB.TextBox txtSQL 
         Height          =   1935
         Left            =   120
         MultiLine       =   -1  'True
         TabIndex        =   14
         Top             =   240
         Width           =   4455
      End
      Begin VB.Frame fraadCmdTab 
         Caption         =   "Command Type"
         Height          =   735
         Index           =   1
         Left            =   120
         TabIndex        =   12
         Top             =   2280
         Width           =   2055
         Begin VB.OptionButton optadCmdText 
            Caption         =   "adCmdText"
            Height          =   255
            Left            =   240
            TabIndex        =   13
            Top             =   360
            Value           =   -1  'True
            Width           =   1695
         End
      End
   End
   Begin VB.Frame fraTables 
      Height          =   3135
      Index           =   1
      Left            =   240
      TabIndex        =   3
      Top             =   1320
      Visible         =   0   'False
      Width           =   4695
      Begin VB.Frame fraadCmdTab 
         Caption         =   "Command Type"
         Height          =   735
         Index           =   0
         Left            =   2400
         TabIndex        =   10
         Top             =   240
         Width           =   2055
         Begin VB.OptionButton optadCmdStoredProc 
            Caption         =   "adCmdStoredProc"
            Height          =   255
            Left            =   240
            TabIndex        =   11
            Top             =   360
            Value           =   -1  'True
            Width           =   1695
         End
      End
      Begin VB.ListBox lstQueries 
         Height          =   2790
         ItemData        =   "Perf.frx":0016
         Left            =   120
         List            =   "Perf.frx":001D
         Sorted          =   -1  'True
         TabIndex        =   9
         Top             =   240
         Width           =   2055
      End
   End
   Begin ComctlLib.TabStrip tabTables 
      Height          =   3585
      Left            =   120
      TabIndex        =   1
      Top             =   960
      Width           =   4935
      _ExtentX        =   8705
      _ExtentY        =   6324
      _Version        =   327682
      BeginProperty Tabs {0713E432-850A-101B-AFC0-4210102A8DA7} 
         NumTabs         =   3
         BeginProperty Tab1 {0713F341-850A-101B-AFC0-4210102A8DA7} 
            Caption         =   "Tables"
            Object.Tag             =   ""
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {0713F341-850A-101B-AFC0-4210102A8DA7} 
            Caption         =   "Queries"
            Object.Tag             =   ""
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {0713F341-850A-101B-AFC0-4210102A8DA7} 
            Caption         =   "SQL"
            Object.Tag             =   ""
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.Label Label1 
      Caption         =   "Cache Size"
      Height          =   255
      Left            =   5400
      TabIndex        =   51
      Top             =   3480
      Width           =   975
   End
   Begin VB.Label lblCursorLocation 
      Height          =   255
      Left            =   6840
      TabIndex        =   49
      Top             =   5880
      Width           =   2415
   End
   Begin VB.Label lblLockType 
      Height          =   255
      Left            =   3240
      TabIndex        =   48
      Top             =   5880
      Width           =   3255
   End
   Begin VB.Label lblCursorType 
      Height          =   255
      Left            =   120
      TabIndex        =   47
      Top             =   5880
      Width           =   2655
   End
   Begin VB.Label lblProvider 
      Height          =   255
      Left            =   1440
      TabIndex        =   31
      Top             =   120
      Width           =   7455
   End
   Begin VB.Label lblProvCaption 
      Caption         =   "Provider:"
      Height          =   255
      Left            =   120
      TabIndex        =   30
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label lblConnCaption 
      Caption         =   "Connect String:"
      Height          =   255
      Left            =   120
      TabIndex        =   29
      Top             =   480
      Width           =   1215
   End
   Begin VB.Label lblConnectString 
      Height          =   255
      Left            =   1440
      TabIndex        =   28
      Top             =   480
      Width           =   7455
   End
   Begin VB.Label lblTimes 
      Caption         =   "Times:"
      Height          =   255
      Left            =   5400
      TabIndex        =   27
      Top             =   3840
      Width           =   975
   End
   Begin VB.Label lblMarkerText 
      Caption         =   "Marker Text:"
      Height          =   255
      Left            =   5400
      TabIndex        =   23
      Top             =   4200
      Width           =   975
   End
End
Attribute VB_Name = "frmPerf"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_oConn                 As New ADODB.Connection     ' data store connection
Private m_iTab                  As Integer                  ' tab selected
Private m_iadCmdTableDirect     As Integer                  ' value of adCmdTableDirect
Private m_iadExecuteNoRecords   As Integer                  ' value of adExecuteNoRecords
Private m_bCancel               As Boolean                  ' true if cancelling form open
'TODO: options which would be good to implement
Private m_bAsync                As Boolean                  ' execute the queries asynchronously
Private m_iNumRows              As Integer                  ' limit the number of rows returned
Private Sub chkAsync_Click()
    ' as yet nothing is done with this
    
    m_bAsync = chkAsync
    cmdCancel.Visible = m_bAsync
End Sub
Private Sub cmdClose_Click()
    If m_oConn.State = adStateOpen Then
        m_oConn.Close
        Set m_oConn = Nothing
    End If
    Me.Visible = False
    frmConnect.Visible = True
    
End Sub
Private Sub Form_Activate()
    If m_bCancel Then
        cmdClose_Click
        Unload Me
    End If
End Sub
Private Sub Form_Load()
    'On Error GoTo Form_Load_err
    ' which version of ADO
    SetVersionSpecifics
    ' connect to the provider
    m_oConn.Provider = g_sProvider
    m_oConn.Open g_sConnectString
    lblProvider.Caption = g_sProvider
    lblConnectString.Caption = g_sConnectString
    ' fill the tables/queries lists
    SchemaFill lstTables, adSchemaTables
    If g_sDriver = ACCESS_DRIVER Or _
       g_sProvider = ACCESS_PROVIDER Then
        SchemaFill lstQueries, adSchemaViews
    Else
        SchemaFill lstQueries, adSchemaProcedures
    End If
    ' don't allow async or adCmdTableDirect if ado 1.5
    If m_oConn.Version = 1.5 Then
        chkAsync.Visible = False
        optadCmdTableDirect.Visible = False
        m_bAsync = False
    Else
        chkAsync.Visible = True
        optadCmdTableDirect.Visible = True
        m_bAsync = True
    End If
Form_Load_Exit:
    Exit Sub
Form_Load_err:
    Select Case Err
    Case 3706   ' could not find provider
        MsgBox "I'm sorry but this provider is not available.  Please pick another.", vbExclamation, "Cannot find provider"
        Me.Visible = False
        m_bCancel = True
    Case Else
        MsgBox "Error: Form_Load: " & Err.Description & " (" & Err.Number & ")"
        Resume Form_Load_Exit
    End Select
End Sub
Private Sub cmdTest_Click()
    ' run the tests
    
    Dim iCmd        As CommandTypeEnum
    Dim sText       As String
    Select Case tabTables.SelectedItem.Index
    Case 1
        ' tables
        If optadCmdTable Then
            iCmd = adCmdTable
        Else
            iCmd = m_iadCmdTableDirect
        End If
        sText = lstTables
    Case 2
        ' queries
        iCmd = adCmdStoredProc
        sText = lstQueries
    Case 3
        ' sql text
        iCmd = adCmdText
        sText = txtSQL
    End Select
    ' TODO: set number of rows
    If m_iNumRows = 0 Then
        ' open recordset with select count(*) ?
        ' this was for logging only
    End If
    ' run the tests
    Test sText, iCmd
    ' some of them can be long, so pop up message
    MsgBox "Done"
End Sub
Private Sub Test(ByVal sText As String, ByVal iCommandType As CommandTypeEnum)
    ' for each cursor type, lock type, and cursor location
    ' which has been selected, run the test
    Dim iCursorType         As Integer
    Dim iLockType           As Integer
    Dim iCursorLocation     As Integer
    If optTest(4) Then
        TimeRecordset sText, _
                  iCursorType, _
                  iLockType, _
                  iCursorLocation, _
                  iCommandType, _
                  txtTimes
    Else
        For iCursorType = chkCursorType.LBound To chkCursorType.UBound
            If chkCursorType(iCursorType) Then
                For iLockType = chkLockType.LBound To chkLockType.UBound
                    If chkLockType(iLockType) Then
                        For iCursorLocation = chkCursorLocation.LBound To chkCursorLocation.UBound
                            If chkCursorLocation(iCursorLocation) Then
                                TimeRecordset sText, _
                                          iCursorType, _
                                          iLockType, _
                                          iCursorLocation, _
                                          iCommandType, _
                                          txtTimes
                            End If
                        Next
                    End If
                Next
            End If
        Next
    End If
End Sub
Private Sub TimeRecordset(ByVal sText As String, _
                    ByVal iCursorTypeRequested As CursorTypeEnum, _
                    ByVal iLockType As LockTypeEnum, _
                    ByVal iCursorLocation As CursorLocationEnum, _
                    ByVal iType As CommandTypeEnum, _
                    ByVal iTimes As Integer)
    ' run the test
    
    Dim oRec                As New ADODB.Recordset
    Dim iCursorTypeReceived As CursorTypeEnum
    Dim lTime               As Long
    Dim sTest               As String
    ' show what's going on
    If Not optTest(4) Then
        lblCursorType.Caption = chkCursorType(iCursorTypeRequested).Caption
        lblLockType.Caption = chkLockType(iLockType).Caption
        lblCursorLocation.Caption = chkCursorLocation(iCursorLocation).Caption
        Me.Refresh
    End If
    ' run the actual test selected
    If optTest(0) Then
        lTime = Test1Run(sText, iCursorTypeRequested, iLockType, iCursorLocation, iType, iTimes)
        sTest = optTest(0).Caption
    End If
    
    If optTest(1) Then
        lTime = Test2Run(sText, iCursorTypeRequested, iLockType, iCursorLocation, iType, iTimes)
        sTest = optTest(1).Caption
    End If
    If optTest(2) Then
        lTime = Test3Run(sText, iCursorTypeRequested, iLockType, iCursorLocation, iType, iTimes)
        sTest = optTest(2).Caption
    End If
    If optTest(3) Then
        lTime = Test4Run(sText, iCursorTypeRequested, iLockType, iCursorLocation, iType, iTimes)
        sTest = optTest(3).Caption
    End If
    If optTest(4) Then
        lTime = Test5Run(sText, iCursorTypeRequested, iLockType, iCursorLocation, iType, iTimes)
        sTest = optTest(4).Caption
        iCursorTypeReceived = iCursorTypeRequested
    Else
        ' get the cursor type actually returned
        ' stops misleading results when the cursor type is not suported
        oRec.ActiveConnection = m_oConn
        oRec.CursorLocation = iCursorLocation
        oRec.Open sText, , iCursorTypeRequested, iLockType, iType
        iCursorTypeReceived = oRec.CursorType
        oRec.Close
    End If
    ' finally log the times
    LogTimes lTime, iTimes, sText, sTest, _
            iCursorTypeRequested, iCursorTypeReceived, _
            iLockType, iCursorLocation, iType
End Sub
Private Function Test1Run(ByVal sText As String, _
                    ByVal iCursorTypeRequested As CursorTypeEnum, _
                    ByVal iLockType As LockTypeEnum, _
                    ByVal iCursorLocation As CursorLocationEnum, _
                    ByVal iType As CommandTypeEnum, _
                    ByVal iTimes As Integer) As Long
'
' Test 1: Open and close the recordset
    Dim ct                  As New CTimer
    Dim oRec                As New ADODB.Recordset
    Dim iLoop               As Integer
    Dim lTime               As Long
    m_oConn.CursorLocation = iCursorLocation
    oRec.ActiveConnection = m_oConn
    oRec.CacheSize = CLng(txtCacheSize)
    For iLoop = 1 To iTimes
        ct.StartTiming
        oRec.Open sText, , iCursorTypeRequested, iLockType, iType
        oRec.Close
        ct.StopTiming
        lTime = lTime + ct.TotalTime
    Next
    Test1Run = lTime
End Function
Private Function Test2Run(ByVal sText As String, _
                    ByVal iCursorTypeRequested As CursorTypeEnum, _
                    ByVal iLockType As LockTypeEnum, _
                    ByVal iCursorLocation As CursorLocationEnum, _
                    ByVal iType As CommandTypeEnum, _
                    ByVal iTimes As Integer) As Long
'
' test 2: open the recordset, move through the records, close the recordset
    Dim ct                  As New CTimer
    Dim oRec                As New ADODB.Recordset
    Dim iLoop               As Integer
    Dim lTime               As Long
    m_oConn.CursorLocation = iCursorLocation
    oRec.ActiveConnection = m_oConn
    oRec.CacheSize = CLng(txtCacheSize)
    For iLoop = 1 To iTimes
        oRec.Open sText, , iCursorTypeRequested, iLockType, iType
        ct.StartTiming
        
        While Not oRec.EOF
            oRec.MoveNext
        Wend
        ct.StopTiming
        oRec.Close
        lTime = lTime + ct.TotalTime
    Next
    Test2Run = lTime
End Function
Private Function Test3Run(ByVal sText As String, _
                    ByVal iCursorTypeRequested As CursorTypeEnum, _
                    ByVal iLockType As LockTypeEnum, _
                    ByVal iCursorLocation As CursorLocationEnum, _
                    ByVal iType As CommandTypeEnum, _
                    ByVal iTimes As Integer) As Long
'
' test 3: open the recordset, get the rows (GetRows), close the recordset
    Dim ct                  As New CTimer
    Dim oRec                As New ADODB.Recordset
    Dim iLoop               As Integer
    Dim lTime               As Long
    Dim avRows              As Variant
    m_oConn.CursorLocation = iCursorLocation
    oRec.ActiveConnection = m_oConn
    oRec.CacheSize = CLng(txtCacheSize)
    For iLoop = 1 To iTimes
        oRec.Open sText, , iCursorTypeRequested, iLockType, iType
        ct.StartTiming
        avRows = oRec.GetRows
        ct.StopTiming
        oRec.Close
        lTime = lTime + ct.TotalTime
    Next
    Test3Run = lTime
End Function
Private Function Test4Run(ByVal sText As String, _
                    ByVal iCursorTypeRequested As CursorTypeEnum, _
                    ByVal iLockType As LockTypeEnum, _
                    ByVal iCursorLocation As CursorLocationEnum, _
                    ByVal iType As CommandTypeEnum, _
                    ByVal iTimes As Integer) As Long
'
' Test 4: open the recordset, get the rows (GetRows) in chunks of 1000), close the recordset
    Dim ct                  As New CTimer
    Dim oRec                As New ADODB.Recordset
    Dim iLoop               As Integer
    Dim lTime               As Long
    Dim avRows              As Variant
    m_oConn.CursorLocation = iCursorLocation
    oRec.ActiveConnection = m_oConn
    oRec.CacheSize = CLng(txtCacheSize)
    For iLoop = 1 To iTimes
        oRec.Open sText, , iCursorTypeRequested, iLockType, iType
        ct.StartTiming
        While Not oRec.EOF
            avRows = oRec.GetRows(1000)
        Wend
        ct.StopTiming
        oRec.Close
        lTime = lTime + ct.TotalTime
    Next
    Test4Run = lTime
End Function
Private Function Test5Run(ByVal sText As String, _
                    ByVal iCursorTypeRequested As CursorTypeEnum, _
                    ByVal iLockType As LockTypeEnum, _
                    ByVal iCursorLocation As CursorLocationEnum, _
                    ByVal iType As CommandTypeEnum, _
                    ByVal iTimes As Integer) As Long
'
' Test 5: Just run the command - no recordset created
    Dim ct                  As New CTimer
    Dim oCmd                As New ADODB.Command
    Dim iLoop               As Integer
    Dim lTime               As Long
    Dim avRows              As Variant
    oCmd.ActiveConnection = m_oConn
    oCmd.CommandType = adCmdText
    oCmd.CommandText = sText
    oCmd.Prepared = Me!optPrepareYes.Value
    For iLoop = 1 To iTimes
        ct.StartTiming
        oCmd.Execute
        ct.StopTiming
        lTime = lTime + ct.TotalTime
    Next
    Test5Run = lTime
End Function
Private Sub LogTimes(lTime As Long, _
                    iTimes As Integer, _
                    sText As String, _
                    sTest As String, _
                    iCursorTypeRequested As CursorTypeEnum, _
                    iCursorTypeReceived As CursorTypeEnum, _
                    iLockType As LockTypeEnum, _
                    iCursorLocation As CursorLocationEnum, _
                    iCommandType As CommandTypeEnum)
    ' log the test times to the database
    Dim db          As DAO.Database
    Dim oRec        As DAO.Recordset
    Set db = OpenDatabase(g_sLogdb)
    Set oRec = db.OpenRecordset("tblPerformanceLog")
    With oRec
        .AddNew
        !MarkerText = txtMarker
        !Test = sTest
        !Driver = g_sDriver
        !CommandText = Left$(sText, 255)
        !Provider = m_oConn.Provider
        !ConnectionString = g_sConnectString
        !CursorTypeRequested = CursorTypeDesc(iCursorTypeRequested)
        !CursorTypeReceived = CursorTypeDesc(iCursorTypeReceived)
        !LockType = LockTypeDesc(iLockType)
        !CursorLocation = CursorLocationDesc(iCursorLocation)
        !CommandType = CommandTypeDesc(iCommandType)
        !NumTimes = iTimes
        !TotalTime = lTime
        !NumRows = m_iNumRows
        !CacheSize = CLng(txtCacheSize)
        .Update
    End With
    oRec.Close
    db.Close
    
    Set oRec = Nothing
    Set db = Nothing
End Sub
Private Function CursorTypeDesc(ByVal iCT As CursorTypeEnum) As String
    ' return the description for the cursor type
    
    Select Case iCT
    Case adOpenForwardOnly
        CursorTypeDesc = "adOpenForwardOnly"
    Case adOpenKeyset
        CursorTypeDesc = "adOpenKeyset"
    Case adOpenStatic
        CursorTypeDesc = "adOpenStatic"
    Case adOpenDynamic
        CursorTypeDesc = "adOpenDynamic"
    End Select
End Function
Private Function LockTypeDesc(ByVal iLT As LockTypeEnum) As String
    ' return the description for the lock type
    Select Case iLT
    Case adLockReadOnly
        LockTypeDesc = "adLockReadOnly"
    Case adLockPessimistic
        LockTypeDesc = "adLockPessimistic"
    Case adLockOptimistic
        LockTypeDesc = "adLockOptimistic"
    Case adLockBatchOptimistic
        LockTypeDesc = "adLockBatchOptimistic"
    End Select
End Function
Private Function CursorLocationDesc(ByVal iCL As CursorLocationEnum) As String
    ' return the description for the cursor location
    Select Case iCL
    Case adUseServer
        CursorLocationDesc = "adUseServer"
    Case adUseClient
        CursorLocationDesc = "adUseClient"
    End Select
End Function
Private Function CommandTypeDesc(ByVal iCT As CommandTypeEnum) As String
    ' return the description for the command type
    Select Case iCT
    Case (adCmdText And m_iadExecuteNoRecords)
        CommandTypeDesc = "adCmdText + NoRecs"
    Case (adCmdStoredProc And m_iadExecuteNoRecords)
        CommandTypeDesc = "adCmdStoredProc + NoRecs"
    Case adCmdText
        CommandTypeDesc = "adCmdText"
    Case adCmdStoredProc
        CommandTypeDesc = "adCmdStoredProc"
    Case adCmdTable
        CommandTypeDesc = "adCmdTable"
    Case m_iadCmdTableDirect
        CommandTypeDesc = "adCmdTableDirect"
    Case adCmdUnknown
        CommandTypeDesc = "adCmdUnknown"
    End Select
End Function
Private Sub Form_Unload(Cancel As Integer)
    If m_oConn.State = adStateOpen Then
        m_oConn.Close
        Set m_oConn = Nothing
    End If
End Sub
Private Sub tabTables_Click()
    ' make the appropriate frame containing the tables or
    ' queries list box, or the SQL text box visible
    
    Dim iIndex      As Integer
    iIndex = tabTables.SelectedItem.Index - 1
    If iIndex <> m_iTab Then
        fraTables(m_iTab).Visible = False
        m_iTab = iIndex
        fraTables(m_iTab).Visible = True
    End If
    chkNoRecords.Visible = (iIndex <> 0)
End Sub
Private Sub SchemaFill(lstList As ListBox, iSchemaType As SchemaEnum)
    ' fill the tables/queries list boxes
    ' Access queries appear in the tables schema as a view
    Dim oRec        As ADODB.Recordset
    Dim sField      As String
    Dim sAccView    As String               ' access view name
    Dim sType       As String
    Select Case iSchemaType
    Case adSchemaTables
        sField = "TABLE_NAME"
        sAccView = "TABLE"
        sType = "TABLE_TYPE"
    Case adSchemaProcedures
        sField = "PROCEDURE_NAME"
        sType = "PROCEDURE_TYPE"
    Case adSchemaViews
        iSchemaType = adSchemaTables
        sField = "TABLE_NAME"
        sAccView = "VIEW"
        sType = "TABLE_TYPE"
    End Select
    
    Set oRec = m_oConn.OpenSchema(iSchemaType)
    lstList.Clear
    While Not oRec.EOF
        ' skip system tables
        If oRec(sType) <> "SYSTEM TABLE" Then
            If sAccView = "" Then
                lstList.AddItem oRec(sField)
            Else
                If sAccView = oRec("TABLE_TYPE") Then
                    lstList.AddItem oRec(sField)
                End If
            End If
        End If
        oRec.MoveNext
    Wend
    
    oRec.Close
    Set oRec = Nothing
End Sub
Private Sub SetVersionSpecifics()
'
' set the ado2 specifics
' needs to be compiler directives so that this will compile on
' an ado 1.5 system
#If ADO15 Then
    m_iadCmdTableDirect = adCmdTable
    m_iadExecuteNoRecords = 128
#Else
    m_iadCmdTableDirect = adCmdTableDirect
    m_iadExecuteNoRecords = adExecuteNoRecords
#End If
End Sub

						