• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Class that can be used to connect, execute stored procs or sql Statements on any database. Tested o

Class that can be used to connect, execute stored procs or sql Statements on any database. Tested o

Class that can be used to connect, execute stored procs or sql Statements on any database. Tested on Oracle/Access/DB2 and SQL Server

Rate Class that can be used to connect, execute stored procs or sql Statements on any database. Tested o

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'******        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