自动检查 IE 中的代理切换

引言

这是我的第一次提交，所以我认为最好是提交一些我发现有用的东西。

这里是一个小型的 VBScript 脚本，用于自动设置 IE 中的代理开关，在注册表中。

该脚本会检查与特定代理服务器“SERVERNAME”的连接。如果找到服务器，它将在注册表中设置开关。如果未找到服务器，它将禁用开关。然后，脚本等待 60 秒并再次调用自身。

背景

在我工作的公司，我们为所有销售人员进行了一次笔记本电脑更新，其中包括将他们配置为连接到我们的公司网络 VPN。我们使用网络内的代理服务器，这给一些用户在断开 VPN 连接后，仍然想使用 IE 浏览网页时带来了一些问题。

我被多次询问用户为什么在未连接到 VPN 时会遇到连接互联网的问题。因此，我决定研究一种自动更新 Internet Explorer 中代理开关的方法，以便 VPN 连接中的任何更改对用户来说几乎是不可见的。

我花了一段时间在 Scripting Guy 网站上寻找有用的代码片段，但没有找到一篇包含我所需所有内容的文章，所以我编写了这个脚本。

Using the Code

只需将此代码复制到记事本中，将“SERVERNAME”更改为您的代理服务器名称，然后将其保存到“开始”菜单的“*启动*”文件夹中，并使用“.vbs”扩展名。

脚本中的所有注释都应该让你了解正在发生的事情。

Const HKEY_CURRENT_USER = &H80000001
Const OK_BUTTON = 0
Const AUTO_DISMISS = 0  'On Error Resume Next

'Used for local computer name value can be changed for remote changes
strComputer = "."
strServer = "SERVERNAME" 'change this to your Proxy server name

Set objShell = CreateObject("Wscript.shell")
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

'Registry key path
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings"
strValueName = "ProxyEnable" ' Key name

' Gets the registry value
objRegistry.GetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, dwValue

' I can't even remember where the following lines came from.
' Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
' Set colItems = objWMIService.ExecQuery _
'  ("Select * from Win32_PingStatus " & _
'  "Where Address = '" & strServer & "'")
 
blnReply = reachable(strServer) 'calls the reachable function

If blnReply = true And dwValue = 0 Then 'if the values do not match change them
  dwValue = 1
  objRegistry.SetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, dwValue
  'objShell.Popup "Proxy server found." & vbCrLf & _
  '           "Settings have been updated automatically." , _
  '           AUTO_DISMISS, "Internet Proxy Manager", OK_BUTTON
ElseIf blnReply = false And dwValue = 1 Then 'other way round check
  dwValue = 0
  objRegistry.SetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, dwValue
  'objShell.Popup "Proxy server not found." & vbCrLf & _
  '               "Settings have been updated automatically." , _
  '               AUTO_DISMISS, "Internet Proxy Manager", OK_BUTTON
End If
 
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Replace(Wscript.ScriptFullName," ","%20"))
Do Until objFSO.FileExists(Wscript.ScriptFullName)
  WScript.Echo("""" & Wscript.ScriptFullName & """ Does Not Exist!")
  Wscript.Sleep 10000
Loop
 
Wscript.Sleep 60000' Sleep for 60 seconds

'"setProxy.vbs" 
objShell.Run """" & Wscript.ScriptFullName & """" 'Wscript.ScriptFullName
 
function reachable(HostName) ' Checks for a connection to the proxy server
    'This function pings the server and then reads 
    'the results to see if anything was returned

    dim wshShell, fso, tfolder, tname, TempFile, results, retString, ts
    Const ForReading = 1, TemporaryFolder = 2
    reachable = false

    set wshShell=wscript.createobject("wscript.shell")
    set fso = CreateObject("Scripting.FileSystemObject")
    Set tfolder = fso.GetSpecialFolder(TemporaryFolder)

    tname = fso.GetTempName
    TempFile = tfolder & tname

    wshShell.run "cmd /c ping -n 3 -w 1000 " & HostName & ">" & TempFile,0,true

    set results = fso.GetFile(TempFile)
    set ts = results.OpenAsTextStream(ForReading)

    do while ts.AtEndOfStream <> True
     retString = ts.ReadLine
     if instr(retString, "Reply")>0 then
       reachable = true
       exit do
     end if
    loop

    ts.Close
    results.delete

end function

关注点

可能还有更简单的方法来完成上述操作，但我没有找到它。如果您有更好的方法，请告诉我。使用一些 VBScript 知识可以完成很多事情。Microsoft Scripting Guy 是在尝试执行此类操作时非常有价值的资源。

历史

这是第一个版本。我可能会添加额外的功能来更新注册表中的正确代理设置（如果它们已被更改）。