Vbs修改Host文件

由于自动化测试工具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

 

 

 

转载于:https://www.cnblogs.com/shinhwa/archive/2010/03/05/1678985.html