XCCC: How to Create an HTTP Virtual Directory on an Exchange 2000 Server for a Public Folder (277905)

MORE INFORMATION

You can run this sample code in Microsoft Visual Basic 6.0 or Microsoft Visual Basic Scripting Edition. You must first add the Active DS Type Library object (Winnt\System32\Activeds.tlb, available on all Microsoft Windows 2000 domain controllers), and the Microsoft CDO for Exchange Management Library object (Cdoexm.dll) to the References option of the Visual Basic project settings.

Use the following code to create the HTTP virtual directory:

' StrFolderName: The folder path that you want to publish as the virtual directory. Use the following format: "<TreeName>\<SubFolderName>"
' strComputerName: The computer name of your Exchange 2000 server where you set up this virtual directory.
Function CreateWeb(strFolderName as String, strComputerName as String)as Boolean

    Dim iServer         As New CDOEXM.ExchangeServer
    Dim strFHName       As String
    Dim NewWeb          As IADsContainer
    Dim ADCont          As IADsContainer

    Set iServer = CreateObject("CDOEXM.ExchangeServer")

    Result = True

    iServer.DataSource.Open strComputerName
    Set ADCont = GetObject("LDAP://" & iServer.DirectoryServer & "/CN=1,CN=HTTP,CN=Protocols,"_
    & Mid(iServer.DataSource.SourceURL, InStr(1, iServer.DataSource.SourceURL, "cn=")))

    Set NewWeb = ADCont.Create("msExchProtocolCfgHTTPVirtualDirectory", "cn=" & strFolderName)

    NewWeb.Put "hTTPPubGAL", CBool(0)
    NewWeb.Put "anonymousAccount", "IUSR_" & strComputerName
    NewWeb.Put "folderPathname", CStr(strFolderName)  
    ' "msExchAccessFlags" property: contains the virtual directory execute permission:
    '512 = Execute Permission=Script
    '516 = Execute Permission=Script&Execute
    '1=Read, 2=Write, 16=Script Access
    NewWeb.Put "msExchAccessFlags", CInt(535) 
    ' "msExchAuthenticationFlags" property: contains the virtual directory authentication settings:
    '1=Anonymous Access, 2=Basic, 4=NTLM
    NewWeb.Put "msExchAuthenticationFlags", CInt(7) 
    NewWeb.Put "msExchBasicAuthenticationDomain", CStr(strDomainName)
    NewWeb.Put "msExchDefaultLogonDomain", CStr(strDomainName)
    ' "msExchDirBrowseFlags" property: controls the Web directory browse permission of the virtual directory:
    '1073741854=No Dir Browse, -1073741794=Dir Browse
    NewWeb.Put "msExchDirBrowseFlags", -1073741794 

    'The property specifies the logon method for clear text logons 
    NewWeb.Put "msExchLogonMethod", CInt(3) 
    NewWeb.Put "msExchServerAutoStart", CBool(-1) 
    ' "msExchServerRole" property: This virtual directory resides on the front end or back end server:
    ' 1 = This is a front end server 
    ' 0 = This is a back end server
    NewWeb.Put "msExchServerRole", CInt(0)
    NewWeb.Put "name", CStr(strFolderName)
    'newweb.Put "showInAdvancedViewOnly", cbool(-1)

    On Error Resume Next
    Err.Clear
    NewWeb.SetInfo
    If Err <> 0 Then
       ' If user exists no need to raise an err
       If Err.Number <> &H80071392 Then 
          MsgBox CStr(Err.Number) + ") " + Err.Description, , Err.Source
          Result = False
        End If
    End If

    Set NewWeb = Nothing
    Set ADCont = Nothing
    Set iServer = Nothing

    CreateWeb = Result
End Function