Instantly share code, notes, and snippets.

Embed
What would you like to do?
Amending/ Changing IE Proxy Settings Cont
' 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment