|
Public Cnn
Set Cnn = CreateObject("ADODB.Connection")
'-----------------------------------------------------------------
'函数功能:连接数据库
'-----------------------------------------------------------------
Public Sub DBConnect(ByVal DBType,ByVal DBServer,ByVal DBUser,ByVal DBPass,ByVal DBName)
On error resume Next
Dim StrCon,rel
Select Case DBType
Case 0 'Sql Server
StrCon = "Provider=MSDASQL;Driver={SQL Server};Server="&DBServer&";Database="&DBName&";Uid="&DBUser&";Pwd="&DBPass&";"
Case 1 'Oracle
StrCon = "Provider=MSDAORA.1;Data Source="&DBServer&";Password="&DBPass&";User ID="&DBUser&";Persist Security Info=True"
Case 2 'Sybase
StrCon = "Driver={SYBASE SYSTEM 11};Srvr="&DBServer&";Uid="&DBUser&";Pwd="&DBPass&";Database="&DBName&";"
Case 3 'Access
StrCon = "Driver={Microsoft Access Driver (*.mdb)};Dbq="&DBName&";Uid="&DBUser&";Pwd="&DBPass&";"
End Select
Cnn.Open StrCon
rel = chkDBError()
If rel = true Then
MsgBox "数据库连接失败,测试中止!"
On Error GoTo 0
Else
Reporter.ReportEvent micPass,"数据库已建立连接! StrCon = " &strCon
End If
End Sub
'----------------------------------------------------------------
'函数功能:检查数据库执行是否有错误发生
'返回值: true/false
'----------------------------------------------------------------
Public Function chkDBError()
Dim ObjError
If Cnn.Errors.Count > 0 Then
For Each ObjError In Cnn.Errors
If objError.Number <> 0 Then
Reporter.ReportEvent micFail,数据库操作失败:" &objError.description
chkDBError = true
End If
Next
Else
chkDBError = false
End If
End Function
'----------------------------------------------------------------
'函数功能:执行sql
'返回值: -1,sql语句执行错误
' 0,查询sql没有有结果返回
' >0,查询sql有结果时为结果集记录数,
' 非查询sql执行成功 ,值为1
'-----------------------------------------------------------------
Public Function ExecuteSql(ByVal sqlstr)
On error resume next
Dim rel,Rst
Dim RstCol
Dim i,j,n
Set Rst =CreateObject("ADODB.Recordset")
sqlstr = LTrim(sqlstr)
If Left(sqlstr,6)="select" Then
Rst.open sqlstr, Cnn
If chkDBError() = True Then
rel = -1
Reporter.ReportEvent micFail, "查询语句 "&sqlstr& " 发生错误!"
Else
IF Rst.EOF THEN
rel = 0
Reporter.ReportEvent micWarning, "查询语句 "&sqlstr& " 无返回值!"
Else
i = 0
For each RstCol in Rst.Fields
i = i+1
datatable.AddSheet("SQL RecordSet").AddParameter RstCol.name,""
Next
n=0
While not Rst.EOF
n=n+1
For j = 0 to i-1
datatable.SetCurrentRow n
datatable.Value( Rst.Fields(j).name,"SQL RecordSet") = Rst.Fields(j).value
Next
Rst.MoveNext
Wend
rel =datatable.GetSheet("SQL RecordSet").GetRowCount
Reporter.ReportEvent micPass,"查询语句 "&sqlstr& " 返回"&rel&"条结果,保存于datatable <SQL RecordSet>"
End if
End If
Else
Rst.open sqlstr, Cnn
If chkDBError() = True Then
rel = -1
Reporter.ReportEvent micFail,"执行语句 "&sqlstr& " 发生错误!"
Else
rel = 1
Reporter.ReportEvent micPass,"执行语句 "&sqlstr& " 成功!"
End If
End If
ExecuteSql=CInt(rel)
Rst.close
End Function |
|