vbs测试webservice脚本

对于上次写的那个使用vbs测试webservice的脚本做了一点扩展，这一次一并发出来。有兴趣的朋友可以一起了解一下。考虑到模板尚未设计完成，这次仅把脚本贴一贴。
原脚本：
'作者：  aslandhu
'公司：  中科大讯飞科技股份有限公司
'脚本功能：     webservice自动化测试，自动读取测试用例，用例配置文件，最终将测试结果写入用例中。
'开发开始时间： 2009-4-20
'更新时间：  2010-3-15(15:30:00)
'******************************************************************webservice测试开始*************************************************************
'请在使用前调试脚本确保脚本能正常工作
'请严格使用提供的模板编写用例，否则脚本无法正常工作
'*****************************************************************收集相关信息************************************************************************
On error resume next
Dim SoapText,XmlHead,XmlLast,SoapQuest,MethodInput,XmlMethodString1,XmlMethodString2,WebserviceAddress,testResult,ResultPath
MethodInput="GetRecResultList"       '待测试的方法
Dim n,m,i,j,a,b,k,c,CounterPass,CounterFail,CounterAll,CounterFailer,BoolCounter 'n为参数个数，也即用例需要取值的列数量,m为用例数量即Excel行数，K为方法数量（保留）
n=1              '传入的参数个数
k=9              '需要检查的参数个数
m=20             '用例数量即Excel行数
CounterAll=0     '这四个是计数器
CounterPass=0
CounterFail=0
CounterFailer=0
BoolCounter=true
WebserviceAddress=http://…………/SMSSDemoWs/TestRoutingEngine.asmx  '测试接口地址
TestPath="C:\test.xls"        '测试用例路径
Dim ArrayInfo()
ReDim ArrayInfo(m,n)
'****************************************************************拼装SOAP头尾消息*****************************************************************
XmlHead="<?xml version=""1.0"" encoding=""utf-16""?>"&"<soap:Envelope xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"">"&"<soap:Body>"
XmlLast="</soap:Body>"&"</soap:Envelope>"
XmlMethodString1="<"&MethodInput&" "&"xmlns=""http://tempuri.org/"">"
XmlMethodString2="</"&MethodInput&">"
'XmlMethodString2="</"&MethodInput&">"
'*****************************************************************创建Excel对象，准备读取用例************************************************
Set Excel = CreateObject("Excel.Application")
oExcel.DisplayAlerts=FALSE
oExcel.Visible = false
oExcel.WorkBooks.Open(TestPath)
oExcel.WorkSheets(MethodInput).Activate
'*****************************************************************将用例存入数组********************************************************************
For i=1 To m  '行数3,b
  For j=1 To n  '列数2,a
  ArrayInfo(i,j)= oExcel.Cells(i,j).Value 
 Next
Next
'****************************************************************开始组装SOAP主体*****************************************************************
SoapText=""
For b=2 To m
For a=1 To n
SoapText=SoapText&"<"&ArrayInfo(1,a)&">"&ArrayInfo(b,a)&"</"&ArrayInfo(1,a)&">"
CounterAll=CounterAll+1
Next
SoapQuest=XmlHead&XmlMethodString1&SoapText&XmlMethodString2&XmlLast
'MsgBox(SoapQuest)
'WriteToFile  "c:\test.txt",SoapQuest
'****************************************************************开始循环发送消息*********************************************************************
'定义一XML的文档对象
'初始化http对象
Set h = createobject( "Microsoft.XMLHTTP")
h.open "POST", WebserviceAddress, False
h.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
h.setRequestHeader "SOAPAction", "http://tempuri.org/"&MethodInput
h.send (SoapQuest)
While h.readyState <> 4
Wend
'***************************************************************循环处理返回结果并将结果写入用例***********************************************
For c=n+1 to n+k
testResult=oExcel.Cells(1,c).Value
test=oExcel.Cells(b,c).Value
testtest=test
fact=GetXml(h.responseText,testResult)
if (IsEmpty(test) or IsNull(test) or (Len(test)=null) or (test=" ")) Then test=" "
if (IsEmpty(fact) or IsNull(fact) or (Len(fact)=null) or (fact=" ")) Then fact=" "
If  CStr(test) <> CStr(fact) then
   oExcel.Cells(b,c).Value = testtest&"("&"实际结果为："&fact&")"
          oExcel.Cells(b,c).Font.Color = RGB(255, 0, 225)
   'oExcel.Cells(b,c+k).Interior.Color = RGB(0, 255, 0) 'Background color
                 oExcel.Cells(b,c).Font.Bold = True
                 BoolCounter=BoolCounter AND false
                 CounterFail=CounterFail+1 
 'else
   'oExcel.Cells(b,c).Value = testtest
   'oExcel.Cells(b,c).Font.Color = RGB(0, 0, 0)
   'oExcel.Cells(b,c).Interior.Color = RGB(255, 255, 255) '
end if
                 BoolCounter=BoolCounter AND true
Next
if BoolCounter=false then                
CounterFailer=CounterFailer+1
BoolCounter=true             
end if
SoapText=""
Next

'****************************************************************释放Excel对象，并将结果写到指定路径***************************************
CheckFolder "C:\TestResult"         '测试结果保存路径
ResultPath="C:\TestResult\"&MethodInput&".xls"
oExcel.WorkSheets(MethodInput).SaveAs ResultPath
oExcel.WorkBooks.Close
oExcel.Quit
Set Excel=nothing
msgbox("你好，共执行完成用例"&CounterAll&"条,共有"&CounterFail&"个检查点与预期结果不一致"&"有"&CounterFailer&"条用例执行失败")
'***************************************************************以下是被调用的函数****************************************************************
Sub CheckFolder(folderpath)
Dim fso,CreateFolderSuccess,f
Set fso=CreateObject("Scripting.FileSystemObject")
If  fso.FolderExists(folderpath)=false Then
 Set f = fso.CreateFolder(folderpath)
  CreateFolderSuccess = f.Path
  Else
  Set fso=nothing
End If
End Sub

'将string写入文本
Sub WriteToFile (filepath,text)
  Dim fso, MyFile,txtFile
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set txtFile = fso.GetFile(filepath)
  Set MyFile = txtFile.OpenAsTextStream(8, 0)
  MyFile.Write text&vbcrlf
  MyFile.Close
End Sub

'创建文本文件
Sub CreatedFile(filepath)
 Set fso = CreateObject("Scripting.FileSystemObject")
    Set MyFile = fso.CreateTextFile(filepath, true)
    MyFile.WriteLine("<!-- Result -->")
    MyFile.Close
End Sub

'判断txt文件是否存在
Function IsFileExist(filepath)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  IsFileExist = fso.FileExists(filepath)
End Function

Function GetXml(testpath, nodeName)
      Set xmlDoc = Nothing
        Set xmlDoc = CreateObject("Msxml2.DOMDocument")
        xmlDoc.loadXML(testpath)
        Set root = xmlDoc.documentElement
        Set bjChildNodes = root.getElementsByTagName(nodeName)
        if(objChildNodes.item(0).ChildNodes.length=0) then
        GetXml=" "
        else
        GetXml= objChildNodes.item(0).firstChild.text
 end if
        Set xmlDoc = Nothing
End Function

  on   error   goto   0 

另外一个脚本（原理实现都一样，上面那个不支持多个方法，下面的这个脚本支持一次执行多个方法的用例，非并发执行）：（Created by aslandhu）

On error resume next
Dim conn,rst,filename,WebserviceAddress,SOAPAction,MethodInput,InputNodesString,OuputNodesString,InputNodes,OutputNodes
filename="C:\test.xls"                               '填入用例路径
Set conn= createobject("ADODB.Connection")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source="&filename&";Extended Properties='Excel 8.0;hdr=yes'"
Set rst= createobject("ADODB.Recordset")
Set Caserst= createobject("ADODB.Recordset")
SqlStr = "select * from [VbsConfig$A1:G2]"    '此处增加用例范围
rst.Open SqlStr,conn,2,2
'Created by aslandhu                                          
Do Until rst.EOF                           
   WebserviceAddress = rst.fields("WebserviceAddress")
   SOAPAction= rst.fields("SOAPAction")
   MethodInput= rst.fields("MethodInput")
   InputNodesString= rst.fields("InputNodesString")
   uputNodesString= rst.fields("OuputNodesString")
   CaseBegin= rst.fields("CaseBegin")
   CaseEnd= rst.fields("CaseEnd")
   InputNodes = Split(InputNodesString, ",", -1, 1)
   utputNodes = Split(OuputNodesString, ",", -1, 1)
'***************************************************从数据表中取测试用例*****************************
   CaseSqlStr =  "select * from ["&MethodInput&"$"&CaseBegin&":"&CaseEnd&"]" 
   Caserst.Open CaseSqlStr,conn,2,2
   Dim InputNodesValue()
   ReDim InputNodesValue(UBound(InputNodes))
'******************************************************开始拼装消息*********************************
Do Until Caserst.EOF
   XmlHead="<?xml version=""1.0"" encoding=""utf-16""?>"&"<soap:Envelope xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"">"&"<soap:Body>"
   XmlLast="</soap:Body>"&"</soap:Envelope>"
   XmlMethodString1="<"&MethodInput&" "&"xmlns=""http://tempuri.org/"">"
   XmlMethodString2="</"&MethodInput&">"
   SoapText="" 
For i=0 To UBound(InputNodes)
   InputNodesValue(i)= Caserst.fields(InputNodes(i))
   SoapText=SoapText+"<"&InputNodes(i)&">"&InputNodesValue(i)&"</"&InputNodes(i)&">"
Next
   SoapQuest=XmlHead&XmlMethodString1&SoapText&XmlMethodString2&XmlLast
   SoapText=""
'***************************************************获取返回结果*************************************
  SoapResponse=GetSoapRes(SoapQuest,CStr(WebserviceAddress),CStr(SOAPAction))
'**************************************************处理返回结果**************************************
Dim OnputNodesValue()
Redim OutputNodesValue(UBound(OutputNodes))
For i=0 To UBound(OutputNodes)
   OutputNodesValue(i)= Caserst.fields(OutputNodes(i))  '存放预期值
   FactValue=GetNodeValue(SoapResponse,OutputNodes(i))
   if (IsEmpty(OutputNodesValue(i)) or IsNull(OutputNodesValue(i)) or (Len(OutputNodesValue(i))=null) or (OutputNodesValue(i)=" ")) Then OutputNodesValue(i)=" "
   if (IsEmpty(FactValue) or IsNull(FactValue) or (Len(FactValue)=null) or (FactValue=" ")) Then FactValue=" "
   If CStr(OutputNodesValue(i)) <> CStr(FactValue) then
   Caserst.fields(OutputNodes(i)) = OutputNodesValue(i)&"("&"实际结果为："&FactValue&")"
   End If
Next
'***************************************************************************************************
   'Created by aslandhu  
   Caserst.MoveNext
Loop
   Caserst.Close
   set Caserst=nothing
'****************************************************************************************************
   rst.MoveNext
Loop
   rst.Close
   conn.Close
   set conn=nothing
   set rst=nothing
on error goto 0
'****************************************************************************************************
Function  GetSoapRes(SoapQuest,WebserviceAddress,SOAPAction)
        Set h = Createobject("Microsoft.XMLHTTP")
        h.open "POST", WebserviceAddress, False
        h.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
        h.setRequestHeader "SOAPAction",SOAPAction
        h.send (SoapQuest)
        While h.readyState <> 4
        Wend
        GetSoapRes=h.responseText
End Function

Function GetNodeValue(SoapResponse,NodeName)
        Set xmlDoc = Nothing
        Set xmlDoc = CreateObject("Msxml2.DOMDocument")
        xmlDoc.loadXML(SoapResponse)
        Set root = xmlDoc.documentElement
        Set bjChildNodes = root.getElementsByTagName(NodeName)
        if(objChildNodes.length=0)then
        GetNodeValue=""
        else if(objChildNodes.item(0).ChildNodes.length=0) then
        GetNodeValue=" "
        else
        GetNodeValue= objChildNodes.item(0).firstChild.text
 end if
        end if
        Set xmlDoc = Nothing
End Function