Active Directory: VBscript to enumerate the send as rights on a user or resource account

Posted February 4th, 2010 in sendasrights by dirk adamsky

This is the second script for today.
It enumerates the “send as” rights on a user or resource account (mailbox).
The “send as” rights are formatted as “domainprew2kname”.

What the script does:

  • ask for the smtp address of the user (inputbox)
  • the function GetDN gets the distinguished name
  • create the user/resource account object
  • create the securitydescriptor, discretionaryacl en accesscontrolentry objects
  • enumerate all aces/accounts with the “send as” right
  • filter removed accounts (S-1….) and “NT AUTHORITHYSELF”

Follow the next steps to run the script (no admin rights needed):

  • find the smtp address of the user (outlook/aduc)
  • open your favorite text editor
  • copy and paste the script into the editor
  • save the script (for example c:tempsendas.vbs)
  • open a command prompt
  • go to “c:temp”
  • give “cscript sendas.vbs” (without quotes) and enter
  • in the input box fill in the smtp address of the user
  • give “ok”

The script:

' Name : sendas.vbs
' Description : script to enumerate the send as rights on a user or resource account
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 04-02-2010
' Level : advanced

strAccount = InputBox("Fill in the smtp address of the account")
strAccountDN = GetDN(strAccount)

Set objAccount = getobject("LDAP://" & strAccountDN)
Set objSecurityDescriptor = objAccount.Get("ntSecurityDescriptor")
Set objDacl = objSecurityDescriptor.DiscretionaryAcl
Set objAce = CreateObject("AccessControlEntry")

For Each objAce In objDacl
	If objAce.ObjectType = "{AB721A54-1E2F-11D0-9819-00AA0040529B}" Then
		If (Left(objAce.Trustee,3) <> "S-1" And objAce.Trustee <> "NT AUTHORITYSELF") Then
			wscript.echo objAce.Trustee & " - send mail as"
		End If
	End If
Next

Set objAce = Nothing
Set objDacl = Nothing
Set objSecurityDescriptor = Nothing
set objAccount = Nothing

Function GetDN(strMail)

	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

	' Search entire Active Directory domain.
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	strBase = "<LDAP://" & strDNSDomain & ">"

	' Filter on user objects.
	strFilter = "(&(objectCategory=person)(objectClass=user)(mail=" &  strMail & "))"

	' Comma delimited list of attribute values to retrieve.
	strAttributes = "distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute
	GetDN = adoRecordset.Fields("distinguishedName").Value
	' Clean up.
	adoRecordset.Close
	adoConnection.Close

	Set adoRecordset = Nothing
	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing

End Function

If you have questions/problems or simply like the script please post a reply.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV