asp-classic-unified-framework/core/lib.Data.asp

<%
Class Database_Class
    Private m_connection
    Private m_connection_string
    Private m_shape_connections

    Private m_trace_enabled
    Public Sub set_trace(bool) : m_trace_enabled = bool : End Sub
    Public Property Get is_trace_enabled : is_trace_enabled = m_trace_enabled : End Property

    Private Sub Class_Initialize
        Set m_shape_connections = Server.CreateObject("Scripting.Dictionary")
    End Sub

    '---------------------------------------------------------------------------------------------------------------------
    Public Sub Initialize(connection_string)
        m_connection_string = connection_string
    End Sub

    '---------------------------------------------------------------------------------------------------------------------
    ' MSDataShape opens its own dedicated connection per call (it cannot reuse
    ' the plain Connection() used by Query/PagedQuery). That connection is
    ' tracked and closed in Class_Terminate rather than left open until the
    ' object is garbage collected.
    Public Function ShapeQuery(sql, params)
        Dim shapeConn, cmd, rs, key

        Set shapeConn = Server.CreateObject("adodb.connection")
        shapeConn.ConnectionString = "Provider=MSDataShape;Data " & m_connection_string
        shapeConn.Open

        key = m_shape_connections.Count
        m_shape_connections.Add key, shapeConn

        Set cmd = Server.CreateObject("adodb.command")
        Set cmd.ActiveConnection = shapeConn
        cmd.CommandText = sql

        If IsArray(params) then
            Set rs = cmd.Execute(, params)
        ElseIf Not IsEmpty(params) then    ' one parameter
            Set rs = cmd.Execute(, Array(params))
        Else
            Set rs = cmd.Execute()
        End If

        Set ShapeQuery = rs
    End Function

    Public Function Query(sql, params)
        Dim cmd, rs
        Set cmd = Server.CreateObject("adodb.command")
        Set cmd.ActiveConnection = Connection
        cmd.CommandText = sql

        If IsArray(params) then
            Set rs = cmd.Execute(, params)
        ElseIf Not IsEmpty(params) then    ' one parameter
            Set rs = cmd.Execute(, Array(params))
        Else
            Set rs = cmd.Execute()
        End If

        Set Query = rs
    End Function

    '---------------------------------------------------------------------------------------------------------------------
    ' per_page/page_num were previously accepted but ignored - PageSize,
    ' CacheSize, and AbsolutePage were hardcoded to 1 regardless of the
    ' arguments passed in, so paging never actually worked. page_num is
    ' clamped to a valid page (1..PageCount) since AbsolutePage raises an
    ' error outside that range, and honoring the caller's page_num means an
    ' out-of-range value is now reachable where it previously never was.
    Public Function PagedQuery(sql, params, per_page, page_num)
        Dim cmd, rs
        Set cmd = Server.CreateObject("adodb.command")
        Set cmd.ActiveConnection = Connection
        cmd.CommandText = sql

        cmd.CommandType = 1                         'adCmdText
        cmd.ActiveConnection.CursorLocation = 3     'adUseClient

        If IsArray(params) then
            Set rs = cmd.Execute(, params)
        ElseIf Not IsEmpty(params) then    ' one parameter
            Set rs = cmd.Execute(, Array(params))
        Else
            Set rs = cmd.Execute()
        End If

        If Not rs.EOF then
            rs.PageSize = per_page
            rs.CacheSize = per_page

            If page_num < 1 Then page_num = 1
            If page_num > rs.PageCount Then page_num = rs.PageCount
            rs.AbsolutePage = page_num
        End If

        Set PagedQuery = rs
    End Function

    '---------------------------------------------------------------------------------------------------------------------
    Public Sub [Execute](sql, params)
        me.query sql, params
    End Sub

    '---------------------------------------------------------------------------------------------------------------------
    Public Sub BeginTransaction
        Connection.BeginTrans
    End Sub

    Public Sub RollbackTransaction
        Connection.RollbackTrans
    End Sub

    Public Sub CommitTransaction
        Connection.CommitTrans
    End Sub

    '---------------------------------------------------------------------------------------------------------------------
    ' Private Methods
    '---------------------------------------------------------------------------------------------------------------------
    Private Sub Class_terminate
        Destroy m_connection

        Dim key
        If Not m_shape_connections Is Nothing Then
            For Each key In m_shape_connections.Keys
                Destroy m_shape_connections(key)
            Next
            Set m_shape_connections = Nothing
        End If
    End Sub

    Public Function Connection
        if not isobject(m_connection) then
            set m_connection = Server.CreateObject("adodb.connection")
            m_connection.open m_connection_string
        end if
        set Connection = m_connection
    End Function
end Class
%>