Finding a user in Exchange mailbox security

A script to read the mailbox security descriptor from Active Directory with the intention of finding a particular user or security principal. It will not display the security descriptor, it simply displays whether or not the account is present in the access control list.

The script works best when run with cscript as the script uses WScript.Echo to write back whether or not it finds a match.

It can be used against Exchange 2000 or Exchange 2003. Exchange 2007 can use Get-MailboxPermission to query the same information.

MailboxRights is used to retrieve the mailbox security descriptor. As part of CDOEXM (Collaboration Data Objects for Exchange Management) the Exchange System Tools must be installed on the system executing the script.

Option Explicit ' FindMailboxAccess.vbs ' ' Short Script to Find and Enumerate Mailbox Access for the specified ' security principal. Searches current domain, must be run as an Exchange Admin ' account to invoke MailboxRights method. ' ' This script is slow, it's speed is unavoidable as MailboxRights cannot be ' executed until connected to an individual user. That means we have to connect ' to every user account to determine whether or not the security principal is ' present within the ACL. ' ' Author: Chris Dent ' Modified: 04/01/2008 Sub UsageText Dim strMessage strMessage = "Usage:" & VbCrLf & VbCrLf strMessage = strMessage & "cscript " & WScript.ScriptName & _ &" " & VbCrLf strMessage = strMessage & VbCrLf strMessage = strMessage & "Note: This script must be executed as Exchange " & _ "Administrator to enumerate" & VbCrLf strMessage = strMessage & "the Mailbox Security Descriptor" & VbCrLf WScript.Echo strMessage WScript.Quit End Sub Sub SortArgv Dim objArgv Set objArgv = WScript.Arguments If objArgv.Count < 1 Then UsageText End If strSearchString = objArgv(0) Set objArgv = Nothing End Sub Sub SearchAD Const ADS_SCOPE_SUBTREE = 2 Dim objConnection, objCommand, objRootDSE, objRecordSet, objUser Dim objMailboxSD, objDACL, objACE Set objConnection = CreateObject("ADODB.Connection") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand = CreateObject("ADODB.Command") objCommand.ActiveConnection = objConnection Set objRootDSE = GetObject("LDAP://RootDSE") objCommand.CommandText = "SELECT distinguishedName, homeMDB " & _ "FROM 'LDAP://" & objRootDSE.Get("defaultNamingContext") & _ "' WHERE objectClass='user' AND objectCategory='person'" WScript.Echo "Searching: " & objRootDSE.Get("defaultNamingContext") Set objRootDSE = Nothing objCommand.Properties("Page Size") = 1000 objCommand.Properties("Timeout") = 600 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE objCommand.Properties("Cache Results") = False Set objRecordSet = objCommand.Execute While Not objRecordSet.EOF On Error Resume Next If Not IsNull(objRecordSet.Fields("homeMDB")) Then ' Can't avoid connecting to the user, need to call the MailboxRights method Set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value) Err.Clear Set objMailboxSD = objUser.MailboxRights Set objDACL = objMailboxSD.DiscretionaryAcl If Err.Number 0 Then ' Ignore It Else For Each objACE in objDACL If InStr(1, objACE.Trustee, strSearchString, VbTextCompare) Then WScript.Echo "Found In Mailbox ACL: " & objUser.Name End If Next End If On Error Goto 0 End If objRecordSet.MoveNext Wend objConnection.Close Set objRecordSet = Nothing Set objCommand = Nothing Set objConnection = Nothing End Sub ' ' Main Code ' Dim strSearchString SortArgv WScript.Echo "Search String: " & strSearchString SearchAD