VBScript 教程之数据库篇

VBScript 教程之数据库篇，以 vbscript DBHelper 类的方式，封装数据库连接、查询、基本的存储过程访问方法。

option Explicit
' 数据库读取选项
Public Const adOpenStatic = 3
Public Const adLockReadOnly = 1
Public Const adLockOptimistic = 3

Public Const adCmdStoredProc = 4
Public Const adInteger=3
Public Const adChar=129
Public Const adVarchar = 200
Public Const adDate=7
Public Const adParamInput=1
Public Const adParamReturnValue=4

Public Const LogTypeInfo = 0
Public Const LogTypeError = 1
Public Const LogTypeWarning = 2

Class DBHelper
    Private oConn
    Private Sub Class_Initialize
        Set oConn = Nothing
    End Sub

    ' ***************************************************************************
    ' 创建 ADODB.Connection 对象，连接数据库
    ' ***************************************************************************
    Public Function Connect(server, database, uid, password)
        Dim sDSNRef
        Dim sMsg

        ' 创建 ADO 数据库连接对象
        On Error Resume Next
        Set oConn = CreateObject("ADODB.Connection")
        If Err then
            ShowMessage "错误 - 无法创建 ADODB.Connection 对象, 不能查询 SQL Server: " & Err.Description & " (" & Err.Number & ")", LogTypeError
            Set Connect = Nothing
            Exit Function
        End If
        On Error Goto 0

        ' 构建连接字符串
        sDSNRef = "Provider=SQLOLEDB;OLE DB Services=0;Data Source=" & server & ";Initial Catalog=" & database
        sDSNRef = sDSNRef & ";User ID=" & uid & ";Password=" & password

        ' 正在连接数据库
        ShowMessage "Connecting to SQL Server using connect string: " & sDSNref, LogTypeInfo
        On Error Resume Next
        oConn.Open sDSNref
        If Err then
            sMsg = Err.Description & " (" & Err.Number & ")"

            ShowMessage "error opening SQL connection: " & sMsg, LogTypeError

            iRetVal = Failure
            ShowMessage "error opening SQL Connection: " & sMsg, LogTypeError
            For each objErr in oConn.Errors
                ShowMessage "  ADO error: " & objErr.Description & " (Error #" & objErr.Number & "; Source: " & objErr.Source & "; SQL State: " & objErr.SQLState & "; NativeError: " & objErr.NativeError & ")", LogTypeError
            Next
            Err.Clear
            Set Connect = Nothing
            Exit Function
        End If
        On Error Goto 0

        ShowMessage "Successfully opened connection to database.", LogTypeInfo

        ' Return the connection to the caller
        Set Connect = oConn
    End Function
    ' ***************************************************************************
    ' 创建 ADODB.Recordset 对象，执行数据库查询，返回 Recordset 对象。
    ' ***************************************************************************
    Public Function Query(strSQL)
        Dim oRS
        ' Create ADO recordset object
        On Error Resume Next
        Set oRS = CreateObject("ADODB.Recordset")
        If Err then
            Set Query = Nothing
            ShowMessage "ERROR - Unable to create ADODB.Recordset object, impossible to query SQL Server: " & Err.Description & " (" & Err.Number & ")", LogTypeError
            Exit Function
        End If
        On Error Goto 0

        ' Issue the SQL statement
        ShowMessage "About to issue SQL statement: " & strSQL, LogTypeInfo
        On Error Resume Next
        oRS.Open strSQL, oConn, adOpenStatic, adLockReadOnly
        If Err then
            Set Query = Nothing
            ShowMessage "ERROR - Opening Record Set (Error Number = " & Err.Number & ") (Error Description: " & Err.Description & ").", LogTypeError
            For each objErr in oConn.Errors
                ShowMessage "  ADO error: " & objErr.Description & " (Error #" & objErr.Number & "; Source: " & objErr.Source & "; SQL State: " & objErr.SQLState & "; NativeError: " & objErr.NativeError & ")", LogTypeError
            Next
            oRS.Close
            Err.Clear
            Exit Function
        End If
        On Error Goto 0

        ShowMessage "Successfully queried the database.", LogTypeInfo
        Set Query = oRS
    End Function
    ' ***************************************************************************
    ' 创建 ADODB.Command 对象，执行数据库存储过程，返回 Command 对象。
    ' 注意：存储过程要求，没有返回值对象，返回值以Select方式返回，存储过程需要使用
    ' set nocount on，禁用影响行数消息。
    ' ***************************************************************************
    Public Function ExecuteProc(strSQL)
        Dim oComm,oRS
        ' Create ADO recordset object
        On Error Resume Next
        Set oComm = CreateObject("ADODB.Command")
        If Err then
            Set ExecuteProc = Nothing
            ShowMessage "ERROR - Unable to create ADODB.Command object, impossible to query SQL Server: " & Err.Description & " (" & Err.Number & ")", LogTypeError
            Exit Function
        End If
        On Error Goto 0
        ' 分解参数
        Dim sql,cmd,parm,parms,p,index
        sql = Split(strSQL," ")
        If UBound(sql) = 1 Then
            cmd = sql(0)
            parm = Right(strSQL,Len(strSQL)-Len(cmd))
            parms = Split(parm,",")
            index = 0
            For Each p In parms
                p = LTrim(Replace(p,"'",""))
                Dim para
                Set para = CreateObject("ADODB.Parameter")
                para.Name = index
                para.Type = adVarchar
                para.Size = 1000
                para.Direction = adParamInput
                para.Value = p
                oComm.Parameters.Append para
                index = index + 1
            Next
        Else
            cmd = strSQL
        End If

        ' Issue the SQL statement
        ShowMessage "About to issue SQL statement: " & strSQL, LogTypeInfo
        On Error Resume Next
        oComm.CommandType = adCmdStoredProc
        oComm.ActiveConnection = oConn
        oComm.CommandText = cmd
        Set oRS = oComm.Execute
        If Err then
            Set ExecuteProc = Nothing
            ShowMessage "ERROR - Opening Command (Error Number = " & Err.Number & ") (Error Description: " & Err.Description & ").", LogTypeError
            For each objErr in oConn.Errors
                ShowMessage "  ADO error: " & objErr.Description & " (Error #" & objErr.Number & "; Source: " & objErr.Source & "; SQL State: " & objErr.SQLState & "; NativeError: " & objErr.NativeError & ")", LogTypeError
            Next
            oComm.Close
            Err.Clear
            Set ExecuteProc = Nothing
            Exit Function
        End If
        On Error Goto 0

        ShowMessage "Successfully queried the database.", LogTypeInfo
        Set ExecuteProc = oRS
    End Function
End Class