You can use ADSI
to talk to Exchange Directory Services. You can enumerate sites, containers, create
recipients, and many other tasks. For more information about ADSI in the
Exchange Server 5.5, please see the new ADSI Exchange Programmer's Guide in
the ADSI
2.5 Help File.
Requirements
- Install Exchange Server. For more
information about Exchange, visit http://www.microsoft.com/exchange.
- For the purpose of the
walkthrough, copy adsvw.exe to your local hard drive, if you haven't
already done so.
Getting to know
Exchange
Exchange Tasks
Browsing an
Exchange Server
- Before browsing the Exchange directory, you must know the server
name on which Exchange Server is running.
- Run the ADSVW, select View as Object
Viewer.
- Type ADsPath as: LDAP://exchsrv
where exchsrv is the Exchange server name.
- Optionally, you can provide an alternate credential, by
checking Use OpenObject, and provide a username and password.
- Click OK.
- You will be able to navigate the Exchange Directory as shown
below.

Go to top.
Enumerating
a Recipient Container Programmatically
'----Replace
these variables accordingly----
siteName = "INDEPENDENCE"
exchSrv = "exchsrv11"
'By getting rootDSE's defaultNamingContext, we don't have to hard code the
Exchange
Organization
Set rootDSE = GetObject("LDAP://" & exchSrv & "/RootDSE")
'Build ADsPath for the container
contPath = "LDAP://" & exchSrv & "/" &
"CN=Recipients," & "OU=" & siteName & "," &
rootDSE.Get("defaultNamingContext")
Set cont = GetObject(contPath)
'Print all persons in the recipient container
wscript.echo "Person List----"
cont.Filter = Array("organizationalPerson")
For Each person In cont
wscript.echo person.Name
Next
wscript.echo
wscript.echo "Distribution List----"
'Print all distribution lists in the recipient container
cont.Filter = Array("groupOfNames")
For Each dl In cont
wscript.echo dl.Name
Next
'-- Source code in \samples\Exchange directory
Go to top.
Creating
a Custom Recipient
'-------------------------------------------------------
'-----CREATING A CUSTOM RECIPIENT ----------------------
'--------------------------------------------------------
'----Server, Organization, and Site information----
server = "exchsrv55"
org = "Microsoft"
site = "Redmond"
'----Custom Recipient----
strDisplayname = "James Smith"
strAlias = "jsmith"
strTelephone = "867-5309"
'----Build an adsPath that looks like this: LDAP://myserver/CN=Recipients, OU=Site, O=Org
adsPath = "LDAP://" + server
adsPath = adsPath + "/cn=Recipients,OU="
adsPath = adsPath + site
adsPath = adsPath + ",O="
adsPath = adsPath + org
Set objCont = GetObject(adsPath)
Set objNewCR = objCont.Create("Remote-Address", CStr("cn=" &
strAlias))
objNewCR.Put "cn", CStr(strDisplayname)
objNewCR.Put "uid", CStr(strAlias)
objNewCR.Put "telephoneNumber", CStr(strTelephone)
objNewCR.Put "Target-Address", "SMTP:jsmith@microsoft.com"
objNewCR.SetInfo
Go to top.
Creating
a Mailbox
You can create a mailbox using
Win32 Security APIs. The mailbox sample demonstrates
this.
Alternatively, you can use the ADSI
Resource Kit to create a mailbox.
'------------------------------------------------
'-----CREATING A MAILBOX ----------------------
'------------------------------------------------
'----Server, Organization, and Site information----
server = "exchsrv"
org = "ARCADIABAY"
Site = "REDMOND"
'--- Mailbox Parameters -----
strDisplayName = "Alice Wonderland"
strFirstName = "Alice"
strLastName = "Wonderland"
strAlias = "alicew"
strMTA = "cn=Microsoft
MTA,cn=exchsrv,cn=Servers,cn=Configuration,ou=REDMOND,o=ARCADIABAY"
strMDB = "cn=Microsoft Private
MDB,cn=exchsrv,cn=Servers,cn=Configuration,ou=REDMOND,o=ARCADIABAY"
strSMTPAddr = "alicew@arcadiabay.com"
'--- Build the Recipient container's adsPath to look like this:
LDAP://myserver/CN=Recipients, OU=Site, O=Org
ADsPath = "LDAP://" + server
ADsPath = ADsPath + "/cn=Recipients,OU="
ADsPath = ADsPath + Site
ADsPath = ADsPath + ",O="
ADsPath = ADsPath + org
Set objCont = GetObject(ADsPath)
'Create a new MailBox
Set objNewUser = objCont.Create("organizationalPerson", "cn=" &
strAlias)
objNewUser.Put "mailPreferenceOption", 0
objNewUser.Put "givenName", strFirstName
objNewUser.Put "sn", strLastName
objNewUser.Put "cn", strDisplayName
objNewUser.Put "uid", strAlias
objNewUser.Put "Home-MTA", strMTA
objNewUser.Put "Home-MDB", strMDB
objNewUser.Put "mail", strSMTPAddr
objNewUser.Put "MAPI-Recipient", True
objNewUser.Put "rfc822Mailbox", strSMTPAddr
'You should associate
your mailbox to a Windows NT account using IADsSID in the
Resource Kit.
'Commit the property cache to the directory service.
objNewUser.SetInfo
'Additionally, you may set
X.400 and other
mailbox addresses.
Go to top.
Associating
a Mailbox Owner with a Windows NT User
You need to install the ADSI
Resource Tool Kit for this sample.
'--------------------------------------------------------
' ASSOCIATING TO A WINDOWS NT PRIMARY ACCOUNT
' (REQUIRED ADSI TOOL KIT - ADSSECURITY.DLL )
'---------------------------------------------------------
Dim sid As New ADsSID
Set mailBox =
GetObject("LDAP://exchsrv03/cn=alicew,cn=Recipients,ou=REDMOND,o=ARCADIABAY")
sid.SetAs ADS_SID_WINNT_PATH, "WinNT://REDMOND/alicew"
sidHex = sid.GetAs(ADS_SID_HEXSTRING)
mailBox.Put "Assoc-NT-Account", sidHex
mailBox.SetInfo
Go to top.
Setting a
Mailbox's Permission
You need to install the ADSI
Resource Tool Kit for this sample.
'--------------------------------------------------------
' SETTING MAILBOX' SECURITY DESCRIPTOR
' (REQUIRED ADSI TOOL KIT - ADSSECURITY.DLL )
'---------------------------------------------------------
Dim sec As New ADsSecurity
Dim sd As IADsSecurityDescriptor
Dim dacl As IADsAccessControlList
Dim ace As New AccessControlEntry
Const ADS_RIGHT_EXCH_MODIFY_USER_ATT = &H2
Const ADS_RIGHT_EXCH_MAIL_SEND_AS = &H8
Const ADS_RIGHT_EXCH_MAIL_RECEIVE_AS = &H10
Set sd =
sec.GetSecurityDescriptor("LDAP://exchsrv/cn=alicew,cn=Recipients,ou=REDMOND,o=Microsoft")
Set dacl = sd.DiscretionaryAcl
ace.Trustee = "REDMOND\alicew"
ace.AccessMask = RIGHT_DS_MODIFY_USER_ATT Or RIGHT_MAIL_SEND_AS Or RIGHT_MAIL_RECEIVE_AS
ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED
dacl.AddAce ace
sd.DiscretionaryAcl = dacl
sec.SetSecurityDescriptor sd
Go to top.
Creating
a Recipient Container
adsPath = "LDAP://excsrv/ou=Site,o=Org"
Set objExistingCont = GetObject(adsPath)
' Create the container
Set objNewCont = objExistingCont.Create("Container",
"cn=MyNewContainer")
' Put the continer-info prop to tell Exchange this is a recipients cont.
objNewCont.Put "Container-Info", &H80000001
objNewCont.SetInfo
Go to top.
Creating a
Distribution List
'-------------------------------------------------------
'-----CREATING A DISTRIBUTION LIST ----------------------
'--------------------------------------------------------
'----Server, Organization, and Site information----
server = "exchsrv04"
org = "ArcadiaBay"
site = "ANN-ARBOR"
'----Distribution List----
strDisplayname = "Distributed System PM"
strAlias = "dpm"
strSMTPAddr = "dpm@arcadiabay.com"
'----Build a Recipient container's adsPath to look like this:
LDAP://myserver/CN=Recipients, OU=Site, O=Org
AdsPath = "LDAP://" + server
AdsPath = AdsPath + "/cn=Recipients,OU="
AdsPath = AdsPath + site
AdsPath = AdsPath + ",O="
AdsPath = AdsPath + org
Set objCont = GetObject(AdsPath)
'Create a new DL
Set objNewDL = objCont.Create("groupOfNames", "cn=" & strAlias)
'Set the DL props
objNewDL.Put "cn", CStr(strDisplayname)
objNewDL.Put "uid", CStr(strAlias)
objNewDL.Put "mail", CStr(strSMTPAddr)
objNewDL.SetInfo
Go to top.
Setting
the Owner of a Distribution List
'-------------------------------------------------------------------------------------
'--- SET THE OWNER OF THE DISTRIBUTION LIST
'------------------------------------------------------------------------------------
Set dl =
GetObject("LDAP://exchsrv/cn=dpm,cn=Recipients,ou=REDMOND,o=ArcadiaBay")
dl.Put "Owner", "cn=bobg,cn=Recipients,ou=REDMOND,o=ArcadiaBay"
dl.SetInfo
Go to top.
Setting a
Distribution List Owner's Permission
You need to install the ADSI
Resource Tool Kit for this sample.
Dim sec As New ADsSecurity
Dim sd As IADsSecurityDescriptor
Dim dacl As IADsAccessControlList
Dim ace As New AccessControlEntry
Const RIGHT_DS_MODIFY_USER_ATT = &H2
Const RIGHT_MAIL_SEND_AS = &H8
Const RIGHT_MAIL_RECEIVE_AS = &H10
'---------------------------------------------------------------------------------------
'-- SET PERMISSION ON THE OWNER TO MODIFY AND SEND AS/RECEIVE
'---NOTE: IT REQUIRES THAT THE ADSI RESOURCE TOOL KIT BE INSTALLED (IADsSecurity)
'---------------------------------------------------------------------------------------
Set sd =
sec.GetSecurityDescriptor("LDAP://exchsrv/cn=dpm,cn=Recipients,ou=REDMOND,o=ArcadiaBay")
Set dacl = sd.DiscretionaryAcl
ace.AccessMask = RIGHT_DS_MODIFY_USER_ATT Or RIGHT_MAIL_SEND_AS Or RIGHT_MAIL_RECEIVE_AS
ace.Trustee = "REDMOND\bobg"
dacl.AddAce ace
sd.DiscretionaryAcl = dacl
sec.SetSecurityDescriptor sd
Go to top.
Adding
Recipients to a
Distribution List
'----------------------------------------------
'----ADDING MEMBERS TO A DISTRIBUTION LIST
'----------------------------------------------
Set dl =
GetObject("LDAP://excsrv11/cn=dpm,cn=Recipients,ou=REDMOND,o=Microsoft")
dl.Add "LDAP://excsrv11/cn=jsmith,cn=Recipients,ou=REDMOND,o=Microsoft"
dl.Add "LDAP://excsrv11/cn=andyhar,cn=Recipients,ou=REDMOND,o=Microsoft"
Go to top.
Enumerating
Members in a Distribution List
'-------------------------------------------------
'----ENUMERATE MEMBERS IN A DISTRIBUTION LIST
'-------------------------------------------------
Set dl =
GetObject("LDAP://excsrv11/cn=dpm,cn=Recipients,ou=REDMOND,o=Microsoft")
For Each member In dl.Members
Debug.Print member.Name & " (" & member.Class &
")"
Next
Go to top.
Removing
Members in a Distribution List
'------------------------------------------------
'----REMOVING MEMBERS IN A DISTRIBUTION LIST
'------------------------------------------------
Set dl =
GetObject("LDAP://excsrv11/cn=dpm,cn=Recipients,ou=REDMOND,o=Microsoft")
dl.Remove "LDAP://excsrv11/cn=jsmith,cn=Recipients,ou=REDMOND,o=Microsoft"
Go to top.
Accessing
Hidden or Deleted Entries
Hidden objects are objects with the Boolean
attribute, "Hide from AB" ("Hide-From-Address-Book" to LDAP) set to
true ("1"). Deleted objects, also called tombstones, are objects with the
Boolean attribute "Is-Deleted" (also "Is-Deleted" to LDAP) attribute
set to true ("1").
'----ACCESSING HIDDEN OR DELETED ENTRIES----
' To access hidden or deleted items in the directory, you
must use
' OpenDSObject or AdsOpenObject(for VC++) to explicitly bind to the directory object
' with a valid user account using simple clear text authentication with
“cn=admin” appended to the username.
' For example: “cn=jsmith, dc=ARCADIABAY, cn=admin”.
' Also, the Exchange service account must be a member of the local administrators group on
the server
' and have explicit Restore Files and Directories privilege.
strADsPath = "LDAP://excsvr/cn=JustinH,cn=Recipients,ou=REDMOND,o=ARCADIABAY"
Set dso = GetObject("LDAP:")
Set objDeleted = dso.OpenDSObject(strADsPath, _
"cn=Administrator, dc=ARCADIABAY, cn=admin", "PasswordGoesHere", 0)
'objDeleted now is a reference to a deleted object.
Debug.Print objDeleted.Name
Go to top.
Retrieving
Changes
One important attribute is the object’s Update
Sequence Number or USN. When a change is made to an object in the Exchange directory, the
local directory service modifies the USN on the object to be the next available USN for
the server. Each server maintains it’s own USN count. So, when a server changes an
object, the directory service takes the current USN, increments it and stamps it on the
changed object. This way, if an application knows the USN number of the last changed
object it received from the server, the next time it makes a request for changes, it asks
for all directory objects with USNs greater than the last USN it received.
Dim ADOConn As ADODB.Connection
Dim ADOCommand As New Command
Dim RS As ADODB.Recordset
Set ADOConn = CreateObject("ADODB.Connection")
ADOConn.Provider = "ADSDSOObject"
ADOConn.Open "Active Directory Provider"
Set ADOCommand.ActiveConnection = ADOConn
ADOCommand.CommandText =
"<LDAP://localhost/o=ARCADIABAY>;(USN-Changed>1030);rdn;subtree"
Set RS = ADOCommand.Execute
While Not RS.EOF
Debug.Print (RS.Fields(0))
RS.MoveNext
Wend
RS.Close
Go to top.
Getting the
Organization and Site Name from a Server
srvName = "exchsrv"
Set objRoot = GetObject("LDAP://" & srvName)
Debug.Print objRoot.Get("o")
'--- OR ------
Set objRoot = GetObject("LDAP://" & srvName & "/RootDSE")
Debug.Print objRoot.Get("defaultNamingContext")
Go to top
Searching
all Exchange Servers in the Entire Organization
We will be using the LDAP Dialect for
searching. You can also use the SQL Dialect. For LDAP Dialect searching, please see Searching for an Alias.
Dim ADOConn As ADODB.Connection
Dim ADOCommand As New Command
Dim RS As ADODB.Recordset
srvName = "exchsrv"
Set ADOConn = CreateObject("ADODB.Connection")
ADOConn.Provider = "ADSDSOObject"
ADOConn.Open "Active Directory Provider"
Set ADOCommand.ActiveConnection = ADOConn
ADOCommand.CommandText = "<LDAP://" & srvName & ">;(
objectClass=Computer);rdn;subtree"
Set RS = ADOCommand.Execute
Debug.Print RS.Fields.Count
While Not RS.EOF
Debug.Print "Server: " & RS.Fields(0)
RS.MoveNext
Wend
RS.Close
Set ADOConn = Nothing
Set ADOCommand = Nothing
Set RS = Nothing
Go to top
Searching
for an Alias
We will be using the SQL Dialect for
searching. You can also use the LDAP Dialect. For LDAP Dialect searching, please see
Searching all Exchange Servers in the Entire Organization.
Set con = CreateObject("ADODB.Connection")
Set Com = CreateObject("ADODB.Command")
'Open a Connection object
con.Provider = "ADsDSOObject"
'------------------------------------------------------------------------------
' If you want to be authenticated as someone other than currently logged on user
' use the connection properties of User ID and Password.
'------------------------------------------------------------------------------
con.Properties("User ID") = "domain\user"
con.Properties("Password") = "password"
'----------------------
' Open the connection.
'----------------------
con.Open "Active Directory Provider"
'Create a command object on this connection
Set Com.ActiveConnection = con
'---------------------
'Set the query string.
'---------------------
adDomainPath = "LDAP://exchsrv/o=microsoft"
searchAlias = "jsmith"
Com.CommandText = "select ADsPath, uid, title, givenName, sn,
physicalDeliveryOfficeName,telephoneNumber from '" & adDomainPath & "'
where uid='" & searchAlias & "'"
'-------------------------------
'Set the preferences for search.
'-------------------------------
Com.Properties("Page Size") = 100
Com.Properties("Timeout") = 30 'seconds
Com.Properties("searchscope") = ADS_SCOPE_SUBTREE 'Define in ADS_SCOPEENUM
Com.Properties("Cache Results") = False ' do not cache the result, it results in
less memory requirements
'-------------------
'Execute the query.
'-------------------
Set RS = Com.Execute
'------------------------
' Navigate the record set.
'------------------------
If (RS.EOF = False) Then
Debug.Print "Alias = " & RS.Fields("UID").Value
Debug.Print "Name = " & RS.Fields("givenName").Value &
" " & RS.Fields("sn")
Debug.Print "Title = " & RS.Fields("Title").Value
Debug.Print "Office = " &
RS.Fields("physicalDeliveryOfficeName").Value
Debug.Print "Telephone = " &
RS.Fields("telephoneNumber").Value
End If
Go to top.
Getting
and Modifying Configuration Properties
This example displays and sets the value of the maximum
message size on an Exchange Server's Message Transfer Agent to 5mb.
Dim objMTA As IADs
Set objMTA = GetObject("LDAP://exchsrv/cn=Microsoft
MTA,cn=exchsrv,cn=Servers,cn=Configuration,ou=REDMOND,o=ARCADIABAY")
'Getting
objMTA.GetInfoEx Array("Deliv-Cont-Length"), 0
Debug.Print objMTA.Get("Deliv-Cont-Length")
'Modifying
objMTA.Put "Deliv-Cont-Length", 5000
objMTA.SetInfo
Set bjMTA = Nothing
Go to top.
Finding
a Home Server of a Mailbox
srvName = "exchsrv"
Set objMailbox = GetObject("LDAP://" & srvName &
"/cn=jsmit,cn=Recipients,ou=REDMOND,o=ArcadiaBay")
objMailbox.GetInfoEx Array("Home-MDB"), 0
dnPath = objMailbox.Get("Home-MDB")
Debug.Print dnPath
'Build the ADsPath for Home MDB
adsPath = "LDAP://" & srvName & "/" & dnPath
Set homeMDB = GetObject(adsPath)
'Home MDB object resides on the computer object
'So we need to go up one level before we get the computer object
Set srvMDB = GetObject(homeMDB.Parent())
Debug.Print "Home MDB ServerName is: " & srvMDB.Get("rdn")
Go to top
Setting and
Modifying the Exchange Security Descriptor
Public Const RIGHT_DS_ADD_CHILD = &H1
Public Const RIGHT_DS_MODIFY_USER_ATT = &H2
Public Const RIGHT_DS_MODIFY_ADMIN_ATT = &H4
Public Const RIGHT_DS_DELETE = &H10000
Public Const RIGHT_MAIL_SEND_AS = &H8
Public Const RIGHT_MAIL_RECEIVE_AS = &H10
Public Const RIGHT_MAIL_ADMIN_AS = &H20
Public Const RIGHT_DS_REPLICATION = &H40
Public Const RIGHT_DS_MODIFY_SEC_ATT = &H80
Public Const RIGHT_DS_SEARCH = &H100
The following sample is for reading and modifying
the Exchange Security Descriptor
Attribute in Exchange 5.5 and ADSI 2.5.
Dim propVal As IADsPropertyValue2
Dim sd As IADsSecurityDescriptor
Dim dacl As IADsAccessControlList
Dim ace As IADsAccessControlEntry
Dim o As IADs
Dim srv
srv = "andyhar04"
mailbox = "cn=andyhar"
Site = "ou=Redmond"
Org = "o=Microsoft"
'----Binding----
ADsPath = "LDAP://" & srv & "/" & mailbox &
",cn=Recipients," & Site & "," & Org
Set o = GetObject(ADsPath)
'----Get the Windows NT Security Descriptor as a raw binary security descriptor----
o.GetInfoEx Array("NT-Security-Descriptor;binary"), 0
v = o.Get("NT-Security-Descriptor")
'----Convert from a raw Security Descriptor to an IADsSecurityDescriptor----
Set propVal = CreateObject("PropertyValue")
propVal.PutObjectProperty ADSTYPE_OCTET_STRING, v
Set sd = propVal.GetObjectProperty(ADSTYPE_NT_SECURITY_DESCRIPTOR)
'----Enumerate an ACE in DACL----
Set dacl = sd.DiscretionaryAcl
For Each ace In dacl
'----TRUSTEE----
perm = ace.Trustee
'----ACE TYPE-----
If (ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED) Then
perm = perm & " is allowed to "
ElseIf (ace.Type = ADS_ACETYPE_ACCESS_DENIED) Then
perm = perm & " is denied to:"
End If
'----ACE MASK----
If (ace.AccessMask And RIGHT_MAIL_SEND_AS) Then
perm = perm & " -send mail"
End If
If (ace.AccessMask And RIGHT_MAIL_RECEIVE_AS) Then
perm = perm & " -receive mail as"
End If
If (ace.AccessMask And RIGHT_DS_MODIFY_USER_ATT) Then
perm = perm & " -modify user attributes"
End If
If (ace.AccessMask And RIGHT_DS_MODIFY_ADMIN_ATT) Then
perm = perm & " -modify admin attributes"
End If
If (ace.AccessMask & RIGHT_DS_DELETE) Then
perm = perm & " -delete this object"
End If
Debug.Print perm
Next
'---- You can also add a new ace, and add it to DACL
Set ace = CreateObject("AccessControlEntry")
ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED ' Allow permission
ace.AccessMask = RIGHT_MAIL_SEND_AS Or RIGHT_DS_MODIFY_USER_ATT Or
RIGHT_DS_MODIFY_ADMIN_ATT Or RIGHT_DS_DELETE
ace.Trustee = "NTDEV\Administrator"
dacl.AddAce ace
sd.DiscretionaryAcl = dacl
'--- Now you have to convert back to the Raw Security Descriptor
propVal.PutObjectProperty ADSTYPE_NT_SECURITY_DESCRIPTOR, sd
v = propVal.GetObjectProperty(ADSTYPE_OCTET_STRING)
'-- Commit to the Directory
o.Put "NT-Security-Descriptor;binary", v
o.SetInfo
Go to top
|