Creating an HTTP Virtual Server
Creating an HTTP Virtual Server
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 an HTTP virtual server on the specified Microsoft® Exchange Server 2003. This example uses functions for Determining If the Specified Server Is a Front-End Server, Determining If the Specified Server Is a Clustered Server, Getting the DNS Address of a Cluster Server, Getting the DNS Name of a Server, Getting the Next Available Cluster Entry ID, Getting a List of All Servers in a Cluster, and Creating a Cluster Resource.
Visual Basic
'//////////////////////////////////////////////////////////////////////
' Function: createHTTPVirtualServer()
' Purpose: Creates an HTTP virtual server on the specified Exchange server.
'
' Input: szDomainName: Domain of the Exchange organization
' szOrganizationName: Name of Exchange Organization
' szAdministrativeGroupName: Name of Administrative Group
' szServerName: Name of server to use
' szDefaultLogonDomain: default logon domain setting
' szVirtualServerName: Name of virtual server
' szvirtualServerIP: IP address of virtual server
' szvirtualServerHostHeader: Host header of virtual server
' szMsExchDefaultDomain: Value for the msExchDefaultDomain property
' szUserName: Admin Username
' szUserPwd: Admin password
' szDirectoryServer: Name of the Directory Server
'
' Output: createHTTPVirtualServer: Contains Error code (if any)
' szEntryID: Could be modified on a clustered machine
'
' 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 createHTTPVirtualServer(ByVal szDomainName As String, _
ByVal szOrganizationName As String, _
ByVal szAdministrativeGroupName As String, _
ByVal szServerName As String, _
ByVal szDefaultLogonDomain As String, _
ByVal szVirtualServerName As String, _
ByVal szVirtualServerIP As String, _
ByVal szVirtualServerHostHeader As String, _
ByVal szMsExchDefaultDomain As String, _
ByRef szEntryID As String, _
ByVal szUserName As String, _
ByVal szUserPwd As String, _
ByVal szDirectoryServer) As Integer
Dim objLdap As IADsOpenDSObject
Dim objHosting As IADsContainer
Dim objHttpServerContainer As IADs
Dim szConnString As String
Dim bisFrontEnd As Boolean
Dim bIsClustered As Boolean
Dim szIPname As String
Dim szIPaddr As String
Dim szServers As String
Dim szaDomTokens() As String
Dim szDomainDN As String
On Error GoTo errhandler
' Put the domain name into an ldap string.
szaDomTokens = Split(szDomainName, ".", -1, 1)
szDomainDN = Join(szaDomTokens, ",dc=")
szDomainDN = "dc=" & szDomainDN
' Is this server a front end? Needed later for
' the msExchServerRole property.
isFrontEndServer szDomainName, _
szOrganizationName, _
szAdministrativeGroupName, _
szServerName, _
szUserName, _
szUserPwd, _
bisFrontEnd, _
szDirectoryServer
' Is this server a clustered server?
isClusteredServer szDomainName, _
szOrganizationName, _
szAdministrativeGroupName, _
szServerName, _
szUserName, _
szUserPwd, _
bIsClustered, _
szDirectoryServer
If bIsClustered Then
' Get the IP name of the server.
getServerIPName szDomainName, _
szOrganizationName, _
szAdministrativeGroupName, _
szServerName, _
szUserName, _
szUserPwd, _
szIPname, _
szDirectoryServer
' Get the IP address of the server.
getIPAddress szIPname, _
szIPaddr
szVirtualServerIP = szIPaddr
' Overwrite the entry ID with the next available entryID for this CLUSTER.
getClusterServerList szIPname, _
szServers
getNextClusterEntryID szServers, _
szEntryID, _
szDomainName, _
szOrganizationName, _
szAdministrativeGroupName,
szUserName, _
szUserPwd, _
szDirectoryServer
End If
' Build the ldap connection string.
szConnString = "LDAP://" + szDirectoryServer + "/cn=http,cn=protocols,cn=" + _
szServerName + ",cn=servers,cn=" + szAdministrativeGroupName + _
",cn=Administrative Groups,cn=" + szOrganizationName + _
",cn=Microsoft Exchange,cn=services,cn=configuration," + _
szDomainDN
' Open up the directory with the passed credentials (preferably the admin).
Set objLdap = GetObject("LDAP:")
' Get a container object from the connection string.
Set objHosting = objLdap.OpenDSObject(szConnString, _
szUserName, _
szUserPwd, _
ADS_SECURE_AUTHENTICATION)
' Create the object hosting container.
Set objHttpServerContainer = objHosting.Create("protocolCfgHTTPServer", _
"cn=" + szEntryID)
' Required properties.
With objHttpServerContainer
.Put "hTTPPubGAL", False
.Put "adminDisplayName", szVirtualServerName
.Put "systemFlags", 1610612736
.Put "msExchAccessFlags", 19
.Put "msExchAuthenticationFlags", 2
.Put "msExchBasicAuthenticationDomain", szDefaultLogonDomain
.Put "msExchDefaultDomain", szMsExchDefaultDomain
.Put "msExchDefaultLogonDomain", getTopLevelDomainName(szDomainName)
.Put "msExchDirBrowseFlags", -1073741794
.Put "msExchIncomingConnectionTimeout", 900
.Put "msExchLogonMethod", 3
.Put "msExchMaxIncomingConnections", 2000000000
.Put "msExchSecureBindings", szVirtualServerIP + ":443:" + szVirtualServerHostHeader
If bIsClustered Then
.Put "msExchServerAutoStart", False
Else
.Put "msExchServerAutoStart", True
End If
.Put "folderPathname", "MBX"
.Put "msExchServerBindings", szVirtualServerIP + ":80:" + szVirtualServerHostHeader
.Put "msExchLogType", 0
If bisFrontEnd Then
.Put "msExchServerRole", 1
Else
.Put "msExchServerRole", 0
End If
.SetInfo
End With
If bIsClustered Then
' Create a cluster resource for this new virtual server.
createClusterResource szServerName, _
szServerName, _
szVirtualServerName + " - HTTP Virtual Server Instance", _
szUserName, _
szUserPwd, _
szEntryID
End If
createHTTPVirtualServer = 0
' Clean up.
Set objLdap = Nothing
Set objHosting = Nothing
Set objHttpServerContainer = Nothing
Exit Function
' Error handling.
errhandler:
Set objLdap = Nothing
Set objHosting = Nothing
Set objHttpServerContainer = Nothing
' Implement error logging here.
createHTTPVirtualServer = 1
Exit Function
End Function
Send us your feedback about the Microsoft Exchange Server 2003 SDK.
Build: June 2007 (2007.618.1)
© 2003-2006 Microsoft Corporation. All rights reserved. Terms of use.