Indented!

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 & _
    " <search String>" & 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

No related posts.

Related posts brought to you by Yet Another Related Posts Plugin.