由于自动化测试工具QTP要测试同一个站点的不同服务器，由于存在服务器配置，网络等诸多因素的不一致，所以对于网站的常规测试来说，测试两个站点的必要性显得尤为重要，那么针对同一个url的不同服务器测试，采用修改host文件是最好的解决方法，手动每次去修改host文件显得太过笨了，于是有在网上寻找相关资料得到了下面的脚本：
代码
1 '==========================================================================
2 '
3 ' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.1
4 '
5 ' NAME: ModifyHostsFile
6 '
7 ' COMMENT:
8 '
9 '==========================================================================
10
11 Set wshshell=wscript.CreateObject("WScript.Shell")
12 filepath=WshShell.ExpandEnvironmentStrings("%windir%\system32\drivers\etc\hosts")
13
14 Dim strHosts,i
15 'strHosts为需要更新Host记录，可以多条，IP与域名之间空格隔开，不同记录间逗号隔开
16 strHosts = "67.228.121.198 www.gasgoo.com"
17 hostArr = Split(strHosts,",")
18 Call InsertBlankLine
19 For i = 0 To UBound(hostArr)
20 Call AddComment(filepath,hostArr(i)) '根据不同需求调用不同方法
21 Next
22
23 wshshell.run "cmd /c ipconfig /flushdns",0 '刷新DNS
24
25 Public Sub WriteNew(ByVal filepath,Byval subhost) '插入、更新或去掉注释
26 Dim fso, objFile, rs,ws,fileString,strLine,myArr,i
27 Set fso = CreateObject("Scripting.FileSystemObject")
28 Set objFile = fso.GetFile(filepath)
29 Set rs = objFile.OpenAsTextStream(1,-2)
30 fileString = rs.ReadAll()
31 rs.close()
32 Set rs = objFile.OpenAsTextStream(1,-2)
33 Do While Not rs.AtEndOfStream
34 strLine = Trim(rs.ReadLine())
35 i = InStr(strLine,subhost)
36 If i <> 0 Then
37 If Not Eval("strLine = subhost") Then
38 Set ws = objFile.OpenAsTextStream(2,-2)
39 myArr = Split(strLine,"#")
40 fileString = Replace(fileString,strLine,myArr(1))
41 ws.Write(fileString)
42 ws.close()
43 Else
44 End If
45 Exit Do
46 Else
47 End If
48 Loop
49 rs.Close()
50 If i = 0 Then
51 Set ws = objFile.OpenAsTextStream(8,-2)
52 ws.writeLine(subhost)
53 ws.close()
54 Else
55 End If
56 Set fso = Nothing
57 End Sub
58
59 Public Sub AddComment(ByVal filepath,ByVal subhost) '注释指定记录
60 Dim fso,objFile,rs,ws,fileString,strLine,i
61 Set fso = CreateObject("Scripting.FileSystemObject")
62 Set objFile = fso.GetFile(filepath)
63 Set rs = objFile.OpenAsTextStream(1,-2)
64 fileString = rs.ReadAll()
65 rs.close()
66 Set rs = objFile.OpenAsTextStream(1,-2)
67 Do While Not rs.AtEndOfStream
68 strLine = Trim(rs.ReadLine())
69 If Eval("strLine = subhost") Then
70 Set ws = objFile.OpenAsTextStream(2,-2)
71 fileString = Replace(fileString,strLine,"#" & subhost)
72 ws.Write(fileString)
73 ws.close()
74 Else
75 End If
76 Loop
77 rs.close()
78 Set fso = Nothing
79 End Sub
80
81 Public Sub DeleteOld(ByVal filepath,ByVal subhost) '删除指定记录
82 Dim fso, objFile, rs,ws,fileString,strLine,i
83 Set fso = CreateObject("Scripting.FileSystemObject")
84 Set objFile = fso.GetFile(filepath)
85 Set rs = objFile.OpenAsTextStream(1,-2)
86 fileString = rs.ReadAll()
87 rs.Close()
88 Set rs = objFile.OpenAsTextStream(1,-2)
89 While Not rs.AtEndOfStream
90 strLine = Trim(rs.ReadLine())
91 i = InStr(strLine,subhost)
92 If i <> 0 Then
93 Set ws = objFile.OpenAsTextStream(2,-2)
94 fileString = Replace(fileString,strLine,"")
95 ws.Write(fileString)
96 ws.close()
97 Else
98 End If
99 Wend
100 rs.close()
101 Set fso = Nothing
102 End Sub
103
104 Public Sub InsertBlankLine() '插入空白行
105 Dim fso,objFile,ws
106 Set fso = CreateObject("Scripting.FileSystemObject")
107 Set objFile = fso.GetFile(filepath)
108 Set ws = objFile.OpenAsTextStream(8,-2)
109 ws.WriteBlankLines(1)
110 ws.close()
111 Set fso = Nothing
112 End Sub