by Gideon Cole (3 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 11th July 1999
Date Added: Mon 8th February 2021
Rating: (1 Votes)
Simplifies ADO 2.x access.
Private Const ConstCommandTimeout = 60
Private Const ConstDatabaseTimeout = 60
Private oDBConnection As New ADODB.Connection
Private oADOCommand As New ADODB.Command
Private oDbRecordSet As New ADODB.Recordset
Attribute oDbRecordSet.VB_VarHelpID = -1
Private iADODatabaseTimeout As Integer
Private iADOCommandTimeout As Integer
Private iCacheSize As Integer
Private lResult As Long
Private sDSN As String
Private sUserName As String
Private sPassword As String
Private sDatabase As String
Private lErrorNumber As Long
Private sErrorDescription As String
Private sErrorPlace As String
Private sODBCString As String
Private sProviderString As String
Private bLogFile As Boolean
Private sLogFilePath As String
Private iLogFileNumber As Integer
Private sSQLString As String
Private bProviderConnection As Boolean
Private bLogging As Boolean
Public Property Let LogFilePath(ByVal vData As String)
sLogFilePath = vData
End Property
Public Property Get LogFilePath() As String
LogFilePath = sLogFilePath
End Property
Public Property Let Logging(ByVal vData As Boolean)
bLogging = vData
End Property
Public Property Get Logging() As Boolean
Logging = bLogging
End Property
Public Property Get Connection() As ADODB.Connection
Set Connection = oDBConnection
End Property
Public Sub Class_Initialize()
On Error GoTo errhandler
Call Initialize
Exit Sub
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Class_Initialize()"
End Sub
Private Sub Initialize()
bLogging = False
iADOCommandTimeout = ConstCommandTimeout
iADODatabaseTimeout = ConstDatabaseTimeout
sDSN = ""
sUserName = ""
sPassword = ""
sDatabase = ""
sODBCString = ""
sSQLString = ""
lErrorNumber = 0
sErrorDescription = ""
sErrorPlace = ""
sODBCString = ""
sProviderString = ""
sSQLString = ""
sLogFilePath = ""
End Sub
Public Sub Class_Terminate()
Call Initialize
If (oDBConnection.State = 1) Then
Me.CloseConnection
End If
End Sub
Public Property Get VersionInfo() As String
VersionInfo = App.Path + "\" + App.EXEName + "." + TypeName(Me) + _
" " + CStr(App.Major) + _
" . " + CStr(App.Minor) + " . " + CStr(App.Revision)
End Property
Public Property Get GetErrorNumber() As Long
GetErrorNumber = lErrorNumber
End Property
Public Property Get GetErrorDescription() As String
GetErrorDescription = sErrorDescription
End Property
Public Property Get GetErrorPlace() As String
GetErrorPlace = sErrorPlace
End Property
Public Property Let DSN(ByVal inDSN As String)
sDSN = inDSN
End Property
Public Property Get DSN() As String
DSN = sDSN
End Property
Public Property Get RecordCount() As Integer
RecordCount = oDbRecordSet.RecordCount
End Property
Public Property Let CacheSize(ByVal inCacheSize As Integer)
iCacheSize = inCacheSize
End Property
Public Property Get CacheSize() As Integer
CacheSize = iCacheSize
End Property
Public Property Let MaxRecords(ByVal inMaxRecords As Double)
On Error GoTo errhandler
If (inMaxRecords > 0) Then
oDbRecordSet.MaxRecords = inMaxRecords
End If
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let MaxRecords()"
End Property
Public Property Get MaxRecords() As Double
On Error GoTo errhandler
MaxRecords = oDbRecordSet.MaxRecords
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get MaxRecords()"
End Property
Public Property Let ProviderConnection(ByVal inValue As Boolean)
On Error GoTo errhandler
bProviderConnection = inValue
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let ProviderConnection()"
End Property
Public Property Get ProviderConnection() As Boolean
On Error GoTo errhandler
ProviderConnection = bProviderConnection
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get ProviderConnection()"
End Property
Public Property Let ADODatabaseTimeout(ByVal inADODatabaseTimeout As Integer)
On Error GoTo errhandler
iADODatabaseTimeout = inADODatabaseTimeout
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let ADODatabaseTimeout()"
End Property
Public Property Get ADODatabaseTimeout() As Integer
On Error GoTo errhandler
ADODatabaseTimeout = iADODatabaseTimeout
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get ADODatabaseTimeout()"
End Property
Public Property Let ADOCommandTimeout(ByVal inADOCommandTimeout As Integer)
On Error GoTo errhandler
iADOCommandTimeout = inADOCommandTimeout
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let ADOCommandTimeout()"
End Property
Public Property Get ADOCommandTimeout() As Integer
On Error GoTo errhandler
ADOCommandTimeout = iADOCommandTimeout
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get ADOCommandTimeout()"
End Property
Public Property Let UserName(ByVal inUserName As String)
On Error GoTo errhandler
sUserName = inUserName
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let UserName()"
End Property
Public Property Get UserName() As String
On Error GoTo errhandler
UserName = sUserName
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get UserName()"
End Property
Public Property Let Password(ByVal inPassword As String)
On Error GoTo errhandler
sPassword = inPassword
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let Password()"
End Property
Public Property Get Password() As String
On Error GoTo errhandler
Password = sPassword
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get Password()"
End Property
Public Property Let Database(ByVal inDatabase As String)
On Error GoTo errhandler
sDatabase = inDatabase
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let Database()"
End Property
Public Property Get Database() As String
On Error GoTo errhandler
Database = sDatabase
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get Database()"
End Property
Public Property Let Provider(ByVal inProviderString As String)
On Error GoTo errhandler
sProviderString = inProviderString
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let Provider()"
End Property
Public Property Get Provider() As String
On Error GoTo errhandler
Provider = sProviderString
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get Provider()"
End Property
Public Property Let ODBCString(ByVal inODBCString As String)
On Error GoTo errhandler
sODBCString = inODBCString
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let ODBCString()"
End Property
Public Property Get ODBCString() As String
On Error GoTo errhandler
ODBCString = sODBCString
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get ODBCString()"
End Property
Public Property Let SQLString(ByVal inSQLString As String)
On Error GoTo errhandler
sSQLString = inSQLString
oADOCommand.CommandText = sSQLString
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let SQLString()"
End Property
Public Property Get SQLString() As String
On Error GoTo errhandler
SQLString = sSQLString
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get SQLString()"
End Property
Public Property Let ADOCommandText(ByVal inText As String)
On Error GoTo errhandler
oADOCommand.CommandText = inText
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Let ADOCommandText()"
End Property
Public Property Get ADOCommandText() As String
On Error GoTo errhandler
ADOCommandText = oADOCommand.CommandText
Exit Property
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get ADOCommandText()"
End Property
Public Function SetODBCString(Optional ByVal inDSN As String, Optional ByVal inUserName As String, Optional ByVal inPassword As String, Optional ByVal inDatabase As String) As Boolean
On Error GoTo errhandler
Dim TheDSN As String
Dim TheUserName As String
Dim ThePassword As String
Dim TheDatabase As String
SetODBCString = False
If (inDSN = "") Then
If (sDSN = "") Then
Exit Function
Else
TheDSN = sDSN
End If
Else
TheDSN = inDSN
End If
If (inUserName = "") Then
If (sUserName = "") Then
Exit Function
Else
TheUserName = sUserName
End If
Else
TheUserName = inUserName
End If
If (inPassword = "") Then
If (sPassword = "") Then
Exit Function
Else
ThePassword = sPassword
End If
Else
ThePassword = inPassword
End If
If (inDatabase = "") Then
If (sDatabase = "") Then
Exit Function
Else
TheDatabase = sDatabase
End If
Else
TheDatabase = inDatabase
End If
sODBCString = "DSN=" & TheDSN & ";uid=" & TheUserName & ";pwd=" & ThePassword & ";database=" & TheDatabase
SetODBCString = True
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Set SetODBCString()"
SetODBCString = False
End Function
Public Function GetState() As Integer
On Error GoTo errhandler
GetState = oDBConnection.State
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "Get State()"
GetState = lErrorNumber
End Function
Public Function OpenODBCConnection() As Long
On Error GoTo errhandler
If (ODBCString = "") Then
OpenODBCConnection = -2
Else
oDBConnection.Open sODBCString
If (oDBConnection.State = 1) Then
Set oADOCommand.ActiveConnection = oDBConnection
oDbRecordSet.CursorLocation = adUseClient
OpenODBCConnection = 0 'OK
Else
OpenODBCConnection = -1 'Error
End If
End If
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "CRVADOAccess.OpenODBCConnection()"
OpenODBCConnection = lErrorNumber
End Function
Public Function OpenProviderConnection() As Long
On Error GoTo errhandler
If (sProviderString = "") Then
OpenProviderConnection = -2
Else
oDBConnection.Open sProviderString
If (oDBConnection.State = 1) Then
oDbRecordSet.CursorLocation = adUseClient
Set oADOCommand.ActiveConnection = oDBConnection
OpenProviderConnection = 0 'OK
Else
OpenProviderConnection = -1 'Error
End If
End If
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "CRVADOAccess.OpenProviderConnection()"
OpenProviderConnection = lErrorNumber
End Function
Public Function SubmitQuery(Optional ByRef inSQLString As String, _
Optional ByRef inCursor As String) As Long
On Error GoTo errhandler
Dim sCursor As String
If (Len(inCursor) > 0) Then
sCursor = inCursor
Else
sCursor = adOpenForwardOnly
End If
'Check if Connected
If (oDBConnection.State = 0) Then 'Not Connected
If (ProviderConnection) Then
lResult = OpenProviderConnection
Else
lResult = OpenODBCConnection
End If
If (lResult <> 0) Then
Exit Function
End If
End If
'Check if Record Set Open
If (oDbRecordSet.State <> 0) Then 'RecordSet is open
oDbRecordSet.Close
End If
'Check if SQL in method call
If (inSQLString = "") Then
If (bLogging) Then
WriteLogRecord oADOCommand.CommandText
End If
oDbRecordSet.Open oADOCommand, oDBConnection, sCursor
Else
If (bLogging) Then
WriteLogRecord inSQLString
End If
oADOCommand.CommandText = inSQLString
oDbRecordSet.Open oADOCommand
'Debug.Print oDbRecordSet.RecordCount
End If
SubmitQuery = 0 'Return OK
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "SubmitQuery()"
If (bLogging) Then
WriteLogRecord lErrorNumber & " " & sErrorDescription
End If
SubmitQuery = lErrorNumber 'Return Error
End Function
Public Function ADOCommandExecute() As Integer
On Error GoTo errhandler
oADOCommand.Execute
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "ADOCommandExecute()"
End Function
Public Function RetrieveRecordSet() As ADODB.Recordset
On Error GoTo errhandler
'This function returns a clone of the recordset
Set RetrieveRecordSet = oDbRecordSet.Clone
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "RetrieveRecordSet()"
Set RetrieveRecordSet = Nothing
End Function
Public Function RetrieveRecordSetPointer() As ADODB.Recordset
On Error GoTo errhandler
'This function returns a pointer to the recordset
Set RetrieveRecordSetPointer = oDbRecordSet
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "RetrieveRecordSetPointer()"
Set RetrieveRecordSetPointer = Nothing
End Function
Public Function CloseRecordSet() As Long
On Error GoTo errhandler
If (oDbRecordSet.State = 1) Then
oDbRecordSet.Close
End If
CloseRecordSet = oDbRecordSet.State
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "CloseConnection()"
End Function
Public Function CloseConnection() As Long
On Error GoTo errhandler
If (oDBConnection.State = 1) Then
oDBConnection.Close
CloseConnection = 0
Else
CloseConnection = -1
End If
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "CloseConnection()"
End Function
Public Function MoveFirst() As Boolean
On Error GoTo errhandler
oDbRecordSet.MoveFirst
MoveFirst = True
Exit Function
errhandler:
lErrorNumber = Err.Number
sErrorDescription = Err.Description
sErrorPlace = "MoveFirst()"
MoveFirst = False
End Function
Private Sub WriteLogRecord(inSQL As String)
On Error Resume Next
iLogFileNumber = FreeFile
'Check if file already exists
If (Dir(sLogFilePath) = "") Then
Open sLogFilePath For Output As #iLogFileNumber
Else
Open sLogFilePath For Append As #iLogFileNumber
End If
'Write out the record
Print #iLogFileNumber, inSQL
Close #iLogFileNumber
End Sub