by eugene van staden / Credits to all whose code snippets helped (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 17th July 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Class that can be used to connect, execute stored procs or sql Statements on any database. Tested on Oracle/Access/DB2 and SQL Server
VBcoders
'****** StoredProcDLL.clsExecuteDLL ******
'****** Author: Eugene Van Staden ******
'****** email: [email protected]
'****** Date of Completion: 13/07/2001 ******
'****** Purpose: To be Used by Lotus Client To Execute ******
'****** Specific Stored Procedures with Specific ******
'****** Data to an Oracle DataBase ******
Private dbConn As ADODB.Connection
Private dbCmd As ADODB.Command
Private dbRs As ADODB.Recordset
Private m_ColCount As Long
Private m_RecCount As Long
Private m_parmIndex As Integer
Private m_parmCount As Integer
Private m_Params As New Collection
Private m_Error As String
Private m_outCount As Integer
Public bSuccess As Boolean
***
'******** CONNECTS TO DB ****************************
***
Public Sub dbConnect(sPath As String, sId As String, sPw As String)
On Error GoTo local_error
Set dbConn = New ADODB.Connection
Dim lSDSN As String
lSDSN = "DSN=" & sPath & ";Uid=" + sId + ";Pwd=" + sPw
dbConn.CursorLocation = adUseClient
dbConn.Open lSDSN
bSuccess = True ' successfull
Debug.Print "Connect"
Exit Sub
local_error:
bSuccess = False ' not successfull
m_Error = Err.Number & " : " & Err.Description
Debug.Print "Connect" & Err.Number & Err.Description
End Sub
Public Sub closeConnect()
dbConn.Close
Set dbConn = Nothing
End Sub
'*********************************************************************
'********** SETS COMMAND OBJECT **********************
'*********************************************************************
Public Sub setCommand(sStoredProc As String) 'As Integer
On Error GoTo local_error
Set dbCmd = New ADODB.Command
With dbCmd
.CommandText = sStoredProc
.CommandType = adCmdStoredProc
End With
bSuccess = True ' successfull
Exit Sub
local_error:
bSuccess = False ' not successfull
m_Error = Err.Number & " : " & Err.Description
Debug.Print "command" & Err.Number & Err.Description
End Sub
***************
'************ ADD INPUT PARAMETERS TO COMMAND OBJECT ****************************
***************
Public Sub addInputParm(sname As String, datatype As Long, Optional ssize As Long, Optional sval As Variant)
On Error GoTo local_error
dbCmd.Parameters.Append dbCmd.CreateParameter(sname, datatype, adParamInput, size, sval)
Exit Sub
local_error:
m_Error = Err.Number & " : " & Err.Description
End Sub
*********
'************* ADD OUTPUT PARAMETERS TO COMMAND OBJECT ******************
*********
Public Sub addOutputParm(sname As String, datatype As Long, Optional size As Long)
On Error GoTo local_error
dbCmd.Parameters.Append dbCmd.CreateParameter(sname, datatype, adParamOutput, size)
Exit Sub
local_error:
m_Error = Err.Number & " : " & Err.Description
End Sub
***********************
'********* ADD OUTPUT/INPUT PARAMETERS TO COMMAND OBJECT ************************************
***********************
Public Sub addInOutParm(sname As String, datatype As Long, Optional size As Long, Optional sval As Variant)
On Error GoTo local_error
dbCmd.Parameters.Append dbCmd.CreateParameter(sname, datatype, adParamInputOutput, size, sval)
Exit Sub
local_error:
m_Error = Err.Number & " : " & Err.Description
End Sub
'***************** EXECUTES COMMAND OBJECT *****************************
Public Sub executeCmd()
On Error GoTo local_error
dbCmd.ActiveConnection = dbConn
dbCmd.Execute , , adAsyncExecute
bSuccess = True
Exit Sub
local_error:
bSuccess = False
m_Error = Err.Number & " : " & Err.Description
End Sub
***
'******** CLOSES THE CONNECTION WHEN FINISHED ********************
***
Private Sub Class_Terminate()
Set dbCmd = Nothing
End Sub
'********************* PARAMETERS ***************************************
****
'************ DISPLAY PARAMETERS COUNT *************************
****
'testing phase
Public Property Get ParamCount() As Integer
On Error GoTo local_error
m_parmCount = dbCmd.Parameters.Count
cmdParamCount = m_parmCount
local_error:
m_Error = Err.Number & " : " & Err.Description
End Property
*****
'************ DISPLAY OUTPUT PARAMETER'S NAME *********************
*****
'testing phase
Public Function ParamName(nIndex As Integer) As String
On Error GoTo local_error
If dbCmd.Parameters(nIndex).Direction = adParamOutput Then
showParameter = dbCmd.Parameters(nIndex).Name
End If
local_error:
m_Error = Err.Number & " : " & Err.Description
End Function
******************
'***ASSIGN AND READ OUTPUTPARAMETERS VALUE ONE AT A TIME BASED ON INDEX SENT BY CLIENT APP*
******************
'testing phase
Public Function NameValue(sname As String) As Variant
On Error GoTo local_error
If dbCmd.Parameters(sname).Direction = adParamOutput Or adParamInputOutput Then
OutParmValue = dbCmd.Parameters(sname).Value
End If
local_error:
m_Error = Err.Number & " : " & Err.Description
End Function
Public Function IndexValue(nIndex As Integer) As Variant
On Error GoTo local_error
If dbCmd.Parameters(nIndex).Direction = adParamOutput Or adParamInputOutput Then
OutParmValue = dbCmd.Parameters(nIndex).Value
End If
local_error:
m_Error = Err.Number & " : " & Err.Description
End Function
***************
'************ RETURN OUTPUT PARAMETERS VALUES IN AN ARRAY ********************
***************
' tesing phase
Public Function OutParmsValues() As Variant()
On Error GoTo local_error
Dim xOutCount As Integer
Dim i As Integer
Dim temp() As Variant
xOutCount = 0
For i = 0 To (dbCmd.Parameters.Count - 1)
If dbCmd.Parameters(i).Direction = adParamOutput Or adParamInputOutput Then
xOutCount = xOutCount + 1
End If
Next i
m_outCount = xOutCount
ReDim temp(1 To m_outCount)
For i = 1 To m_outCount
temp(i) = dbCmd.Parameters(i).Value
'ADD VALUE AND NAME AS KEY IN COLLECTION
m_Params.Add dbCmd.Parameters(i).Value, dbCmd.Parameters(i).Name
Next i
OutParmsValues = temp()
local_error:
m_Error = Err.Number & " : " & Err.Description
End Function
'**************************************************************
'************* READ Params COLLECTION ***********************
'**************************************************************
Public Property Get Params() As Collection
Set Params = m_Params
End Property
'********** ERROR CODE & DESCRIPTION OF ANY ERROR IN DLL *********
Public Property Get Error() As String
Error = m_Error
End Property
**
'******* RETURN OUTPUT PARAMETER COUNT *******************************
**
Public Property Get outCount() As Integer
outCount = m_outCount
End Property
'''*********** READ RECORDCOUNT OF RS ***********************
Public Property Get dbRecCount() As Long
dbRecCount = m_RecCount
End Property
'************ READ THE RECORDCOUNT RETURNED FROM SP *****************
Public Property Get dbColumnCount() As Long
dbColumnCount = m_ColCount
End Property
''
'''*********** IF NOT executeCMD() THEN ISSUE THESE SUBS *************
'''********** RETURNS ADODB>RECORDSET OBJECT ***************
Public Function GetRS() As ADODB.Recordset
On Error GoTo getRs_Err
Set dbRs = New ADODB.Recordset
With dbRs
.ActiveConnection = dbConn
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
'.Source = dbCmd
'.Open
End With
Set dbRs = dbCmd.Execute
m_ColCount = dbRs.Fields.Count
m_RecCount = dbRs.RecordCount
dbRs.Close
Set GetRS = dbRs
Exit Function
getRs_Err:
Debug.Print Err.Number & Err.Description
End Function
'************* RETURN 2D ARRAY OBJECT WITH RS VALUES
Function returnArrayRS(oRs As ADODB.Recordset) As Variant()
Dim varTemp() As Variant
Dim fldThis As ADODB.Field
Dim nIndex As Integer
ReDim varTemp(1 To oRs.Fields.Count, 0 To 0) As Variant
nIndex = 1
For Each fldThis In oRs.Fields
varTemp(nIndex, 0) = fldThis.Name
nIndex = nIndex + 1
Next fldThis
oRs.MoveFirst
Do While Not oRs.EOF
ReDim Preserve varTemp(LBound(varTemp, 1) To UBound(varTemp, 1), LBound(varTemp, 2) To (UBound(varTemp, 2) + 1)) As Variant
For nIndex = LBound(varTemp, 1) To UBound(varTemp, 1)
varTemp(nIndex, UBound(varTemp, 2)) = oRs.Fields(varTemp(nIndex, 0)).Value
Next nIndex
oRs.MoveNext
Loop
returnArrayRS = varTemp()
End Function
No comments have been posted about Class that can be used to connect, execute stored procs or sql Statements on any database. Tested o. Why not be the first to post a comment about Class that can be used to connect, execute stored procs or sql Statements on any database. Tested o.
