由于在公司访问外网需要使用代理设置,而回家之后就又要取消代理设置。每天都得来回的设置IE Firefox 有道词典……有点烦了。
于是乎,想写个脚本自启动时控制一下,首先就得找到软件的代理设置是保存在哪儿的?找到后才能修改。。。
IE代理启用控制:
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable
FireFox的代理启用控制:
C:\Documents and Settings\User name\Application Data\Mozilla\Firefox\Profiles\lnll6u8i.default\prefs.js
有道词典的代理启用控制:
C:\Documents and Settings\User name\Local Settings\Application Data\Yodao\DeskDict\config.ini
然后看代码吧:
Const REG_INTERNET_SETTINGS_PATH = "Software\Microsoft\Windows\CurrentVersion\Internet Settings"
'=================================================================================================
' Check connectivity to company intranet (pinging win.dom.XXXXX.com).
'=================================================================================================
Function NetCheck
Dim objWMIService, objComputer, colPing
'You can find the explanations for the code as below from http://club.excelhome.net/thread-201282-1-1.html
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colPing = objWMIService.ExecQuery _
("Select * from Win32_PingStatus Where Address = 'win.dom.XXXXX.com'")
For Each objComputer in colPing
If objComputer.StatusCode = 0 Then
NetCheck = True
Else
NetCheck = False
End If
Next
End Function
'=================================================================================================
' Replace the original string with the new string in a text file.
'=================================================================================================
Sub ReplaceInFiles(FilePath,originalStr,newStr)
Dim url,Retrieval,FileAllText
Dim FSObject,f1
On Error Resume next
Const ForReading = 1, ForWriting = 2
'Get the original text and replace
Set FSObject = CreateObject("scripting.FileSystemObject")
Set f1 = FSObject.OpenTextFile(FilePath,ForReading)
FileAllText=f1.ReadAll
FileAllText=Replace(FileAllText,originalStr,newStr)
'Create new file to repleace the original file
Set FSObject = CreateObject("scripting.FileSystemObject")
Set f1 = FSObject.CreateTextFile(FilePath, True)
f1.writeline FileAllText
If err.number <> 0 Then
Msgbox "There is some error:"& err.number&"-"&err.Description
Set FSObject = Nothing
Exit Sub
Else
'msgbox "Successfully replace!"
End If
End Sub
'=================================================================================================
' Main File
'=================================================================================================
Sub Main
On Error Resume Next
Dim objShell
'--- Set Objects ---
Set objShell = CreateObject("WScript.Shell")
'--- Exit if not connected to company intranet
If NetCheck = False Then
'Here 0 disable the proxy
objShell.RegWrite "HKEY_CURRENT_USER\" & REG_INTERNET_SETTINGS_PATH & "\ProxyEnable", 0, "REG_DWORD"
Call ReplaceInFiles("C:\Documents and Settings\User name\Application Data\Mozilla\Firefox\Profiles\lnll6u8i.default\prefs.js","user_pref(""network.proxy.type"", 1);","user_pref(""network.proxy.type"", 0);")
Call ReplaceInFiles("C:\Documents and Settings\User name\Local Settings\Application Data\Yodao\DeskDict\config.ini","USEPROXY=1","USEPROXY=0")
<span style="white-space: pre;"> </span>Msgbox "Successfully finish"
Set objShell = Nothing
Else
'Here 1 disable the proxy
objShell.RegWrite "HKEY_CURRENT_USER\" & REG_INTERNET_SETTINGS_PATH & "\ProxyEnable", 1, "REG_DWORD"
Call ReplaceInFiles("C:\Documents and Settings\User name\Application Data\Mozilla\Firefox\Profiles\lnll6u8i.default\prefs.js","user_pref(""network.proxy.type"", 0);","user_pref(""network.proxy.type"", 1);")
Call ReplaceInFiles("C:\Documents and Settings\User name\Local Settings\Application Data\Yodao\DeskDict\config.ini","USEPROXY=0","USEPROXY=1")
Msgbox "Successfully finish"
Set objShell = Nothing
End If
End Sub
Call Main
把代码保存到一个VBS文件(如proxysetting.vbs)放到自启动文件夹(C:\Documents and Settings\User name\Start Menu\Programs\Startup)下,每次插上网线启动机子,它就会自动设置代理设置。也可以放在桌面直接双击运行。
PS:这个脚本还有很大的改进空间,应该可以做成实时扫描,这样就不用每次插上网线启动机子,但是这样又得重启应用程序才能使代理设置生效。也许应该在脚本中加上重启应用程序的代码。
如果各位大牛有更好的方法,还望共享。