'Downloads and installs PAC file from hostsfile.org. 
'Configures Internet Explorer to use the PAC file.

Option Explicit

'http://ericphelps.com/
'Released to Public Domain December 2007

Const PROXY_URL = "http://www.hostsfile.org/proxy.txt"
Const WINDOWS_FOLDER = 0
Const SYSTEM_FOLDER = 1
Dim gstrHostsFolder, fs

'Make sure the system has the basics
If Not HasScripting() Then WScript.Quit

'Find the "hosts" folder where we'll put the PAC file
Set fs = CreateObject("Scripting.FileSystemObject")
gstrHostsFolder = fs.BuildPath(fs.GetSpecialFolder(SYSTEM_FOLDER).Path, "drivers\etc")
If Not fs.FolderExists(gstrHostsFolder) Then
	gstrHostsFolder = fs.GetSpecialFolder(WINDOWS_FOLDER).Path
End If

'Prompt for admin rights if needed
If NeedsUAC() Then 
	UAC
End If

'Let the first-time user know what's about to happen
If Not fs.FileExists(fs.BuildPath(gstrHostsFolder, "proxy")) Then
	If MsgBox("This script will download the latest " _
	& """Proxy Access Control"" (PAC) script from hostsfile.org, back up any existing PAC script, " _
	& "and set Internet Explorer to use the new PAC script for all LAN (non-dialup) connections. " _
	& "NOTE: PCs that are configured to use a proxy server (typically corporate PCs) should " _
	& "check with their computer administrator before running this script.", vbOkCancel, "One-Time Notice") <> vbOk Then
		WScript.Quit
	End If
	If MsgBox("This script will need Internet access and administrative " _
	& "permissions in order to change registry settings, run other programs, and modify files. " _
	& "If your PC security warns you about these actions, you should allow " _
	& "them.", vbOkCancel , "One-Time Notice") <> vbOk Then
		WScript.Quit
	End If
End If

'Basics are in order - run the main program.
Main

Sub Main
	'Declare variables
	Dim fs, ws, sc, oTest
	Dim strShortcutFolder, strNotepad
	Dim strData, blnDNS, blnSuccess, strMessage, strUser
	
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	
	On Error Resume Next
	

	'Get the most recent PROXY file
	strData = ""
	Status "Downloading PROXY file..."
	strData = GetData(PROXY_URL)
	If Len(strData) < 10000 Then
		Status "Length of downloaded PROXY file was " & Len(strData) & " bytes."
		MsgBox "Sorry, I couldn't download the PROXY file. Maybe the Internet was vaporized?", ,"Error"
	Else
		'Verify permissions on the proxy file (if it exists)
		If fs.FileExists(fs.BuildPath(gstrHostsFolder, "proxy")) Then
			Err.Clear
			fs.GetFile(fs.BuildPath(gstrHostsFolder, "proxy")).Attributes = 32 'Clear everything except archive
			If fs.GetFile(fs.BuildPath(gstrHostsFolder, "proxy")).Attributes <> 32 Then
				Status "WARNING - Permission on proxy can't be reset"
				If MsgBox("I don't seem to be able to set permissions on the ""proxy"" file. You may not have permission to modify the ""proxy"" file. Should I ignore this problem and continue?", vbYesNo, "Error") = vbNo Then
					Exit Sub
				End If
			Else
				Status "Attributes OK on existing proxy file"
			End If
		End If
		'Verify permissions on proxy.bak backup file (if it exists)
		If fs.FileExists(fs.BuildPath(gstrHostsFolder, "proxy.bak")) Then
			Err.Clear
			fs.GetFile(fs.BuildPath(gstrHostsFolder, "proxy.bak")).Attributes = 32 'Clear everything except archive
			If fs.GetFile(fs.BuildPath(gstrHostsFolder, "proxy.bak")).Attributes <> 32 Then
				Status "WARNING - Permission on proxy.bak can't be reset"
				If MsgBox("I don't seem to be able to set permissions on the ""proxy.bak"" file (the existing backup file). This means I may not be able to back things up before I make changes. Should I ignore this problem and continue?", vbYesNo, "Error") = vbNo Then
					Exit Sub
				End If
			Else
				Status "Attributes OK on existing proxy.bak file"
			End If
		End If
		'Back up the old proxy file
		If fs.FileExists(fs.BuildPath(gstrHostsFolder, "proxy.bak")) Then
			Status "Deleting old ""proxy.bak"" file"
			Err.Clear
			fs.DeleteFile fs.BuildPath(gstrHostsFolder, "proxy.bak"), True
			If fs.FileExists(fs.BuildPath(gstrHostsFolder, "proxy.bak")) Then
				Status "WARNING - Can't delete old proxy.bak file"
				If MsgBox("I couldn't delete your existing backup file. This means I will NOT be able to back things up for you. Should I ignore this error and continue?", vbYesNo, "Error") = vbNo Then
					Exit Sub
				End If
			End If
		End If
		If fs.FileExists(fs.BuildPath(gstrHostsFolder, "proxy")) Then
			Status "Renaming existing ""proxy"" file to ""proxy.bak"""
			Err.Clear
			fs.GetFile(fs.BuildPath(gstrHostsFolder, "proxy")).Name = "proxy.bak"
			If Err.Number <> 0 Then
				Status "WARNING - Can't rename existing proxy file"
				If MsgBox("I couldn't backup your existing proxy file. If things continue to go wrong (which is how the universe works), you could wipe out your proxy file, have no backup, and tear a hole in space-time. Should I continue down the path of almost certain doom?", vbYesNo, "Error") = vbNo Then
					Exit Sub
				End If
			End If
		End If
		'Write the downloaded proxy data to the file
		Status "Saving new ""proxy"" file"
		If Not String2File(strData, fs.BuildPath(gstrHostsFolder, "proxy")) Then
			MsgBox "Sorry, I couldn't save the new ""proxy"" file. You may not have permission to modify the file.",,"Error"
			Exit Sub
		End If
	End If
	
	'Activate the PROXY file as a PAC
	If fs.FileExists(fs.BuildPath(gstrHostsFolder, "proxy")) Then
		ws.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\AutoConfigURL", "file://" & Replace(fs.BuildPath(gstrHostsFolder, "proxy"), "\", "/"), "REG_SZ"
		ws.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyBypass", 0, "REG_DWORD"
		ws.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable", 0, "REG_DWORD"
		ws.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\Flags", 211, "REG_DWORD"
		ws.RegWrite "HKCU\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\EnableAutoProxyResultCache", 0, "REG_DWORD"
		blnSuccess = True
		If ws.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\AutoConfigURL") <> "file://" & Replace(fs.BuildPath(gstrHostsFolder, "proxy"), "\", "/") Then blnSuccess = False
		If ws.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyBypass") <> 0 Then blnSuccess = False
		If ws.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable") <> 0 Then blnSuccess = False
		If ws.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\Flags") <> 211 Then blnSuccess = False
		If ws.RegRead("HKCU\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\EnableAutoProxyResultCache") <> 0 Then  blnSuccess = False
		If Not blnSuccess Then
			MsgBox "I was unable to make the changes necessary to use your proxy file as a PAC for Internet Explorer."
		End If
	End If	
End Sub

Function GetData(strUrl)
Dim web
Const WinHttpRequestOption_EnableRedirects = 6
	Set web = Nothing
	On Error Resume Next
	Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
	If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
	If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
	If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
	If web Is Nothing Then
		GetData = ""
		Exit Function
	End If
	web.Option(WinHttpRequestOption_EnableRedirects) = True
	web.Open "GET", strURL, False
	web.SetRequestHeader "REFERER", strUrl
 	web.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
 	web.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
 	web.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
 	web.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
	web.Send
	If web.Status = "200" Then
		GetData = web.ResponseText
	Else
		GetData = ""
	End If
End Function

Sub StopService(strServiceName)
	Dim blnDependencies, objWMI, objService, colServices
	On Error Resume Next
	Err.Clear
	Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
	Set colServices = objWMI.ExecQuery("Associators of {Win32_Service.Name='" & strServiceName & "'} Where AssocClass=Win32_DependentService " & "Role=Antecedent" )
	blnDependencies = False 
	For Each objService in colServices
		blnDependencies = True 
		objService.StopService
	Next
	If blnDependencies = True Then 
		Wscript.Sleep 20000
	End If
	Set colServices = objWMI.ExecQuery("Select * from Win32_Service where Name='" & strServiceName & "'")
	For Each objService in colServices
		objService.StopService()
	Next
	Set objWMI = Nothing
	'If WMI fails, try running NET.EXE to stop service
	If Err.Number <> 0 Then
		CreateObject("WScript.Shell").Run "net.exe stop " & strServiceName, 0, False
	End If
End Sub

Function ServiceState(strServiceName)
	'Returns "Running", "Stopped", "Starting", "Stopping", or ""
	Dim objWMI, colServices, objService, strState, strStartMode
	On Error Resume Next
	Err.Clear
	Set objWMI = GetObject("winmgmts:\\.\root\CIMV2")
	Set colServices = objWMI.ExecQuery("SELECT * FROM Win32_Service WHERE NAME='" & strServiceName & "'", "WQL", 48)
	For Each objService In colServices
		strState = objService.State
	Next
	If Err.Number <> 0 Then
		ServiceState = "" 'Return empty string on WMI failure
	Else
		ServiceState = strState
	End If
	Set objWMI = Nothing
End Function

Function ServiceStartMode(strServiceName)
	'Returns "Auto", "Disabled", "Manual", or ""
	Dim objWMI, colServices, objService, strState, strStartMode
	On Error Resume Next
	Err.Clear
	Set objWMI = GetObject("winmgmts:\\.\root\CIMV2")
	Set colServices = objWMI.ExecQuery("SELECT * FROM Win32_Service WHERE NAME='" & strServiceName & "'", "WQL", 48)
	For Each objService In colServices
		strStartMode = objService.StartMode
	Next
	If Err.Number <> 0 Then
		ServiceStartMode = "" 'Return empty string on WMI failure
	Else
		ServiceStartMode = strStartMode
	End If
	Set objWMI = Nothing
End Function

Function HasScripting()
'Returns True if able to create common scripting objects (some WinXP can fail!)
Dim fs, ws, sa, lngErrNum
	Err.Clear
	lngErrNum = 0
	Set ws = CreateObject("WScript.Shell")
	lngErrNum = lngErrNum + Err.Number
	Set fs = CreateObject("Scripting.FileSystemObject")
	lngErrNum = lngErrNum + Err.Number
'	Set sa = CreateObject("Shell.Application")
'	lngErrNum = lngErrNum + Err.Number
	If lngErrNum <> 0 Then
		If MsgBox ("You seem to have a bad (or old) installation of Microsoft Windows Scripting. I'd like to take you to a Microsoft web page where you can download Scripting Version 5.6. May I launch your default browser to show you the download page?", vbYesNo, "Update Needed") = vbYes Then
			ws.Run "http://www.microsoft.com/downloads/details.aspx?FamilyId=C717D943-7E4B-4622-86EB-95A22B832CAA&displaylang=en", 1, False
		End If
		HasScripting = False
	Else
		HasScripting = True
	End If
End Function

Function String2File(strData, strFileName)
'Writes a string to a file. Returns True if success.
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim lngChar, strBlock, intChar, dtTimeStamp
Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	On Error Resume Next
	If fs.FileExists(strFileName) Then
		dtTimeStamp = fs.GetFile(strFileName).DateLastModified
	Else
		dtTimeStamp = CDate(0)
	End If
	Err.Clear
	Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
	ts.Write strData
	If Err.Number <> 0 Then
		'Must have hit one of the "problem characters" between 128 and 159
		For lngChar = 1 To Len(strData) Step 100
			Err.Clear
			ts.Write Mid(strData, lngChar, 100)
			If Err.Number <> 0 Then
				'This block of 100 must have the problem. Write them one-at-a-time
				strBlock = Mid(strData, lngChar, 100)
				For intChar = 1 To Len(strBlock)
					ts.Write Chr(255 And AscW(Mid(strBlock, intChar)))
				Next
			End If
		Next
	End If
	ts.Close
	If fs.FileExists(strFileName) Then
		If dtTimeStamp = fs.GetFile(strFileName).DateLastModified Then
			String2File = False
		Else
			String2File = True
		End If
	Else
		String2File = False
	End If
End Function

Sub Status(strMessage)
	'Writes a message to the UI only if the script is running under CSCRIPT
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
		Wscript.Echo strMessage
	End If
End Sub

'********************************************************************************
'****    Code section for User Access Control (UAC) and "RUNAS" prompting    ****
'********************************************************************************

Function NeedsUAC()
'Returns False if UAC not needed (Win9x or Win2K/XP with logged on admin)
'Returns True if UAC needed (Win2K/XP with no admin or every instance of Vista)
	If IsAdmin(UserName()) Then
		If OsVersion() < 6 Then
			NeedsUAC = False
		Else
			NeedsUAC = True
		End If
	Else
		NeedsUAC = True
	End If
End Function

Sub UAC()
'Re-launches this script with admin priveleges. The original 
'instance of the script is terminated by this subroutine. 
'How it happens - A temporary script is generated that uses 
'the Shell.Application "ShellExecute" method with "runas" 
'to re-launch this script.
Const FOR_WRITING = 2
Dim ws, fs, ts
Dim strData, strUacFile, strArgs, strArg
Dim lngArg
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	'Define the name of the special script that will re-launch this one for UAC if needed.
	'Define the name of the special script that will re-launch this one for UAC if needed.
	'Can't use %TEMP% or other per-user folder, can't use script folder because it might be
	'in protected area. 
	strUacFile = ""
	If strUacFile = "" Then
		'First try to use "shared docs" because everyone can get to it.
		strUacFile = ws.RegRead("HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Common Documents")
		If strUacFile <> "" Then
			If fs.FolderExists(strUacFile) Then 
				strUacFile = fs.BuildPath(strUacFile, "~" & fs.GetBaseName(WScript.ScriptName) & ".vbs")
			Else
				strUacFile = ""
			End If
		End If
	End If
	If strUacFile = "" Then
		'Last choice is the drive root. At least we know it exists!
		strUacFile = fs.BuildPath(fs.GetDriveName(WScript.Path) & "\", "~" & fs.GetBaseName(WScript.ScriptName) & ".vbs")
	End If
	'If the UAC script exists, we can assume it launched this one! 
	If fs.FileExists(strUacFile) Then
		'If we were already started by the temporary UAC script, that script should be deleted.
		fs.DeleteFile strUacFile
	Else	
		'This is definitely a directly-run script. We need to re-launch it to get a UAC.
		'First collect any arguments the script has so we can re-launch it the same.
		For lngArg = 0 To WScript.Arguments.Count - 1
			If strArgs <> "" Then strArgs = strArgs & " "
			strArg = WScript.Arguments(lngArg)
			If ((InStr(strArg, " ") <> 0) Or (InStr(strArg, vbTab) <> 0)) Then 
				strArg = """" & """" & strArg & """" & """"
			End If
			strArgs = strArgs & strArg
		Next
		'Now build the actual command that will re-launch the script with a UAC prompt
		'There is an awful lot of double-double quoting happening here!
		strData = "CreateObject(""Shell.Application"").ShellExecute "
		strData = strData & """" & """" & """" & Wscript.FullName & """" & """" & """"
		strData = strData & ", "
		strData = strData & """" & """" & """" & WScript.ScriptFullName & """" & """"
		If strArgs = "" Then
			strData = strData & """, "
		Else
			strData = strData & " " & strArgs & """, "
		End If
		strData = strData & """" & """" & """" & fs.GetParentFolderName(WScript.ScriptFullName) & """" & """" & """"
		strData = strData & ", "
		strData = strData & """runas"""
		strData = strData & ", 1"
		'Save the UAC command in a separate script
		Set ts = fs.OpenTextFile(strUacFile, FOR_WRITING, True)
		ts.Write strData
		ts.Close
		'Show a message to warn the user why they are about to see a UAC prompt
		Wscript.Echo "This script will need administrative priveleges."
		'Launch the UAC script
		CreateObject("Wscript.Shell").Run "wscript.exe" & " """ & strUacFile & """", 1, False
		'We MUST exit at this point and let the UAC script re-launch us.
		WScript.Quit
	End If
End Sub

Function OsVersion()
'Returns the base + minor version for the OS. Returns 0 on error.
'3.5=NT, 4.0=95, 4.1=98, 4.9=ME, 5.0=2K, 5.1=XP, 5.2=2003, 6.0=Vista
Dim strVersion, objWMI, colSystems, objOS
Dim ver, strVer, strVerMajor, strVerMinor, strMajor
	strVersion = "0" 'Set a default of zero in case of error
	On Error Resume Next
	Set objWMI = GetObject("winmgmts:\\.\root\CIMV2")
	Set colSystems = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem", "WQL", 48)
	For Each objOS In colSystems
		strVersion = objOS.Version
	Next
	Set objWMI = Nothing
	If InStr(strVersion, ".") > 0 Then
		strVersion = Left(strVersion, InStr(strVersion, ".") + 1)
	End If
	'If WMI fails, try parsing output from the old "ver" command
	If strVersion = "0" Then
		Set ws = CreateObject("Wscript.Shell")
		Set ver = ws.Exec("%comspec% /c ver")
		Do While ver.Status = 0
			WScript.Sleep 100
		Loop
		strVer = ver.StdOut.ReadAll
		strVer = Split(strVer, ".")
		'Get major version
		strMajor = strVer(0)
		strMajor = Split(strMajor, " ")
		strVerMajor = strMajor(UBound(strMajor))
		'Get minor version
		strVerMinor = strVer(1)
		strVerMinor = Left(strVerMinor, 1)
		'Check results
		If IsNumeric(strVerMajor) And IsNumeric(strVerMinor) Then
			strVersion = strVerMajor & "." & strVerMinor
		End If
	End If
	OsVersion = strVersion
End Function

Function UserName()
	Dim objWMI, colComputers, objComputer, strUser, ws, env
	On Error Resume Next
	strUser = ""
	Err.Clear
	Set objWMI = GetObject("winmgmts:\\.\root\CIMV2")
	Set colComputers = objWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", 48)
	If Err.Number <> 0 Then
		'WMI Failure. Try environment
		Set ws = CreateObject("Wscript.Shell")
		Set env = ws.Environment("Process")
		strUser = env.Item("USERNAME")
	Else
		For Each objComputer In colComputers
			strUser = objComputer.UserName
		Next
		If Instr(strUser, "\") Then
			strUser = Mid(strUser, Instr(strUser, "\") + 1)
		End If
	End If
	Set objWMI = Nothing
	UserName = strUser
End Function

Function IsAdmin(strUserName)
	Dim objWMI, colUsers, objUser, strGroup, strUser, blnIsAdmin, blnHasAdmins
	On Error Resume Next
	Err.Clear
	Set objWMI = GetObject("winmgmts:\\.\root\CIMV2")
	Set colUsers = objWMI.ExecQuery("SELECT * FROM Win32_GroupUser", "WQL", 48)
	If Err.Number <> 0 Then
		'Assume WMI failure means Win9X, implying user is an Administrator
		IsAdmin = True
	Else
		blnIsAdmin = False
		blnHasAdmins = False
		For Each objUser In colUsers
			strGroup = objUser.GroupComponent
			strGroup = Split(strGroup, "=")
			If strGroup(UBound(strGroup)) = """Administrators""" Then
				blnHasAdmins = True
				strUser = objUser.PartComponent
				strUser = Split(strUser, "=")
				If strUser(UBound(strUser)) = """" & strUserName & """" Then
					blnIsAdmin = True
				End If
			End If
		Next
	End If
	If blnHasAdmins = False Then
		'If there are no members of the Administrators group, assume everybody is an admin
		IsAdmin = True
	Else
		IsAdmin = blnIsAdmin 
	End If
End Function



'*****************************************************************************************
'****                            Unused code block                                    ****
'*****************************************************************************************

' Function AddressBarSearchScript(strFolder)
' 	Dim strData
' 	strData = ""
' 	strData = strData & "::  This file disables the ""Search from the Address bar"" feature " & vbCrLf
' 	strData = strData & "::  in Internet Explorer. This feature can cause problems when " & vbCrLf
' 	strData = strData & "::  used with restrictive hosts files. This computer uses such a " & vbCrLf
' 	strData = strData & "::  hosts file. The person who installed the hosts file elected to " & vbCrLf
' 	strData = strData & "::  install this file to make sure other users did not experience " & vbCrLf
' 	strData = strData & "::  problems with Internet Explorer replacing a good web page with " & vbCrLf
' 	strData = strData & "::  a search web page." & vbCrLf & vbCrLf
' 	'For some wacky reason, batch files can do anything.
' 	'Like create a Win98 Registry file (works on 2K/XP) and merge it.
' 	'If I'd done this with a script, it would fire security alerts.
' 	strData = strData & "@echo off" & vbCrLf
' 	strData = strData & " >""%temp%\DisableAddressBarSearch.reg"" echo REGEDIT4" & vbCrLf
' 	strData = strData & ">>""%temp%\DisableAddressBarSearch.reg"" echo." & vbCrLf
' 	strData = strData & ">>""%temp%\DisableAddressBarSearch.reg"" echo [HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\]" & vbCrLf
' 	strData = strData & ">>""%temp%\DisableAddressBarSearch.reg"" echo ""AutoSearch""=dword:00000000" & vbCrLf
' 	strData = strData & ">>""%temp%\DisableAddressBarSearch.reg"" echo." & vbCrLf
' 	strData = strData & "start /w regedit.exe /s ""%temp%\DisableAddressBarSearch.reg""" & vbCrLf
' 	strData = strData & "del ""%temp%\DisableAddressBarSearch.reg"" > nul" & vbCrLf
' 	strData = strData & "cls" & vbCrLf
' 	strData = strData & "exit"
' 	AddressBarSearchScript = String2File(strData, CreateObject("Scripting.FileSystemObject").BuildPath(strFolder, "Disable Address Bar Searching.bat")) 
' End Function

' Function PacEnableScript(strFolder, gstrHostsFolder)
' 	Dim strData
' 	strData = ""
' 	strData = strData & "::  This file enables a ""Proxy Access Control"" (PAC) script " & vbCrLf
' 	strData = strData & "::  in Internet Explorer (IE). A PAC is used to block access to " & vbCrLf
' 	strData = strData & "::  certain Internet resources (web pages, pictures, etc.). " & vbCrLf
' 	strData = strData & "::  The person who installed the proxy file elected to install " & vbCrLf
' 	strData = strData & "::  this file to make sure other users of this computer would " & vbCrLf
' 	strData = strData & "::  automatically get their IE configured to use the proxy file " & vbCrLf
' 	strData = strData & "::  as a PAC as soon as they logged in." & vbCrLf & vbCrLf
' 	'For some wacky reason, batch files can do anything.
' 	'Like create a Win98 Registry file (works on 2K/XP) and merge it.
' 	'If I'd done this with a script, it would fire security alerts.
' 	strData = strData & "@echo off" & vbCrLf
' 	strData = strData & " >""%temp%\EnablePac.reg"" echo REGEDIT4" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo." & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo [HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings]" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo ""AutoConfigURL""=""file://" & Replace(CreateObject("Scripting.FileSystemObject").BuildPath(gstrHostsFolder, "proxy"), "\", "/") & """" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo ""ProxyEnable""=dword:00000000" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo ""ProxyBypass""=dword:00000000" & vbCrLf
' 	'strData = strData & ">>""%temp%\EnablePac.reg"" echo ""ProxyOverride""=-" & vbCrLf
' 	'strData = strData & ">>""%temp%\EnablePac.reg"" echo "";roxyServer""=-" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo." & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo [HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1]" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo ""Flags""=dword:000000d3" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo." & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo [HKEY_CURRENT_USER\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings]" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo ""EnableAutoProxyResultCache""=dword:00000000" & vbCrLf
' 	strData = strData & ">>""%temp%\EnablePac.reg"" echo." & vbCrLf
' 	strData = strData & "start /w regedit.exe /s ""%temp%\EnablePac.reg""" & vbCrLf
' 	strData = strData & "del ""%temp%\EnablePac.reg"" > nul" & vbCrLf
' 	strData = strData & "cls" & vbCrLf
' 	strData = strData & "exit"
' 	PacEnableScript = String2File(strData, CreateObject("Scripting.FileSystemObject").BuildPath(strFolder, "Enable PAC File.bat")) 
' End Function

' Function ChooseOne(strPrompt, strTitle, strTabDelimitedChoices)
' 'Returns one of several string choices. 
' 'Returns empty string if there is a problem.
' Dim fs, web, doc
' Dim strFile, strChoice
' Dim intChars
' Dim dtTime
' 	On Error Resume Next
' 	Set web = CreateObject("InternetExplorer.Application")
' 	If web Is Nothing Then
' 		ChooseOne = ""
' 		Exit Function
' 	End If
' 	'Increase displayed width to accomodate longest string choice
' 	intChars = 0
' 	For Each strChoice In Split(strTabDelimitedChoices, vbTab)
' 		If Len(strChoice) > intChars Then intChars = Len(strChoice)
' 	Next
' 	If intChars > 20 Then
' 		web.Width = 250 + 6 * (intChars - 20)
' 	Else
' 		web.Width = 250
' 	End If
' 	web.Height = 200
' 	web.Offline = True
' 	web.AddressBar = False
' 	web.MenuBar = False
' 	web.StatusBar = False
' 	web.Silent = True
' 	web.ToolBar = False
' 	web.Navigate "about:blank"
' 	'Wait for the browser to navigate to nowhere
' 	dtTime = Now
' 	Do While web.Busy
' 		'Don't wait more than 5 seconds
' 		Wscript.Sleep 100
' 		If (dtTime + 5/24/60/60) < Now Then
' 			ChooseOne = ""
' 			web.Quit
' 			Exit Function
' 		End If
' 	Loop
' 	'Wait for a good reference to the browser document
' 	Set doc = Nothing
' 	dtTime = Now
' 	Do Until Not doc Is Nothing
' 		Wscript.Sleep 100
' 		Set doc = web.Document
' 		'Don't wait more than 5 seconds
' 		If (dtTime + 5/24/60/60) < Now Then
' 			ChooseOne = ""
' 			web.Quit
' 			Exit Function
' 		End If
' 	Loop
' 	'Write the HTML form
' 	doc.Write "<html><head><title>" & strTitle & "</title></head>"
' 	doc.Write "<body><b>" & strPrompt & "</b><br><form><select name=""choice"">"
' 	For Each strChoice In Split(strTabDelimitedChoices, vbTab)
' 		doc.Write "<option value=""" & strChoice & """>" & strChoice
' 	Next
' 	doc.Write "</select>"
' 	doc.Write "<br><br><input type=button "
' 	doc.Write "name=submit "
' 	doc.Write "value=""OK"" onclick='javascript:submit.value=""Done""'>"
' 	doc.Write "</form></body></html>"
' 	'Show the form
' 	web.Visible = True
' 	'Wait for the user to choose, but fail gracefully if a popup killer.
' 	Err.Clear
' 	Do Until doc.Forms(0).elements("submit").Value <> "OK"
' 		Wscript.Sleep 100
' 		If doc Is Nothing Then
' 			ChooseOne = ""
' 			web.Quit
' 			Exit Function
' 		End If
' 		If Err.Number <> 0 Then
' 			ChooseOne = ""
' 			web.Quit
' 			Exit Function
' 		End If
' 	Loop
' 	'Retrieve the chosen value
' 	ChooseOne = doc.Forms(0).elements("choice").Value
' 	web.Quit
' End Function

' Function HasWMI()
' 'Returns True is able to get CIMV2
' Dim oTest
' 	Set oTest = Nothing
' 	On Error Resume Next
' 	Err.Clear
' 	Set oTest = GetObject("winmgmts:\\.\root\CIMV2")
' 	If oTest Is Nothing Then
' 		If OsVersion() = 4 Then
' 			If MsgBox ("You don't seem to have WMI (Windows Management Infrastructure). May I take you to a Microsoft web page where you can download WMI?", vbYesNo, "WMI") = vbYes Then
' 				ws.Run "http://www.microsoft.com/downloads/details.aspx?FamilyID=afe41f46-e213-4cbf-9c5b-fbf236e0e875&DisplayLang=en", 1, False
' 			End If
' 		End If
' 		HasWMI = False
' 	Else
' 		Set oTest = Nothing
' 		HasWMI = True
' 	End If
' End Function