clsdataconnect.cls

欢迎您使用审批系统!该系统主要面向银行内部人员,但也为客户提供一些信息." 登陆,注册和管理员入口"项目专为银行内部人员设计."客户登陆,注册,贷款须知和预约"项目专为客户设计.客户可通过这些窗口浏览

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ClsDataConnect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Implements ObjectControl
'******************************************************************
' Name:       Dataconnect.Cls
'             This is used to set up  ADO connection, Execute SQL
'             statements and disconnect from data source. This is
'             to be included in all forms that call Connect(),
'             ExecuteSQL() and Disconnect() functions
'Called By:   Any Class or objec
'Calls    :   None.
'Author   :   Dinar Dalvi
'*****************************************************************
' variables for Connection,Command and RecordSet Object
Private m_Connection As Object
Private m_RecSet As Object
Private m_EndOfFile As Boolean
Private m_Error As Object

Public blnJunkVariable
Public Enum enumExecuteType
   exec_type_sql = 1
   Exec_Type_Stored_procedure = 2
End Enum
Public enumExecute As enumExecuteType

Private Sub ObjectControl_Activate()
'at present do nothing

End Sub

Private Function ObjectControl_CanbePooled() As Boolean
' allows connect to be pooled in the mts
' Mts will use the available free thread from the pool for an new process

 ObjectControl_CanbePooled = True
End Function

Private Sub ObjectControl_Deactivate()
' at present do nothing

End Sub

Public Property Get ExecuteType() As enumExecuteType
ExecuteType = enumExecute
End Property
Public Property Let ExecuteType(ReqType As enumExecuteType)
   enumExecute = ReqType
End Property
Public Property Let ConnSet(ByVal Conn As Object)
   m_Connection = Conn
End Property
Public Property Get ConnSet() As Object
   Set ConnSet = m_Connection
End Property
Public Property Let RecSet(ByVal Rc As Object)
   m_RecSet = Rc
End Property
Public Property Get RecSet() As Object
   Set RecSet = m_RecSet
End Property
Public Property Let Geterror(ByVal e_error As Object)
   m_Error = e_error
End Property
Public Property Get Geterror() As Object
   Set Geterror = m_Error
End Property

Public Property Let EndOfFile(EndFile As Boolean)
   m_EndOfFile = EndFile
End Property
Public Property Get EndOfFile() As Boolean
   EndOfFile = m_EndOfFile
End Property
'**********************************************************
' Name: Connect
' Creation Date: May 19, 1999
' Author   :   Dinar Dalvi
' Input:
' Output:
' Assumptions:
' Revision History:
'        October 21, 1999 DD  - Modified
'**********************************************************
Function Connect(ConnectionString) As Boolean
    Dim blnReturnValue
    Dim AdoCon As Object
    'blnReturnValue = False
    On Error Resume Next
        Set AdoCon = New ADODB.Connection
        AdoCon.Errors.Clear
        AdoCon.ConnectionTimeout = 480
        AdoCon.CommandTimeout = 30
        AdoCon.CursorLocation = 3
        AdoCon.Open (ConnectionString)
        x = 0
        Dim O_error As New ClsErrors

        If Err.Number <> 0 Then
        'If AdoCon.Errors.Count > 0 Then
'        If ConnSet.Errors.Count > 0 Then
'            MsgBox "Error/s Occured while executing SQL statement: Error Number " & _
'            ConnSet.Errors((ConnSet.Errors.Count) - 1).Number & " Error Desc : " & _
'            ConnSet.Errors((ConnSet.Errors.Count) - 1).Description, vbCritical, "Data Connection Module"
            For x = 0 To AdoCon.Errors.Count - 1
            ' Need to keep this for Oracle Dinar Dalvi
'                If InStr(AdoCon.Errors(x).Description, "ORA-01017") Then
'                    MsgBox "Invalid Username/Password login failed", vbCritical, "Data Connection Module"
'                    Exit For
'                Else
'                If AdoConn.Errors(x).Number = 0 Then
'                    blnReturnValue = True
'                Else
'                    MsgBox "Error : " & AdoCon.Errors(x).Number & " Description : " & AdoCon.Errors(x).description, vbCritical, "Data Connection Module"
                    O_error.Error_Desc = AdoCon.Errors(x).description
                    O_error.Error_Number = AdoCon.Errors(x).Number
                    'Geterror = True
                    Set m_Error = O_error

                    Exit Function
'                End If
            Next
        Else
            Connect = True
            'blnReturnValue = True
            Set m_Connection = AdoCon
        End If
    Set m_Connection = AdoCon
    Connect = True '  = blnReturnValue
End Function

'**********************************************************
' Name: DisConnect
' Creation Date: May 19, 1999
' Author   :   Dinar Dalvi
' Input:
' Output:
' Assumptions:
' Revision History:
'        October 21, 1999 DD  - Modified
'**********************************************************
Function DisConnect() As Boolean
    On Error Resume Next
'    Dim O_error As New ClsErrors
    
    Set m_RecSet = Nothing
    Set m_ConnSet = Nothing
    DisConnect = True
'    If Err.Number <> 0 Then
'        For x = 0 To ConnSet.Errors.Count - 1
'           O_error.Error_Desc = ConnSet.Errors(x).description
'           O_error.Error_Number = ConnSet.Errors(x).Number
'           ExecuteSQL = False
'           Set m_Error = O_error
'        Next
'    End If
    
End Function

'**********************************************************
' Name: ExecuteSQL
' Creation Date: May 19, 1999
' Author   :   Dinar Dalvi
' Input:
' Output: will return 1 if success 0 if fail 2 if error
' Assumptions:
' Revision History:
'        October 21, 1999 DD  - Modified
'**********************************************************

Function ExecuteSQL(strSQLString, Optional typ = 1) As Boolean
    'Dim blnReturnValue
    'blnReturnValue = False
    Dim Rs As New ADODB.Recordset
    Dim O_error As New ClsErrors

    EndOfFile = False
    On Error Resume Next
    
    'Set Rs = New ADODB.Recordset
    Rs.CacheSize = 10
    Rs.CursorType = 3
    Rs.CursorLocation = 3
    Rs.LockType = 1
    Rs.CursorType = adOpenKeyset
    Rs.LockType = adLockOptimistic
    Rs.ActiveConnection = ConnSet
    Rs.Open strSQLString, , , , typ
    ' will write Code to return the recordset from a stored procedure.
    ' At present only an insert stored procedure will be executed
    If Err.Number <> 0 Then
        For x = 0 To ConnSet.Errors.Count - 1
           O_error.Error_Desc = ConnSet.Errors(x).description
           O_error.Error_Number = ConnSet.Errors(x).Number
           ExecuteSQL = False
           Set m_Error = O_error
        Next
    Else
        ExecuteSQL = True
        If Rs.EOF Then
            EndOfFile = True
        Else
            EndOfFile = False
            Set m_RecSet = Rs
        End If
    End If
End Function
Public Function GetState(intState As Integer) As String
Select Case intState
      Case adStateClosed
        GetState = "adStateClosed"
      Case adStateOpen
        GetState = "adStateOpen"
End Select
End Function
Sub SetRs_State(typ As Integer)
Select Case typ
  Case 1 ' Sql script
    SQLStmt.CommandType = adCmdText
    SQLStmt.CommandTimeout = 10
  Case 2 ' Stored procedure
    SQLStmt.CommandType = adCmdStoredProc
    SQLStmt.CommandTimeout = 10
End Select
End Sub
Public Function CheckState() As Boolean
    If ConnSet Is Nothing Then
       CheckState = False
    End If
End Function