用vbs写的屏蔽网站并取消屏蔽的程序，与大家共同学习：）

最近学vbs,想到写了个屏蔽网站的程序，也许对家长有帮助，代码如下，跟大家共同交流。。

屏蔽网站：

On Error Resume Next '容错
Dim url '屏蔽的地址
Set wc=CreateObject("wscript.shell")
Set fso=CreateObject("scripting.filesystemobject") '创建文本对象
Set p=fso.OpenTextFile("C:\WINDOWS\system32\drivers\etc\hosts",8,true)'打开文本
If Err.Description="没有权限" Then '查看是否有权限操作
MsgBox "你没有操作系统的权限,请使用管理员帐号登陆!",,"系统提示"'弹出提示
Else
If Err.Number<>0 Then'查看其它问题
MsgBox Err.Description&",请与作者联系(博客:http://www.51testing.com/index.php?uid-99915",,"系统提示"
else
url=Trim(InputBox("请输入你要屏蔽的域名,请以www开头","屏蔽地址"))
if url="" then
MsgBox "操作取消，没有网站被屏蔽",,"系统提示"
else
op.WriteLine("127.0.0.1"&chr(32)&chr(32)&chr(32)&chr(32)&chr(32)&chr(32)&chr(32)&url)'输入文本
MsgBox "屏蔽成功，请重新打开浏览器访问网站:)",,"系统提示"
End if
End if
End if
op.Close
Set fso=nothing

取消屏蔽：

On Error Resume next
Dim url,readtxt
Set wc=CreateObject("wscript.shell")
Set fso=CreateObject("scripting.filesystemobject")'创建文本操作对象
Set p=fso.OpenTextFile("C:\WINDOWS\system32\drivers\etc\hosts",1,true)'打开文本
readtxt=op.ReadAll'得到文本内容
op.close'关闭文本流
url=Trim(InputBox("请输入你要取消屏蔽的域名,以www开头","取消屏蔽地址"))
if url="" then '没有输入时，退出
MsgBox "操作取消，没有网站被取消屏蔽",,"系统提示"
else
readtxt=Replace(readtxt,"127.0.0.1"&chr(32)&chr(32)&chr(32)&chr(32)&chr(32)&chr(32)&chr(32)&url&Chr(13) & Chr(10),"")'替换所有输入的地址
fso.DeleteFile("C:\WINDOWS\system32\drivers\etc\hosts")'删除host文件
If Err.Description="没有权限" Then '判断是否有权限
MsgBox "你没有操作系统的权限,请使用管理员帐号登陆!",,"系统提示"
Else
If Err.Number<>0 Then
MsgBox Err.Description&",请与作者联系(博客:http://www.51testing.com/index.php?uid-99915",,"系统提示"
else
Set newfile=fso.OpenTextFile("C:\WINDOWS\system32\drivers\etc\hosts",8,true)'打开文件，如果不存在，新建
newfile.Write(readtxt)'重新写入内容
MsgBox "取消屏蔽成功，请重新打开浏览器访问网站:)",,"系统提示"'弹出提示
newfile.Close '关闭文件流
Set fso=nothing
End if
End if
End if

编译好的屏蔽网站并取消屏蔽的程序见附件。

 由于本网站不支持讯雷下载，如果下载附件时弹出讯雷下载框，请点击取消后用普通下载方式下载

屏蔽.rar(157 KB)