Wednesday, October 13, 2010

VBScript to remotely report on a current user's IE Security settings

I had a request come up today to report back on whether or not a trusted site had been successfully added to user's IE security settings.

The trusted site was applied using Group Policy (under user configuration, windows settings). The following Microsoft article describes how these settings are stored in the windows registry:

Below is the script used to look for a trusted site and report back to a text file. You will need to provide a list of computers that the script will read from:

On Error Resume Next

Const ForReading = 1
Const ForWriting = 2
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_USERS = &H80000003

Dim objFSO, sZoneMap, strComputerName, objStatus, objPing, MyArray
Dim logonname, User, Users, strUsr, strDomain, objWMIService

Dim colAccounts, objAccount, strSID, objPCList, objZoneMap, objPingFailList, oReg
Dim strKeyPath, strValueName

If LCase(Right(wscript.FullName,11)) = "wscript.exe" Then
Set oShell=CreateObject("WScript.Shell")
oShell.Run "cscript.exe /nologo """ & wscript.ScriptFullName & """", 1, False
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objPCList = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) & "\Computers.txt", ForReading)
Set objZoneMap = objFSO.CreateTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) & "\ZoneMap.txt", ForWriting)
Set objPingFailList = objFSO.CreateTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) & "\Ping_Failed.txt", ForWriting)

Do Until objPCList.AtEndOfStream
strComputerName = Trim(objPCList.Readline)
On Error Resume Next
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerName & "\root\cimv2")
Set Users = objWMIService.InstancesOf ("Win32_ComputerSystem")

For Each User in Users
logonname = User.UserName
'WScript.Echo logonname
MyArray = Split(logonname,"\",-1,1)
strDomain = MyArray(0)
strUsr = MyArray(1)
Exit For

Set colAccounts = objWMIService.ExecQuery ("select * From Win32_UserAccount where " & "name = '" & strUsr & "' AND domain = '" & strDomain & "'")
For Each objAccount In colAccounts
strSID = objAccount.SID
Exit For

Set objPing = objWMIService.ExecQuery("select * from Win32_PingStatus where address = '" & strComputerName & "'")
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then
WScript.Echo strComputerName & " is not reachable"
objPingFailList.WriteLine strComputerName
Set sZoneMap = Nothing
On Error Resume Next
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strComputerName & "/root/default:StdRegProv")
strKeyPath = strSID & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\yourdomain\subdomain"
strValueName = "http"
oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,sZoneMap
Wscript.Echo strSID & vbTab & strComputerName & vbTab & sZoneMap
objZoneMap.WriteLine strComputerName & vbTab & "has version " & sZoneMap
End If


Thanks to JJ for large portions of this code!