vbscript ADO连接类

Posted 2021-05-21

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsADOConnection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'@Folder("Database Management")
 
Const sModule As String = "clsADOConnection"
 
'==================================================================================================================================================
'   MEMBER CONSTANTS
'==================================================================================================================================================
 
 
'==================================================================================================================================================
'   MEMBER VARIABLES
'==================================================================================================================================================
Private oConn                          As ADODB.Connection
Private oLastError                     As String
Private oError                         As Boolean
 
'==================================================================================================================================================
'   PROPERTIES
'==================================================================================================================================================
 
Public Property Get Conn() As ADODB.Connection
    Set Conn = oConn
End Property
 
Public Property Set Conn(ByVal objConn As ADODB.Connection)
    Set oConn = objConn
End Property
 
Public Property Get LastError() As String
    LastError = oLastError
End Property
Public Property Get Error() As Boolean
    Error = oError
End Property

'==================================================================================================================================================
'   CLASS EVENTS
'==================================================================================================================================================
 
Private Sub Class_Initialize()
End Sub
 
Private Sub Class_Terminate()
'close connection
    CloseADOConnection
End Sub
 
Public Function Init(CONNECTION_STRING As String) As clsADOConnection
    OpenADOConnection CONNECTION_STRING
    Set Init = Me
End Function
 
'==================================================================================================================================================
'   METHODS
'==================================================================================================================================================
 
Private Sub OpenADOConnection(CONNECTION_STRING As String)
    On Error GoTo ADOError
 
'   Connection object
    Set oConn = New ADODB.Connection
    oConn.Open CONNECTION_STRING
    Debug.Print Now & "Connection state: " & oConn.State
    If Not oConn.State = adStateOpen Then
        oError = True
        oLastError = "Connection error"
    End If
 
ExitHere:
    Exit Sub
ADOError:
    Dim Errs As ADODB.Errors
    Dim errLoop As ADODB.Error
    Dim strErr As String
    Dim i As Long
    i = 1
    ' Process
     strErr = strErr & vbCrLf & "VB Error # " & Str(Err.Number)
     strErr = strErr & vbCrLf & "   Generated by " & Err.Source
     strErr = strErr & vbCrLf & "   Description  " & Err.Description
    
    ' Enumerate Errors collection and display properties of each Error object.
     Set Errs = oConn.Errors
     For Each errLoop In Errs
          With errLoop
            strErr = strErr & vbCrLf & "Error #" & i & ":"
            strErr = strErr & vbCrLf & "   ADO Error   #" & .Number
            strErr = strErr & vbCrLf & "   Description  " & .Description
            strErr = strErr & vbCrLf & "   Source       " & .Source
            i = i + 1
        End With
    Next errLoop
    oLastError = strErr
    Err.Clear
    Err.Clear: Resume ExitHere
End Sub
 
Private Sub CloseADOConnection()
 
    If Not oConn Is Nothing Then
        If oConn.State = adStateOpen Then oConn.Close
        Debug.Print Now & "Connection state: " & oConn.State
    End If
    Set oConn = Nothing
 
End Sub