by Muhammad Musa Ali (6 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 11th August 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Modified Data Access Class - This class is the modified version of my earlier uploaded Database Access Class. It contains some new features
API Declarations
Public Conn As Connection ' made Public for use
Public cmd As ADODB.Command ' to call the stored
Public prm As ADODB.Parameter ' procedures
VBcoders
Public Sub Connect()
Dim strConn As String
Set Conn = New Connection
Conn.CursorLocation = adUseClient
' connection string for SQL Server, you will have to change only this connection string
' for a different database
strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + mUsr + ";" _
+ "Password=" + mPwd + ";Initial Catalog= " + mDb + " ; Data Source=" + mServer + ""
Conn.Open strConn
End Sub
Public Function GetRst(ByVal strQuery As String, ByRef rstResult As ADODB.Recordset) As Boolean
Dim rst As New ADODB.Recordset
Conn.CommandTimeout = 30
'rst.Open strQuery, Conn, adOpenDynamic
rst.Open strQuery, Conn, adOpenDynamic, adLockOptimistic
If rst.RecordCount <= 0 Or rst.EOF Then
GetRst = False
Else
GetRst = True
End If
Set rstResult = rst
End Function
' takes the query as a string and returns the forward only recordset using Command Object
Public Function GetFoRst(strQuery As String, ByRef rst As ADODB.Recordset) As Boolean
Dim oCommand As New ADODB.Command
Dim strCmd As String
' specify the connection
oCommand.ActiveConnection = Conn
' build the command
strCmd = strQuery
oCommand.CommandText = strCmd
oCommand.CommandTimeout = 30
' execute the command
Set rst = oCommand.Execute
If rst.RecordCount <= 0 Then
GetFoRst = False
Else
GetFoRst = True
End If
End Function
' takes an update or delete query as string and updates the database
' uses Command object
Public Function UpdateIt(ByVal strQuery As String) As Boolean
On Error GoTo errhandler
Dim oCommand As New ADODB.Command
Dim lngRecord As Long
Dim i As Integer
' specify the connection
oCommand.ActiveConnection = Conn
' prepare the sql command
oCommand.CommandText = strQuery
' execute the command
oCommand.Execute lngRecord
If lngRecord <= 0 Then
UpdateIt = False
Else
UpdateIt = True
End If
Exit Function
errhandler:
UpdateIt = False
End Function
' for cleaning up any opened recordset
Public Sub CloseRst(rst As ADODB.Recordset)
If Not rst Is Nothing Then
If rst.State = adStateOpen Then
rst.Close
End If
Set rst = Nothing
End If
End Sub
' release the connection object
Public Sub DisConnect()
' to release the resources
If Not Conn Is Nothing Then
If Conn.State = adStateOpen Then
Conn.Close
End If
Set Conn = Nothing
End If
End Sub
' returns the two dimensional array from the retrieved recordset
Public Function GettRows(ByVal strQuery As String, avarData As Variant) As Boolean
On Error GoTo errorhandler
Dim strCmd As String
Dim lngNumber As Long
Dim oCommand As New ADODB.Command
Dim rst As New ADODB.Recordset
' specify the connection
oCommand.ActiveConnection = Conn
' build the command
strCmd = strQuery
oCommand.CommandText = strCmd
oCommand.CommandTimeout = 30
' execute the command
Set rst = oCommand.Execute
' getting the 2-d matrix
lngNumber = rst.RecordCount
If lngNumber > 0 Then
avarData = rst.GetRows()
If lngNumber > UBound(avarData, 2) + 1 And Not rst.EOF Then
GettRows = False
Else
GettRows = True
End If
Else
GettRows = False
End If
' closing the opened rst
rst.Close
Set rst = Nothing
Exit Function
errorhandler:
GettRows = False
End Function
' sets the Command
Public Sub setCommand(strStoredProc As String) 'As Integer
Set cmd = New ADODB.Command
With cmd
.CommandText = strStoredProc
.CommandType = adCmdStoredProc
End With
End Sub
' adds input parameters to command object
Public Sub addInParam(strName As String, lngDataType As Long, Optional lngSize As Long, Optional sval As Variant)
Set prm = cmd.CreateParameter(strName, lngDataType, adParamInput, lngSize, sval)
cmd.Parameters.Append prm
End Sub
' adds output parameters to command object
Public Sub addOutParam(strName As String, lngDataType As Long, Optional lngSize As Long, Optional sval As Variant)
Set prm = cmd.CreateParameter(strName, lngDataType, adParamOutput, lngSize, sval)
cmd.Parameters.Append prm
End Sub
' executes the command object and returns a recordset
Public Function exeCmdforRst() As Recordset
Dim rst As ADODB.Recordset
Conn.CursorLocation = adUseClient
cmd.ActiveConnection = Conn
Set rst = cmd.Execute
Set exeCmdforRst = rst
End Function
' executes the command object only
Public Sub executeCmd()
Conn.CursorLocation = adUseClient
cmd.ActiveConnection = Conn
cmd.Execute
End Sub
'executes the command object - contribution from Ram
Public Sub execCmd(ByVal cmdObject) 'As Boolean
Dim oCommand As New ADODB.Command
'assign the command object argument to the local variable
Set oCommand = cmdObject
' specify the connection
oCommand.ActiveConnection = Conn
' execute the command
oCommand.Execute
End Sub
'new inclusion - contribution from Ram
'to begin a new transaction
Public Sub BeginTrans()
Conn.BeginTrans
End Sub
'new inclusion - contribution from Ram
'to close the current transaction
Public Sub CommitTrans()
Conn.CommitTrans
End Sub
' new inclusion - contribution from Ram
'to rollback the current transaction updates
Public Sub RollbackTrans()
Conn.RollbackTrans
End Sub
No comments have been posted about Modified Data Access Class - This class is the modified version of my earlier uploaded Database Acc. Why not be the first to post a comment about Modified Data Access Class - This class is the modified version of my earlier uploaded Database Acc.