Skip to content

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
You can’t perform that action at this time.