VBScript 教程之数据库篇

/article/7255283.html

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