www.pudn.com > ADO 2.6 Programmers Reference(Source Code).zip > Perf.frm
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