asp-classic-unified-framework/core/databaseConnection.asp

<%
'------------------------------------------------------------------------------
' DatabaseConnection.Class.inc
' A singleton VBScript "factory" for ADODB.Connection to multiple databases
' Enhanced with separate error handling for creation and open operations
'------------------------------------------------------------------------------

' Singleton holder
Dim DatabaseConnection__Singleton
Set DatabaseConnection__Singleton = Nothing

' Factory function
Function DatabaseConnection()
    If DatabaseConnection__Singleton Is Nothing Then
        Set DatabaseConnection__Singleton = New DatabaseConnection_Class
    End If
    Set DatabaseConnection = DatabaseConnection__Singleton
End Function

'------------------------------------------------------------------------------
' Class definition
'------------------------------------------------------------------------------
Class DatabaseConnection_Class
    Private conn   ' holds the ADODB.Connection instance

    '----------------------------------------
    ' Connect to an Access (.mdb/.accdb) file
    '----------------------------------------
    Public Function ConnectToAccessDatabase(dataSource, provider)
        If IsEmpty(provider) Or provider = "" Then
            provider = "Microsoft.Jet.OLEDB.4.0"
        End If
        Dim connStr
        connStr = "Provider=" & provider & ";" & _
                  "Data Source=" & dataSource & ";" & _
                  "Persist Security Info=False;"
        Set ConnectToAccessDatabase = Me.Connect(connStr)
    End Function

    '----------------------------------------
    ' Connect to SQL Server
    '----------------------------------------
    Public Function ConnectToSQLServer(server, database, uid, pwd, useTrusted)
        Dim connStr
        If useTrusted = True Then
            connStr = "Provider=SQLOLEDB;" & _
                      "Server=" & server & ";" & _
                      "Database=" & database & ";" & _
                      "Trusted_Connection=Yes;"
        Else
            connStr = "Provider=SQLOLEDB;" & _
                      "Server=" & server & ";" & _
                      "Database=" & database & ";" & _
                      "User ID=" & uid & ";" & _
                      "Password=" & pwd & ";"
        End If
        Set ConnectToSQLServer = Me.Connect(connStr)
    End Function

    '----------------------------------------
    ' Connect via ODBC DSN
    '----------------------------------------
    Public Function ConnectToODBC(dsnName, uid, pwd)
        Dim connStr
        connStr = "DSN=" & dsnName & ";"
        If Not IsEmpty(uid) Then connStr = connStr & "UID=" & uid & ";"
        If Not IsEmpty(pwd) Then connStr = connStr & "PWD=" & pwd & ";"
        Set ConnectToODBC = Me.Connect(connStr)
    End Function

    '----------------------------------------
    ' Generic Connect: opens and returns an ADODB.Connection
    ' Includes separate handling for creation and open errors
    '----------------------------------------
    Public Function Connect(connectionString)
        On Error Resume Next

        ' Dispose previous connection if any
        If Not conn Is Nothing Then
            conn.Close
            Set conn = Nothing
        End If

        ' Create ADO Connection object
        Set conn = Server.CreateObject("ADODB.Connection")
        If conn Is Nothing Then
            Err.Clear
            On Error GoTo 0
            Err.Raise 50000, _
                      "DatabaseConnection_Class.Connect", _
                      "Could not create ADODB.Connection. Ensure ADO is installed and registered."
        End If

        ' Clear any prior errors before opening
        Err.Clear

        ' Open database connection
        conn.Open connectionString
        If Err.Number <> 0 Then
            Dim lastErrNum, lastErrDesc
            lastErrNum = Err.Number
            lastErrDesc = Err.Description
            Err.Clear
            On Error GoTo 0
            Err.Raise lastErrNum, _
                      "DatabaseConnection_Class.Connect", _
                      "Failed to open connection (" & connectionString & _
                      ") - Error " & lastErrNum & ": " & lastErrDesc
        End If

        On Error GoTo 0
        Set Connect = conn
    End Function

    '----------------------------------------
    ' Close & clean up
    '----------------------------------------
    Public Sub Close()
        On Error Resume Next
        If Not conn Is Nothing Then
            conn.Close
            Set conn = Nothing
        End If
        On Error GoTo 0
    End Sub
End Class
%>