共享一份数据库操作底层的函数库脚本

roger_ge

刚从开发转到测试，想想自动化测试以后应该也能用到的，所以花了点时间写了个数据库操作的底层函数脚本。以下三个函数已经测试过。
说明一下：因为对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 编辑 ]

roger_ge

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)

423799223

我都是把这些公用的东西封装到dll中，QTP 10.0支持读取.net Dll做成全局缓存里面的方法，非常方便
如果你操作个数据库需要在QTP在放这么多代码，太麻烦了，脚本还是越简单越好