Creating a Global Address Book

Article
08/20/2015

Creating a Global Address Book

This content is no longer actively maintained. It is provided as is, for anyone who may still be using these technologies, with no warranties or claims of accuracy with regard to the most recent product version or service release.

The following example creates a global address book for the specified hosted organization. This example uses functions for Deleting an ACE From an ACL, Adding an ACE To an Existing ACL, Reordering a DACL, and Removing Permissions from the Default Global Address List.

Visual Basic

'//////////////////////////////////////////////////////////////////////
' Function: createGlobalAddressBook()
' Purpose:  Creates a global address book for the specified hosted organization.
'
' Input:    szDomainName:         Domain of the Exchange organization
'           szOrganizationName:   Name of the exchange organization
'           szAddressName:        Name of the GAL
'           szDomain:             Domain of the hosted org
'           szUserName:           Admin username
'           szUserPwd:            Admin pwd
'           szDirectoryServer:    Name of the Directory Server
'
' Output:   getValue:             Contains Error code (if any)
'
' Note:  In order for this example to function correctly, it may be necessary to include
' references to the following libraries: Active DS Type Library, Microsoft CDO for
' Exchange Management Library, Microsoft Cluster Service Automation Classes,
' Microsoft CDO for Windows 2000 Library.
'//////////////////////////////////////////////////////////////////////
Public Function createGlobalAddressBook(ByVal szDomainName As String, _
                                        ByVal szOrganizationName As String, _
                                        ByVal szAddressName As String, _
                                        ByVal szDomain As String, _
                                        ByVal szUserName As String, _
                                        ByVal szUserPwd As String, _
                                        ByVal szDirectoryServer) As Integer

    Dim objLdap As IADsOpenDSObject
    Dim objgal As IADs
    Dim objGalContainer As IADsContainer
    Dim szConnString As String
    Dim szSearchRequest As String
    Dim objSecurityDescriptor As SecurityDescriptor
    Dim objParentSD As SecurityDescriptor
    Dim objParentDACL As AccessControlList
    Dim objCopyDACL As AccessControlList
    Dim objNewDACL As AccessControlList
    Dim iCurrentControl As Variant
    Dim objOACE As AccessControlEntry
    Dim szaDomTokens() As String
    Dim szDomainDN As String
    Dim szUserGroup As String
    Dim szAdminGroup As String

    On Error GoTo errhandler

    ' Initialize strings.
    szUserGroup = "AllUsers"
    szAdminGroup = "Admins"

    ' Put the domain name into an ldap string.
    szaDomTokens = Split(szDomainName, ".", -1, 1)
    szDomainDN = Join(szaDomTokens, ",dc=")
    szDomainDN = "dc=" & szDomainDN

    ' Build the ldap connection string.
    szConnString = "LDAP://" + szDirectoryServer + "/" + _
                 "cn=All Global Address Lists,cn=Address Lists Container,cn=" + szOrganizationName + _
                 ",cn=microsoft exchange,cn=services,cn=configuration," + szDomainDN

    szSearchRequest = "(|(&(&(&(&(mailnickname=*)(|(&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=contact))(objectCategory=group)(objectCategory=publicFolder))))(objectCategory=group)(cn=*" + szDomain + ")))"
    szSearchRequest = szSearchRequest + "(&(&(&(&(mailnickname=*)(|(&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=contact))(objectCategory=group)(objectCategory=publicFolder))))(objectClass=user)(mail=*" + szDomain + "))))"

    ' Open up the directory with the passed credentials (preferably the admin).

    Set objLdap = GetObject("LDAP:")

    ' Get a container object from the connection string.

    Set objGalContainer = objLdap.OpenDSObject(szConnString, _
                                               szUserName, _
                                               szUserPwd, _
                                               ADS_SECURE_AUTHENTICATION)

    ' Create the recipient policy object.

    Set objgal = objGalContainer.Create("addressBookContainer", _
                                        "cn=" + szAddressName)

    ' Required properties.

    With objgal
        .Put "purportedSearch", szSearchRequest
        .Put "name", szAddressName
        .Put "displayName", szAddressName
        .Put "showInAdvancedViewOnly", True
        .Put "systemFlags", 1610612736
        .SetInfo
    End With

    ' Now that the address book has been created, set security permissions.
    ' Get a handle to the security descriptor object on the new GAL.

    Set objSecurityDescriptor = objgal.Get("ntSecurityDescriptor")

    ' Get the security control object.

    iCurrentControl = objSecurityDescriptor.Control

    ' Turn off inheritance.

    objSecurityDescriptor.Control = iCurrentControl Or SE_DACL_PROTECTED

    ' Get the Security Descriptor for the parent object.

    Set objParentSD = objGalContainer.Get("ntSecurityDescriptor")

    ' Get the access control list for the parent SD.

    Set objParentDACL = objParentSD.DiscretionaryAcl

    ' Make a copy of the ACL that is on the parent object (replicate it to the new GAL).

    Set objCopyDACL = objParentDACL.CopyAccessList()

    ' Delete the specified ACL.

    DeleteAce objCopyDACL, "NT AUTHORITY\Authenticated Users"

    ' Add the ACL for the group.

    AddAce objCopyDACL, szUserGroup + "@" + szDomain, 131220, 0, 2, 0, 0, 0
    AddAce objCopyDACL, szUserGroup + "@" + szDomain, 256, 5, 2, 1, "{A1990816-4298-11D1-ADE2-00C04FD8D5CD}", 0

    AddAce objCopyDACL, szAdminGroup + "@" + szDomain, 131220, 0, 2, 0, 0, 0
    AddAce objCopyDACL, szAdminGroup + "@" + szDomain, 256, 5, 2, 1, "{A1990816-4298-11D1-ADE2-00C04FD8D5CD}", 0

    ' Reorder the ACLs.

    Set objNewDACL = ReorderACL(objCopyDACL)

    ' Set the new ACL.

    objSecurityDescriptor.DiscretionaryAcl = objNewDACL
    ' Save changes.

    objgal.Put "ntSecurityDescriptor", objSecurityDescriptor
    objgal.SetInfo

    ' Remove settings from default GAL.

    resetDefaultGAL szDomainName, _
                    szOrganizationName, _
                    szUserName, _
                    szUserPwd, _
                    szDirectoryServer

    createGlobalAddressBook = 0

    ' Clean up.
    Set objLdap = Nothing
    Set objgal = Nothing
    Set objGalContainer = Nothing
    Exit Function

    ' Error handling.
errhandler:

    Set objLdap = Nothing
    Set objgal = Nothing
    Set objGalContainer = Nothing
    createGlobalAddressBook = 1
    ' Implement error logging here.

    Exit Function

End Function

Send us your feedback about the Microsoft Exchange Server 2003 SDK.

This topic last updated: March 2004

Build: June 2007 (2007.618.1)

Share via

Creating a Global Address Book

Creating a Global Address Book

Visual Basic

Additional resources