VBS 通过 HTTP 请求取数据修改 hosts

' On Error Resume Next

Const strURL = "http://***.txt"
Dim objXMLHTTP, objFSO

' Http get set info
Set objXMLHTTP = CreateObject("Msxml2.XMLHTTP")
objXMLHTTP.open "GET", strURL & "?" & Now(), False
objXMLHTTP.send()

If Err.Number <> 0 Then
	' WScript.Echo "Error: " & Err.Number
	Set objXMLHTTP = Nothing
	Err.Clear
Else
	WScript.Echo objXMLHTTP.responseText
	strHttpResult = Split(objXMLHTTP.responseText, " ")
	strDomainName = Trim(strHttpResult(0))
	strIp = Replace(Trim(strHttpResult(1)), vbLf, "")
	Set objXMLHTTP = Nothing
	
	' Update hosts
	Dim strNewContents
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Const ForReading = 1, ForWriting = 2, ForAppending = 8 
	strHostFile = objFSO.GetSpecialFolder(1) & "\drivers\etc\hosts"
	strHostBackFile = objFSO.GetSpecialFolder(1) & "\drivers\etc\hosts.bak"
	objFSO.CopyFile strHostFile, strHostBackFile
	
	Set objFile = objFSO.OpenTextFile(strHostFile, ForReading, False) 
	Do Until objFile.AtEndOfStream
	  strLine = objFile.Readline
	  strLine = Trim(strLine)
	  If Not(InStr(1, strLine, Chr(9) & strDomainName, 1) > 0 Or InStr(1, strLine, Chr(32) & strDomainName, 1) > 0) Then
	    strNewContents = strNewContents & strLine & vbCrLf
	  End If 
	Loop
	strNewContents = strNewContents & strIp & Chr(9) & strDomainName
	objFile.Close
	
	Set objFile = objFSO.OpenTextFile(strHostFile, ForWriting)
	objFile.Write strNewContents
	objFile.Close
	
	Set objFSO = Nothing
End If

引用

http://www.example-code.com/vb/splitComma.asp
http://zh-cn.w3support.net/index.php?db=so&id=204759
http://hi.baidu.com/officeteam/blog/item/5c4941f4be05eb2dbd310901.html
http://blog.ednchina.com/micheal/48115/message.aspx
http://www.jb51.net/article/14586.htm
http://technet.microsoft.com/zh-cn/library/ee692852.aspx#ELC