共享一份数据库操作底层的函数库脚本
刚从开发转到测试，想想自动化测试以后应该也能用到的，所以花了点时间写了个数据库操作的底层函数脚本。以下三个函数已经测试过。说明一下：因为对VBS不是很熟悉，不知道VBS中有没有像c#中的datatable之类的东东，暂时不知道如何在vbs中存储不定行和不定列的数据，所有对于从数据库返回记录集的脚本函数没有写，如果有哪位XDJM知道的，劳烦赐教一下
Option Explicit
Const adCmdText = 1
Const adStateOpen = 1
Const adCmdStoredProc = 4
Dim cnn,cmd,pm
Set cnn=CreateObject("ADODB.Connection")
Set cmd=CreateObject("ADODB.Command")
Set pm=CreateObject("ADODB.Parameter")
Dim strCnn
'SQL Server initialization string
strCnn="Provider=SQLOLEDB.1;User ID=sa; password=sa;Initial Catalog=data;Data Source=127.0.0.1"
'Access initialization string
'strCnn="Provider=Microsoft.Jet.OLEDB.4.0;User Id=admin; password=;Data Source=data.mdb"
Function InitConnection()
On Error Resume Next
Dim strSQL
cnn.ConnectionString=strCnn
cnn.Open
If Err.Number<> 0 Then 'catch the exception
MsgBox Err.Source
Err.Clear
InitConnection=False
Else
InitConnection=True
End If
End Function
Function CloseConnection
If cnn.State=adStateOpen Then 'the connection is open
cnn.Close
Set cnn=Nothing
End If
End Function
'excute the sql string, like insert/update/delete
Function RunSQLString(ByVal sqlstr)
On Error Resume Next
If InitConnection=False Then
RunSQLString=False
Exit Function
End If
Dim recordsAffected
cnn.Execute sqlStr,recordsAffected,adCmdText
If Err.Number<> 0 Then 'catch the exception
MsgBox Err.Description
Err.Clear
RunSQLString=False
Else
RunSQLString=True
End If
Call CloseConnection
End Function
'excure procedure,and not need to return value
'call this function sample:
'Dim proparameters as ADODB.Parameter
'proparameters=Array(parameter1,parameter2...)
'Call GetNullRunProcedure(procedureName,proparameters)
Function RunProcedure(ByVal procedureName, ByVal procedureParameterArray)
On Error Resume Next
If InitConnection=False Then
RunProcedure=False
Exit Function
End If
Dim index
For index=LBound(procedureParameterArray) To UBound(procedureParameterArray)
cmd.Parameters.Append procedureParameterArray(index)
Next
cmd.CommandText=procedureName
cmd.ActiveConnection=cnn
cmd.CommandType=adCmdStoredProc
cmd.Execute
If Err.Number<>0 Then
MsgBox Err.Description
Err.Clear
RunProcedure=False
Else
RunProcedure=True
End If
If cmd.State=adStateOpen Then
Set cmd=Nothing
End If
Call CloseConnection
End Function
'excure the transaction
Function RunTransaction(ByVal sqlStrArray)
On Error Resume Next
If InitConnection=False Then
RunSQLString=False
Exit Function
End If
cnn.BeginTrans
Dim recordsAffected
Dim index
For index=LBound(sqlStrArray) To UBound(sqlStrArray)
cnn.Execute sqlStrArray(index),recordsAffected,adCmdText
Next
If Err.Number<>0 Then
cnn.RollbackTrans
MsgBox Err.Description
Err.Clear
RunTransaction=False
Else
cnn.CommitTrans
RunTransaction=True
End If
Call CloseConnection
End Function
[ 本帖最后由 roger_ge 于 2009-10-23 13:12 编辑 ]
再发一个调用存储函数的示例 ^_^
Dim pmtest(1)Set pmtest(0)=CreateObject("ADODB.Parameter")
Set pmtest(1)=CreateObject("ADODB.Parameter")
pmtest(0).Type=200
pmtest(0).Size=50
pmtest(0).Value="gd"
pmtest(1).Type=200
pmtest(1).Size=50
pmtest(1).Value="ew"
Call RunProcedure("test",pmtest) 我都是把这些公用的东西封装到dll中，QTP 10.0支持读取.net Dll做成全局缓存里面的方法，非常方便
如果你操作个数据库需要在QTP在放这么多代码，太麻烦了，脚本还是越简单越好
页:
[1]
