Tuesday 24 May 2011

VBS to edit Proxy server bypass list

The following is a VB Script that can amend a users Proxy server bypass list.
This script is great in that it appends the list so that it can be run multiple times during logon or applicaiton launch without losing setting made previosuly.




'--------------------------------------------------
'Aim:       To add exceptions to the proxy settings
'           Developed to avoid duplicates being in the list
'--------------------------------------------------
Option Explicit

Const HKCU = &H80000001
Const SUB_KEY = "Software\Microsoft\Windows\CurrentVersion\Internet Settings"
Const VALUE_NAME = "ProxyOverride"
Const BYPASS_SITES = "*.thinworld.net"
'--------------------------------------------------
'HKCU = value for the HKEY_CURRENT_USER hive
'SUB_KEY = location for the security zone map
'VALUE_NAME = value name to look for
'BYPASS_SITES = sites to bypass the proxy
'--------------------------------------------------

Dim objReg
Dim strValue, strNewValue, strSite
Dim arrTemp, arrTempSites
'--------------------------------------------------
'objReg = WMI class to manipulate the registry
'strValue = the value retrieved from the registry
'strNewValue = the value to write to the registry
'--------------------------------------------------

'-- get the existing bypass list --'
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
objReg.GetStringValue HKCU, SUB_KEY, VALUE_NAME, strValue

'-- write the new bypass list --'
objReg.GetStringValue HKCU, SUB_KEY, VALUE_NAME, strValue
arrTempSites = Split(BYPASS_SITES, ";")
strNewValue = strValue
For Each strSite In arrTempSites
  arrTemp = Split(strNewValue, ";")
  If Not Array_InArray(strSite, arrTemp) Then
   strNewValue = strSite & ";" & strNewValue
  End If
Next
objReg.SetStringValue HKCU, SUB_KEY, VALUE_NAME, strNewValue

WScript.Quit 0

'--------------------------------------------------
'Aim:       To determine is the given text is in the given array
'Returns:   True if found, False if not found
'--------------------------------------------------
Function Array_InArray(ByVal needle, ByVal haystack)

  Dim idx
  Dim blnFound
  '--------------------------------------------------
  'idx = index in an array
  'blnFound = whether the item is found or not
  '--------------------------------------------------

  blnFound = False

  For Each idx In haystack
    If LCase(needle) = LCase(idx) Then
     blnFound = True
     Exit For
    End If
  Next

  Array_InArray = blnFound

End Function

No comments:

Post a Comment