lookup_set_ie_vpn_proxies.vbs

## lookup_set_ie_vpn_proxies.vbs
' LOOKUP_SET_IE_VPN_PROXIES.VBS
' Jon Bryan Jan 2016
' Run as a user logon script, via GPO.
' Fixes those defined VPN Proxy settings "SITE1 PPTP" and "SITE1 VPN" - no tick boxes or text boxes filled.
' Retains and enforces the normal value for SITE2 based VPN Proxy settings.
' Will replace the existing SET_IE_VPN_PROXIES.VBS script, if the expected VPN Proxy settings are not found, they are added.
'
OPTION EXPLICIT
ForceScriptEngine("cscript")
Const HKEY_CURRENT_USER = &H80000001
Dim WSHNetwork, strComputer, strKeyPath, arrValueNames, arrValueTypes, i, strValueName, objReg, arrValues, errReturn, arraystrValueName
Set WSHNetwork = CreateObject("WScript.Network")
strComputer =  WSHNetwork.ComputerName
arraystrValueName=""
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"
objReg.EnumValues HKEY_CURRENT_USER, strKeyPath, arrValueNames, arrValueTypes
For i=0 To UBound(arrValueNames)
	If arrValueNames(i)="DefaultConnectionSettings" or arrValueNames(i)="SavedLegacySettings" or arrValueNames(i)="" Then
	'Do Nothing
	Else
		strValueName = arrValueNames(i)
		'Setup collection of "VPN Names" to check through at the end - used to see if the normal ones are there and add if not.
		If arraystrValueName="" Then
			arraystrValueName=strValueName
		Else
			arraystrValueName=arraystrValueName & "," & strValueName
		End If
		' Enforce SITE2 PPTP settings - standard - proxy.pac
		If strValueName = "SITE2 PPTP" Then
			arrValues = Array(70,0,0,0,3,0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,39,0,0,0,104,116,116,112,58,47,47,109,121,112,114,111,120,121,115,101,114,118,101,114,46,98,108,97,104,46,99,111,109,47,112,114,111,120,121,46,112,97,99,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
			errReturn = objReg.SetBinaryValue (HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues)
		End If
		' Enforce new SITE1 settings - blanking all ticks and dialogs - looking for two names.
		If strValueName = "SITE1 PPTP" Then
			arrValues = Array(70,0,0,0,2,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
			errReturn = objReg.SetBinaryValue (HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues)
		End If
		If strValueName = "SITE1 VPN" Then
			arrValues = Array(70,0,0,0,2,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
			errReturn = objReg.SetBinaryValue (HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues)
		End If
	End If
Next
'Check for existence of VPN settings that should be pushed out be default:
If Instr(arraystrValueName ,"SITE1 PPTP") = 0 then
	' SITE1 PPTP not found, so add it
	strValueName = "SITE1 PPTP"
	arrValues = Array(70,0,0,0,2,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
	errReturn = objReg.SetBinaryValue (HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues)
End If
If Instr(arraystrValueName ,"SITE2 PPTP") = 0 then
	' SITE2 PPTP not found, so add it
	strValueName = "SITE2 PPTP"
	arrValues = Array(70,0,0,0,3,0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,39,0,0,0,104,116,116,112,58,47,47,109,121,112,114,111,120,121,115,101,114,118,101,114,46,98,108,97,104,46,99,111,109,47,112,114,111,120,121,46,112,97,99,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
	errReturn = objReg.SetBinaryValue (HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues)
End If
'TIDY UP
Set WSHNetwork = Nothing
Set strComputer = Nothing
Set objReg = Nothing
Set strKeyPath = Nothing
Set arrValueNames = Nothing
Set arrValueTypes = Nothing
Set i = Nothing
Set strValueName = Nothing
Set arrValues = Nothing
Set errReturn = Nothing
Set arraystrValueName = Nothing
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub ForceScriptEngine(strScriptEng)
  ' Forces this script to be run under the desired scripting host.
  ' Valid arguments are "wscript" or "cscript".
  ' The command line arguments are passed on to the new call.
  Dim arrArgs
  Dim strArgs
  For Each arrArgs In WScript.Arguments
    strArgs = strArgs & " " & Chr(34) & arrArgs & Chr(34)
  Next
  If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
    If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
      CreateObject("Wscript.Shell").Run "cscript.exe //Nologo " & _
        Chr(34) & Wscript.ScriptFullName & Chr(34) & strArgs
      Wscript.Quit
    End If
  Else
    If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
      CreateObject("Wscript.Shell").Run "wscript.exe " & Chr(34) & _
        Wscript.ScriptFullName & Chr(34) & strArgs
      Wscript.Quit
    End If
  End If
End Sub