wsc-mvc/Framework/Database.wsc

<?xml version="1.0"?>
<?component error="true" debug="false"?>
<component>
<registration
    description="WscMvc Database"
    progid="WscMvc.Database"
    version="1.00"
    classid="{E3F7C1A2-9B4D-4E6F-8C3A-2D5B7A9E1F04}">
</registration>

<public>
    <method name="Open">
        <parameter name="connectionString"/>
    </method>
    <method name="Close"/>
    <method name="BeginTransaction"/>
    <method name="CommitTransaction"/>
    <method name="RollbackTransaction"/>
    <method name="ExecuteNonQuery">
        <parameter name="sql"/>
        <parameter name="paramOrder"/>
        <parameter name="paramsDict"/>
        <parameter name="rowsAffected"/>
    </method>
    <method name="ExecuteScalar">
        <parameter name="sql"/>
        <parameter name="paramOrder"/>
        <parameter name="paramsDict"/>
        <parameter name="result"/>
    </method>
</public>

<script language="VBScript">
<![CDATA[
Option Explicit

' Explicit, request-scoped ADODB connection/transaction/command lifecycle -
' never cached in Session/Application (SPEC SS10). Never references ASP
' intrinsics. sql uses ADO's positional "?" placeholders; paramOrder is a
' plain comma-separated string (not an array) giving the placeholder order,
' deliberately avoiding an untested VBScript-array-through-WSC-<public>
' marshaling question for zero real benefit - paramsDict (a Scripting.
' Dictionary, the same object-parameter pattern already proven by
' ViewRenderer.wsc) supplies each named value. Parameter type/size are
' inferred from VBScript VarType()/Len() - a deliberate minimal v0.1 policy,
' not a general ORM type system (SPEC SS3 non-goal).

' ADODB type/property constants (adovbs.inc is not included in a WSC script
' block; these are ADODB's own stable, documented numeric values).
Const adVarWChar = 202
Const adInteger = 3
Const adBigInt = 20
Const adDouble = 5
Const adDate = 7
Const adBoolean = 11
Const adParamInput = 1

Dim m_conn, m_isOpen

m_isOpen = False

Sub Open(connectionString)
    Set m_conn = Nothing
    On Error Resume Next
    Set m_conn = CreateObject("ADODB.Connection")
    If Err.Number = 0 Then m_conn.Open connectionString
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set m_conn = Nothing
        Err.Raise vbObjectError + 101, "WscMvc.Database", "Unable to open database connection"
    End If
    On Error Goto 0
    m_isOpen = True
End Sub

' Idempotent: safe to call even if Open was never called or Close already ran.
Sub Close()
    If m_isOpen And Not m_conn Is Nothing Then
        On Error Resume Next
        m_conn.Close
        Err.Clear
        On Error Goto 0
    End If
    Set m_conn = Nothing
    m_isOpen = False
End Sub

Sub BeginTransaction()
    RequireOpen
    On Error Resume Next
    m_conn.BeginTrans
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Err.Raise vbObjectError + 102, "WscMvc.Database", "Unable to begin transaction"
    End If
    On Error Goto 0
End Sub

Sub CommitTransaction()
    RequireOpen
    On Error Resume Next
    m_conn.CommitTrans
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Err.Raise vbObjectError + 103, "WscMvc.Database", "Unable to commit transaction"
    End If
    On Error Goto 0
End Sub

Sub RollbackTransaction()
    RequireOpen
    On Error Resume Next
    m_conn.RollbackTrans
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Err.Raise vbObjectError + 104, "WscMvc.Database", "Unable to roll back transaction"
    End If
    On Error Goto 0
End Sub

Sub ExecuteNonQuery(sql, paramOrder, paramsDict, rowsAffected)
    Dim cmd, affected
    RequireOpen

    Set cmd = Nothing
    On Error Resume Next
    Set cmd = BuildCommand(sql, paramOrder, paramsDict)
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set cmd = Nothing
        Err.Raise vbObjectError + 105, "WscMvc.Database", "Unable to prepare command"
    End If
    On Error Goto 0

    On Error Resume Next
    cmd.Execute affected
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set cmd = Nothing
        Err.Raise vbObjectError + 106, "WscMvc.Database", "Command execution failed"
    End If
    On Error Goto 0

    rowsAffected = affected
    Set cmd = Nothing
End Sub

Sub ExecuteScalar(sql, paramOrder, paramsDict, result)
    Dim cmd, rs
    RequireOpen

    Set cmd = Nothing
    On Error Resume Next
    Set cmd = BuildCommand(sql, paramOrder, paramsDict)
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set cmd = Nothing
        Err.Raise vbObjectError + 105, "WscMvc.Database", "Unable to prepare command"
    End If
    On Error Goto 0

    Set rs = Nothing
    On Error Resume Next
    Set rs = cmd.Execute()
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set rs = Nothing
        Set cmd = Nothing
        Err.Raise vbObjectError + 106, "WscMvc.Database", "Command execution failed"
    End If
    On Error Goto 0

    If rs.EOF Then
        result = Null
    Else
        result = rs.Fields(0).Value
    End If

    On Error Resume Next
    rs.Close
    Err.Clear
    On Error Goto 0
    Set rs = Nothing
    Set cmd = Nothing
End Sub

Sub RequireOpen()
    If Not m_isOpen Or m_conn Is Nothing Then
        Err.Raise vbObjectError + 100, "WscMvc.Database", "Database is not open"
    End If
End Sub

Function BuildCommand(sql, paramOrder, paramsDict)
    Dim cmd, names, i, key, value

    Set cmd = CreateObject("ADODB.Command")
    cmd.ActiveConnection = m_conn
    cmd.CommandText = sql
    cmd.CommandType = 1 ' adCmdText

    If Len(Trim(paramOrder)) > 0 Then
        names = Split(paramOrder, ",")
        For i = 0 To UBound(names)
            key = Trim(names(i))
            If paramsDict Is Nothing Or Not paramsDict.Exists(key) Then
                Err.Raise vbObjectError + 107, "WscMvc.Database", "Missing parameter value: " & key
            End If
            value = paramsDict.Item(key)
            cmd.Parameters.Append BuildParameter(cmd, key, value)
        Next
    End If

    Set BuildCommand = cmd
End Function

Function BuildParameter(cmd, name, value)
    Dim p

    If IsNull(value) Or IsEmpty(value) Then
        Set p = cmd.CreateParameter(name, adVarWChar, adParamInput, 1)
        p.Value = Null
    Else
        Select Case VarType(value)
            Case 2, 3 ' vbInteger, vbLong
                Set p = cmd.CreateParameter(name, adInteger, adParamInput, 0, CLng(value))
            Case 5, 4, 6 ' vbDouble, vbSingle, vbCurrency
                Set p = cmd.CreateParameter(name, adDouble, adParamInput, 0, CDbl(value))
            Case 7 ' vbDate
                Set p = cmd.CreateParameter(name, adDate, adParamInput, 0, CDate(value))
            Case 11 ' vbBoolean
                Set p = cmd.CreateParameter(name, adBoolean, adParamInput, 0, CBool(value))
            Case Else
                Dim s, sz
                s = CStr(value)
                sz = Len(s)
                If sz = 0 Then sz = 1
                Set p = cmd.CreateParameter(name, adVarWChar, adParamInput, sz, s)
        End Select
    End If

    Set BuildParameter = p
End Function
]]>
</script>
</component>