次の方法で共有

How to create an Offline Address Book using Visual Basic

  • [アーティクル]

I thought that this would be fun to post, so here it is :)

 

'//////////////////////////////////////////////////////////////////////

' Function: createOfflineAddressBook()

' Purpose: Creates an Offline Address Book. '

' Input: szDomainName: Domain of the Exchange org

' szOrganizationName: Name of Exchange org

' szAddressName: Name of address book

' szDomain: Domain suffix ' szUserName: admin username

' szUserPwd: admin pwd ' szDirectoryServer: Name of the Directory Server

' szAdminGroup: Name of the Admin Group '

' Output: createOfflineAddressBook: 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 createOfflineAddressBook(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, _ ByVal szAdminGroup) As Integer

 

Dim objLdap As IADsOpenDSObject

Dim objOAB As IADs

Dim objOABContainer As IADsContainer

Dim szLdapDomain As String

Dim szConnString As String

Dim szSiteFolderServer As String

Dim szAddressBookLocation As String

Dim baSchedule(83) As Byte

Dim szaOfflineABSServer() As String

Dim szOfflineABServer As String

Dim iIndex As Integer

Dim baGuidArray(15) As Byte

Dim szaDomTokens() As String

Dim szDomainDN As String

Dim iIndex As Integer

Dim iCounter As Integer

Dim szChar As String

Dim bConv As Byte

 

Dim szGuid As String On Error GoTo errhandler

 

' Puts the domain specified into an ldap domain string.

szaDomTokens = Split(szDomainName, ".", -1, 1) szDomainDN = Join(szaDomTokens, ",dc=")

szDomainDN = "dc=" & szDomainDN szLdapDomain = szDomainDN

 

' Fill in byte array, this is expensive but it's only called once per ' hosted org creation.

For iIndex = LBound(baSchedule) To UBound(baSchedule)

 

Select Case iIndex

Case 6

baSchedule(iIndex) = 8

Case 18

baSchedule(iIndex) = 8

Case 30

baSchedule(iIndex) = 8

Case 42

baSchedule(iIndex) = 8

Case 54

baSchedule(iIndex) = 8

Case 66

baSchedule(iIndex) = 8

Case 78

baSchedule(iIndex) = 8

Case Else baSchedule(iIndex) = 0

End Select

Next

 

' Location of address book.

szAddressBookLocation = "cn=" + szAddressName + _ ",cn=All Global Address Lists,cn=Address Lists Container,cn=" + _ szOrganizationName + ",cn=microsoft exchange,cn=services,cn=configuration," + _ szLdapDomain

 

' Get the site server string.

szConnString = "LDAP://" + szDirectoryServer + "/" + _ "cn=" + szAdminGroup + ",cn=Administrative Groups,cn=" + _ szOrganizationName + ",cn=Microsoft Exchange,CN=Services,CN=Configuration," + _ szLdapDomain

 

' On the Admin group object, get the site folder server value.

getValue szConnString, "siteFolderServer", szSiteFolderServer, szUserName, szUserPwd

 

' The offlineABServer is the sitefolderserver minus the first four entries,' so when putting the ‘szOfflineABSServer string together, start indexing at 4.

 

szaOfflineABSServer = Split(szSiteFolderServer, "cn=", -1, 1)

szOfflineABServer = ""

For iIndex = 4 To UBound(szaOfflineABSServer)

szOfflineABServer = szOfflineABServer + "cn=" + szaOfflineABSServer(iIndex)

Next

 

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

 

' Create a connection string for the offline address book.

szConnString = "LDAP://" + szDirectoryServer + "/" + _ "CN=Offline Address Lists,CN=Address Lists Container,CN=" + _ szOrganizationName + ",CN=Microsoft Exchange,CN=Services,CN=Configuration," + _ szLdapDomain Set objLdap = GetObject("LDAP:")

 

' Create object and get FID.

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

 

 ' Create the recipient policy object.

 Set objOAB = objOABContainer.Create("msExchOAB", _ "cn=" + szAddressName)

 

 ' Set required properties and Take the string guid and get the guid as a hex byte array.

 szGuid = GetGUID

 

iIndex = 0

 

For iCounter = 1 To Len(szGuid) Step 2

' Get the current character.

szChar = Mid(szGUID, iCounter, 2)

' Convert the character to it's hex value.

 bConv = getByteValue(szChar)

' Stick that hex value into the byte array.

baGuidArray(iIndex) = bConv

 iIndex = iIndex + 1

Next

 

With objOAB

.Put "name", szAddressName

.Put "showInAdvancedViewOnly", True

.Put "systemFlags", 1610612736

.Put "doOABVersion", 0

.Put "msExchOABFolder", 0

.Put "offLineABContainers", szAddressBookLocation

.Put "offLineABSchedule", baSchedule

.Put "offLineABServer", szOfflineABServer

.Put "offLineABStyle", 1

.Put "siteFolderGUID", baGuidArray

 .Put "siteFolderServer", szSiteFolderServer

.Put "legacyExchangeDN", "/o=" + szOrganizationName + "/cn=addrlists/cn=oabs/cn=" + szAddressName

.SetInfo End With createOfflineAddressBook = 0

 

' Clean up.

 

 Set objLdap = Nothing

Set objOAB = Nothing

Set objOABContainer = Nothing

Exit Function

 

' Error handling. errhandler:

Set objLdap = Nothing

Set objOAB = Nothing

Set objOABContainer = Nothing

createOfflineAddressBook = 1

 

' Implement error logging here.

Exit Function

End Function

 

Dave

Comments