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