<% @ CodePage=1252 Language=VBScript %>
<% OPTION EXPLICIT %>
<!-- #include file="errors.inc" -->
<html>
<head>
<META http-equiv="Content-Type" content="text/html; charset=windows-1252">
<%
    On Error Resume Next
    CONST strPropSendEmailAddress = "http://schemas.microsoft.com/cdo/configuration/sendemailaddress"
    CONST strPropSendUsing = "http://schemas.microsoft.com/cdo/configuration/sendusing"
    CONST strPropTimeZoneId = "urn:schemas:calendar:timezoneid"
    CONST strPropOnline = "http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-c000-000000000046}/0x8240"
    CONST strPropConfType = "http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-c000-000000000046}/0x8241"    
    CONST strPropBusyStatus = "http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-c000-000000000046}/0x8205"
    CONST strPropResponseStatus = "http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-c000-000000000046}/0x8218"
    CONST strPropAllowExternal = "http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-c000-000000000046}/0x8246"
    CONST strPropPassword = "http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-c000-000000000046}/0x8249"
    CONST strPropLocation = "http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-c000-000000000046}/0x8208"
    CONST strPropNetShowURL = "http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-c000-000000000046}/0x8248"
    CONST strPropCGOID = "http://schemas.microsoft.com/mapi/id/{6ED8DA90-450B-101B-98DA-00AA003F1305}/35"
    CONST strPropSentRepName = "http://schemas.microsoft.com/mapi/proptag/0x0042001f"
    CONST strPropSentRepEmail = "http://schemas.microsoft.com/mapi/proptag/0x0065001f"
    CONST strPropTestPS = "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-c000-000000000046}/MySender"

    CONST L_Link_Text = "Hyperlink zur Teilnahme an der Konferenz"
    CONST L_SentTo_Text = "Die Besprechung wurde erfolgreich an die folgenden Adressen gesendet:"

    Dim cnt
    Dim cntRecipients
    Dim arrRecipients()
    Dim strURL
    Dim strAuthUser

    Send()

Sub Send()
    On Error Resume Next

    cntRecipients = 0

    ' get the authenticated user
    strAuthUser = Request.ServerVariables("AUTH_USER")
    Response.Write("<!-- AUTH_USER: " & strAuthUser & " -->" & vbNewLine)

    ' get the To info
    Dim txtRecipients(2)
    txtRecipients(0) = Request.Form("textTo")
    Response.Write("<!-- To: " & Request.Form("textTo") & " -->" & vbNewLine)
    txtRecipients(1) = Request.Form("textCC")
    Response.Write("<!-- CC: " & Request.Form("textCC") & " -->" & vbNewLine)

    ' get the Resource info
    Dim txtResource
    txtResource = Request.Form("listResource")
    Response.Write("<!-- Resource: " & txtResource & " -->" & vbNewLine)

    Dim objNewAppointment
    Set objNewAppointment = Server.CreateObject("CDO.Appointment")
    If (CheckSetError(L_CDO_Text, L_CreateAppointment_ErrorMessage)) Then
        Exit Sub
    End If
    
    ' Set all of the stuff we need from the schedule form
    objNewAppointment.Subject = Request.Form("textSubject")
    Response.Write("<!-- Subject: " & Request.Form("textSubject") & " -->" & vbNewLine)

    Dim dateStartTime, startTimeArray, nLBStartTime

    Dim strStartDateTime
    strStartDateTime = Request.Form("hiddenStartDateTime")
    Response.Write("<!-- hidStartDate: " & strStartDateTime & " -->" & vbNewLine)
    Dim strEndDateTime
    strEndDateTime = Request.Form("hiddenEndDateTime")
    Response.Write("<!-- hidEndDate: " & strEndDateTime & " -->" & vbNewLine)

    startTimeArray = Split(strStartDateTime, ":")
    nLBStartTime = LBound(startTimeArray)
    dateStartTime = DateSerial(startTimeArray(nLBStartTime), startTimeArray(nLBStartTime+1), startTimeArray(nLBStartTime+2))
    dateStartTime = DateAdd("h", startTimeArray(nLBStartTime+3), dateStartTime)
    dateStartTime = DateAdd("n", startTimeArray(nLBStartTime+4), dateStartTime)

    Response.Write("<!-- StartTime (UTC): " & CStr(dateStartTime) & " -->" & vbNewLine)
    
    Dim dateEndTime, EndTimeArray, nLBEndTime

    EndTimeArray = Split(strEndDateTime, ":")
    nLBEndTime = LBound(EndTimeArray)
    dateEndTime = DateSerial(EndTimeArray(nLBEndTime), EndTimeArray(nLBEndTime+1), EndTimeArray(nLBEndTime+2))
    dateEndTime = DateAdd("h", EndTimeArray(nLBEndTime+3), dateEndTime)
    dateEndTime = DateAdd("n", EndTimeArray(nLBEndTime+4), dateEndTime)

    Response.Write("<!-- EndTime (UTC): " & CStr(dateEndTime) & " -->" & vbNewLine)
    
    Dim strEncodedBody
    Dim strDecodedBody
    Dim index
    strEncodedBody = Request.Form("textaBody")
    strDecodedBody = ""
    Do
        length = Len(strEncodedBody)
        index = InStr(strEncodedBody, "%0D%0A")
        If (index = 0) Then
            strDecodedBody = strDecodedBody & strEncodedBody
        Else
            strDecodedBody = strDecodedBody & Left(strEncodedBody, index-1) & vbNewLine
            strEncodedBody = Right(strEncodedBody, length-index-5)
        End If
    Loop While (0 <> index)
    
    objNewAppointment.TextBody = strDecodedBody
    Response.Write("<!-- Body: " & strDecodedBody & " -->" & vbNewLine)

    Dim strPubPriv
    Dim strPassword
    strPubPriv = Request.Form("radioPubPriv")
    Response.Write("<!-- PubPriv: " & strPubPriv & " -->" & vbNewLine)
    strPassword = Request.Form("textPassword")
    If (("Private" <> strPubPriv) And ("" <> strPassword)) Then
        Response.Write("<!-- Password: " & strPassword & " -->" & vbNewLine)
    End If

    Response.Write("<!-- hiddenRecurPattern: " & Request.Form("hiddenRecurPattern") & " -->" & vbNewLine)
    Response.Write("<!-- hiddenRecurRange: " & Request.Form("hiddenRecurRange") & " -->" & vbNewLine)
    Response.Write("<!-- hiddenOccurrence: " & Request.Form("hiddenOccurrence") & " -->" & vbNewLine)
    Response.Write("<!-- hiddenEndByDate: " & Request.Form("hiddenEndByDate") & " -->" & vbNewLine)

    Dim objConfiguration
    Set objConfiguration = Server.CreateObject("CDO.Configuration")
    If (CheckSetError(L_CDO_Text, L_CreateCDOConfig_ErrorMessage)) Then
        Exit Sub
    End If

    Dim strSender
    Dim strFullDomain
    ' Parse the AuthUser to get the mailbox and domain
    If (strAuthUser <> "") Then
        Dim strUserName
        Dim strDomainName
        Dim nBackslash
        
        ' separate the name into domain and user so we can use the domain for the LDAP string
        nBackslash = InStr(1, strAuthUser, "\", vbTextCompare)
        If (nBackslash = 0) Then
            Result = &H80070005
            If (CheckSetError(L_AuthUser_Text, L_ParsingAuthUser_ErrorMessage)) Then
                Exit Sub
            End If
        End If
        
        strDomainName = Left(strAuthUser, nBackslash -1)
        strUserName   = Right(strAuthUser, Len(strAuthUser) - nBackslash)
        Response.Write("<!-- Domain: " & strDomainName & " -->" & vbNewLine)
        Response.Write("<!-- User: " & strUserName & " -->" & vbNewLine)

        ' Resolve the sender's name
        Dim strLDAP
        strLDAP = "ldap://" + strDomainName
    
        ' Create an Addressee object
        Dim objSenderAddressee
        Set objSenderAddressee = Server.CreateObject("CDO.Addressee")
        If (CheckSetError(L_CDO_Text, L_CreatingAddressee_ErrorMessage & strUserName)) Then
            Exit Sub
        End If

        ' prepend the display name with an = so it will resolve
        objSenderAddressee.DisplayName = "=" & strUserName
        If (CheckSetError(L_CDO_Text, L_SettingDisplayName_ErrorMessage & strUserName)) Then
            Exit Sub
        End If

        ' try to resolve it
        objSenderAddressee.CheckName(strLDAP)
        If (CheckSetError(L_CDO_Text, L_CheckingName_ErrorMessage & strUserName)) Then
            Exit Sub
        End If

        ' if not then we have some problems
        If (objSenderAddressee.ResolvedStatus = 2) OR (objSenderAddressee.ResolvedStatus = 0) Then 
            'cdoAmbiguous OR cdoUnresolved
            Result = &H80070005
            If (CheckSetError(L_AuthUser_Text, L_ResolvingAuthUser_ErrorMessage)) Then
                Exit Sub
            End If
        End If

        ' save the full domain for use in the saving and reloading of the appointment
        strSender = objSenderAddressee.EmailAddress
        Response.Write("<!-- Sender Email: " & strSender & " -->" & vbNewLine)

        Dim nAtSign
        nAtSign = InStr(1, strSender, "@", vbTextCompare)
        If (nAtSign = 0) Then
            Result = &H80070005
            Call CheckSetError(L_AuthUser_Text, L_ParsingAuthEmail_ErrorMessage)
            Exit Sub
        End If

        strFullDomain = Right(strSender, Len(strSender) - nAtSign)    
    Else ' Anonymous
        Dim CMSConfig
        Dim CMSZone
        Dim objResourceList
        Dim objResource
        
        'Create the CMS Configuration object (dllhost will create this from xcmsadm)
        Set CMSConfig = Server.CreateObject("XCMSCOM.CMSConfiguration")
        If (CheckSetError(L_CMSAdmin_Text, L_CreateConfiguration_ErrorMessage)) Then
            Exit Sub
        End If

        CMSConfig.GetZone "", CMSZone
        Set CMSConfig = Nothing
        If (CheckSetError(L_CMSAdmin_Text, L_GetZone_ErrorMessage)) Then
            Exit Sub
        End If

        CMSZone.GetResourceMailboxes "", objResourceList
        Set CMSZone = Nothing
        If (CheckSetError(L_CMSAdmin_Text, L_GetResourceMailboxes_ErrorMessage)) Then
            Exit Sub
        End If

        For each objResource in objResourceList
            If (objResource.DisplayName = txtResource) Then
                Exit For
            End If
        Next
        Set objResourceList = Nothing
        
        If (objResource.DisplayName <> txtResource) Then
            Result = &H80070002
            Call CheckSetError(L_CMSAdmin_Text, L_CouldntFindResource_ErrorMessage)
            Exit Sub
        End If
        ' save the full domain for use in the saving and reloading of the appointment
        strSender = objResource.EmailName

        ' domain
        Response.Write(strSender)
        strFullDomain = "fully.qualified.domain"
        strSender = txtResource & "@" & strFullDomain
    End If
                
    ' Set Configuration
    Dim objFields
    Set objFields = objConfiguration.Fields
    If (CheckSetError(L_CDO_Text, L_GettingConfigFields_ErrorMessage)) Then
        Exit Sub
    End If

    ' Update the sender and the method to use to send the appointment
    If (strAuthUser <> "") Then
        objFields(strPropSendEmailAddress).Value = strSender
        If (CheckSetError(L_CDO_Text, L_SettingSendAddress_ErrorMessage)) Then
            Exit Sub
        End If
    End If
    objFields(strPropSendUsing).Value = 3 'cdoSendUsingExchange
    If (CheckSetError(L_CDO_Text, L_SettingSendUsing_ErrorMessage)) Then
        Exit Sub
    End If

    objFields(strPropTimeZoneId).Value = 0 'UTC/GMT time
    If (CheckSetError(L_CDO_Text, L_SettingTimeZoneId_ErrorMessage)) Then
        Exit Sub
    End If

    objFields.Update
    If (CheckSetError(L_CDO_Text, L_UpdatingConfigFields_ErrorMessage)) Then
        Exit Sub
    End If
    objNewAppointment.Configuration = objConfiguration
    If (CheckSetError(L_CDO_Text, L_SettingConfig_ErrorMessage)) Then
        Exit Sub
    End If

    objNewAppointment.StartTime = dateStartTime
    objNewAppointment.EndTime = dateEndTime

    '
    ' Set Attendees
    '
    
    ' First start with the organizer
    Set objRecip = objNewAppointment.Attendees.Add
    If (CheckSetError(L_CDO_Text, L_AddingNewAttendee1_ErrorMessage & strSender & L_AddingNewAttendee2_ErrorMessage)) Then
        Exit Sub
    End If
                
    objRecip.Address = strSender
    If (CheckSetError(L_CDO_Text, L_SettingAddress_ErrorMessage & strSender)) Then
        Exit Sub
    End If
    
    objRecip.Role = 0 'cdoRequiredParticipant
    If (CheckSetError(L_CDO_Text, L_RecipientRole1_ErrorMessage & strSender & L_RecipientRole2_ErrorMessage & L_Required_Text)) Then
        Exit Sub
    End If

    ' Then do all of the people on the To: line
    If (strAuthUser <> "") Then
        Dim iAddressee
        Dim iAddressees
        Dim objRecip
        Dim txtRecipTemp
        Dim start, finish, length
    
        For cnt = 0 to 1
            start = 1
            length = Len(txtRecipients(cnt))
            Do
                If (0 = length) Then
                    Exit Do
                End If
                finish = InStr(start, txtRecipients(cnt), ";", vbTextCompare) - 1
                If (finish < 1) Then
                    finish = Len(txtRecipients(cnt))
                End If
                txtRecipTemp = mid(txtRecipients(cnt), start, finish-start+1)

                ' Create an Addressee object
                Set iAddressee = Server.CreateObject("CDO.Addressee")
                If (CheckSetError(L_CDO_Text, L_CreatingAddressee_ErrorMessage & txtRecipTemp)) Then
                    Exit Sub
                End If

                ' if the name has an @ sign it is assumed to be an SMTP address 
                '     and therefor doesn't need to be resolved
                If (InStr(1, txtRecipTemp, "@") = 0) Then
                    iAddressee.DisplayName = txtRecipTemp
                    If (CheckSetError(L_CDO_Text, L_SettingDisplayName_ErrorMessage & txtRecipTemp)) Then
                        Exit Sub
                    End If
                    
                    iAddressee.CheckName(strLDAP)
                    If (CheckSetError(L_CDO_Text, L_CheckingName_ErrorMessage & txtRecipTemp)) Then
                        Exit Sub
                    End If
                Else
                    iAddressee.EmailAddress = txtRecipTemp
                    If (CheckSetError(L_CDO_Text, L_SettingEmailAddress_ErrorMessage & txtRecipTemp)) Then
                        Exit Sub
                    End If
                    iAddressee.ResolvedStatus = 1 'cdoResolved
                End If

                If (iAddressee.ResolvedStatus = 2) Then 'cdoAmbiguous
                    Response.Write("<!-- " & "Ambiguous name: " & txtRecipTemp & " -->" & vbNewLine)
                    Set iAddressees = iAddressee.AmbiguousNames
                    For Each iAddressee in iAddressees
                        Response.Write("<!-- " & iAddressee.DisplayName & "(" & iAddressee.EmailAddress & ") -->" & vbNewLine)
                    Next
                    Response.Write(vbCRLF)
                    Result=2
                    If (CheckSetError(L_Resolution_Text, L_AmbiguousNames_ErrorMessage & txtRecipTemp)) Then
                        Exit Sub
                    End If
                ElseIf (iAddressee.ResolvedStatus = 0) Then 'cdoUnresolved
                    Response.Write("<!-- " & "Unresolved name: " & txtRecipTemp & " -->" & vbNewLine & vbNewLine)
                    Result=2
                    If (CheckSetError(L_Resolution_Text, L_UnresolvableName_ErrorMessage & txtRecipTemp)) Then
                        Exit Sub
                    End If
                Else ' cdoResolved
                    Set objRecip = objNewAppointment.Attendees.Add
                    If (CheckSetError(L_CDO_Text, L_AddingNewAttendee1_ErrorMessage & txtRecipTemp & L_AddingNewAttendee2_ErrorMessage)) Then
                        Exit Sub
                    End If
                    
                    objRecip.Address = iAddressee.EmailAddress
                    If (CheckSetError(L_CDO_Text, L_SettingAddress_ErrorMessage & txtRecipTemp)) Then
                        Exit Sub
                    End If

                    objRecip.Role = cnt 'cdoRequiredParticipant
                    If (0 = cnt) Then
                        If (CheckSetError(L_CDO_Text, L_RecipientRole1_ErrorMessage & txtRecipTemp & L_RecipientRole2_ErrorMessage & L_Required_Text)) Then
                            Exit Sub
                        End If
                    Else
                        If (CheckSetError(L_CDO_Text, L_RecipientRole1_ErrorMessage & txtRecipTemp & L_RecipientRole2_ErrorMessage & L_Optional_Text)) Then
                            Exit Sub
                        End If
                    End If
                    
                    cntRecipients = cntRecipients + 1
                    Redim preserve arrRecipients(cntRecipients)
                    arrRecipients(cntRecipients-1) = iAddressee.EmailAddress
                End If
                    
                start = finish + 2
            Loop While (start < length)
        Next
    End If

    '
    ' Set Resource
    '
    
    ' Create an Addressee object
    Dim objResourceAddressee
    Set objResourceAddressee = Server.CreateObject("CDO.Addressee")
    If (CheckSetError(L_CDO_Text, L_CreatingAddressee_ErrorMessage & txtResource)) Then
        Exit Sub
    End If

    ' If we are an authenticated user, then resolve the resource
    If (strAuthUser <> "") Then
        ' prepend the display name with an = so it will resolve
        objResourceAddressee.DisplayName = "=" & txtResource
        If (CheckSetError(L_CDO_Text, L_SettingDisplayName_ErrorMessage & txtResource)) Then
            Exit Sub
        End If

        ' try to resolve it
        objResourceAddressee.CheckName(strLDAP)
        If (CheckSetError(L_CDO_Text, L_CheckingName_ErrorMessage & txtResource)) Then
            Exit Sub
        End If

        ' if not then we have some problems
        If (objResourceAddressee.ResolvedStatus = 2) OR (objResourceAddressee.ResolvedStatus = 0) Then 
            'cdoAmbiguous OR cdoUnresolved
            Result = &H80070005
            If (CheckSetError(L_Resolution_Text, L_ResolvingResource_ErrorMessage)) Then
                Exit Sub
            End If
        End If
    End If
        
    ' Set the "Show Time As"
    objNewAppointment.BusyStatus = "Free"
    If (CheckSetError(L_CDO_Text, L_SettingBusyStatus_ErrorMessage)) Then
        Exit Sub
    End If

    ' Set the recurrence pattern
    ' Set Reccurrence Pattern
    Dim strRecurPattern
    strRecurPattern = Request.Form("hiddenRecurPattern")
    If (strRecurPattern <> "") Then
        Dim objRecPattern    
        Set objRecPattern = objNewAppointment.RecurrencePatterns.Add("ADD")
        If (CheckSetError(L_CDO_Text, L_AddingRecurrencePattern_ErrorMessage)) Then
            Exit Sub
        End If
             
        With objRecPattern
            .Frequency = CInt(strRecurPattern)
            If (CheckSetError(L_CDO_Text, L_SetRecurFrequency_ErrorMessage)) Then
                Exit Sub
            End If
            
            '  No End Date
            If (Request.Form("Range") = "NoEndDate") Then
                ' .NoEndDate = true
                ' I am not setting .. it is Readonly ... I will use default.
            ElseIf (Request.Form("Range") = "EndAfterOccurences") Then ' Occurrences
                .Instances = Request.Form("hiddenOccurrence")
                If (CheckSetError(L_CDO_Text, L_SetRecurInstances_ErrorMessage)) Then
                    Exit Sub
                End If
            ElseIf (Request.Form("Range") = "EndByDate") Then          ' EndByDate
                .PatternEndDate = Request.Form("hiddenEndByDate")
                If (CheckSetError(L_CDO_Text, L_SetRecurPatternEnd_ErrorMessage)) Then
                    Exit Sub
                End If
            End If              
        End With
    End If


'    Set objFields = objNewAppointment.Fields
'    If (CheckSetError(L_CDO_Text, L_GettingApptFields_ErrorMessage)) Then
'        Exit Sub
'    End If

    '
    ' Set the exchange conferencing required fields (except Location)
    '
    objNewAppointment.Fields(strPropOnline).Value = true
    objNewAppointment.Fields(strPropConfType).Value = CLng(2)
    objNewAppointment.Fields(strPropBusyStatus).Value = CLng(0)
    objNewAppointment.Fields(strPropResponseStatus).Value = CLng(2)

    If ("Private" <> strPubPriv) Then
        objNewAppointment.Fields(strPropAllowExternal).Value = true
        If ("" <> strPassword) Then
            objNewAppointment.Fields(strPropPassword).Value = strPassword
        End If
    Else
        objNewAppointment.Fields(strPropAllowExternal).Value = false    
    End If
    If (CheckSetError(L_CDO_Text, L_SettingApptFields_ErrorMessage)) Then
        Exit Sub
    End If

    objNewAppointment.Fields.Update
    If (CheckSetError(L_CDO_Text, L_UpdatingApptFields_ErrorMessage)) Then
        Exit Sub
    End If
    
    objNewAppointment.Fields.Resync
    If (CheckSetError(L_CDO_Text, L_SyncingApptFields_ErrorMessage)) Then
        Exit Sub
    End If

    ' Now we have done everything that we need to do, except the location field
    ' Save the appointment to the Users calendar
    ' Reopen the appointment and grab the CleanGlobalObjectId (CGOID)
    ' Pass the CGOID to the admin who returns a URL
    ' save the URL to both the location and the NetShowURL props
    ' then save to the organizer's calendar and send the meeting to everyone 

    ' Sending a message to the resource instead of direct booking
    Dim objCalRequest
    If ("" = strAuthUser) Then
        Set objRecip = objNewAppointment.Attendees.Add
        If (CheckSetError(L_CDO_Text, L_AddingNewAttendee1_ErrorMessage & txtResource & L_AddingNewAttendee2_ErrorMessage)) Then
            Exit Sub
        End If
                    
        objRecip.Address = txtResource & strFullDomain
        If (CheckSetError(L_CDO_Text, L_SettingAddress_ErrorMessage & txtResource)) Then
            Exit Sub
        End If
    
        objRecip.Role = 0 'cdoRequiredParticipant
        If (CheckSetError(L_CDO_Text, L_RecipientRole1_ErrorMessage & txtResource & L_RecipientRole2_ErrorMessage & L_Required_Text)) Then
            Exit Sub
        End If
     
        Set objCalRequest = objNewAppointment.CreateRequest
        If (CheckSetError(L_CDO_Text, L_ApptCreateRequest_ErrorMessage)) Then
            Exit Sub
        End If      

        objCalRequest.Message.Send
        If (CheckSetError(L_CDO_Text, L_ApptSend_ErrorMessage)) Then
            Exit Sub
        End If
    Else

'        ' When sending to the resource as a resource set the following props
'        objRecip.Role = 2 'cdoNonParticipant
'        objRecip.Type = "Resource"

'        cntRecipients = cntRecipients + 1
'        Redim preserve arrRecipients(cntRecipients)
'        arrRecipients(cntRecipients-1) = objResourceAddressee.EmailAddress
        Dim strCalendarURL
'        strCalendarURL = "file://./backofficestorage/" & strFullDomain & "/MBX/" & strUserName & "/calendar"
        strCalendarURL = "file://./backofficestorage/" & strFullDomain & "/MBX/" & txtResource & "/calendar"
        objNewAppointment.DataSource.SaveToContainer strCalendarURL
        If (CheckSetError(L_ADO_Text, L_ApptSaveTo1_ErrorMessage & L_Resource_Text & L_ApptSaveTo2_ErrorMessage)) Then
            Exit Sub
        End If
    End If


    '
    ' Now create the URL, send the message, and save to the organizers calendar
    '
    If (strAuthUser <> "") Then
        ' Get the name of the URL we just saved
        Dim strSourceURL
        strSourceURL = objNewAppointment.DataSource.SourceURL
        If (CheckSetError(L_ADO_Text, L_GettingApptSource_ErrorMessage)) Then
            Exit Sub
        End If

        ' Create a new appointment
        Dim objTestAppt
        Set objTestAppt = Server.CreateObject("CDO.Appointment")
        If (CheckSetError(L_CDO_Text, L_CreateAppointment_ErrorMessage)) Then
            Exit Sub
        End If
    
        ' Bind to the URL we just saved
        objTestAppt.DataSource.Open strSourceURL
        If (CheckSetError(L_ADO_Text, L_ApptOpen_ErrorMessage & strSourceURL)) Then
            Exit Sub
        End If

        ' Get the CleanGlobalObjectID off of the new appointment
        Dim CGOID
        Set CGOID = objTestAppt.Fields(strPropCGOID)
        If (CheckSetError(L_ADO_Text, L_GettingCGOID_ErrorMessage)) Then
            Exit Sub
        End If

        ' Free the new Appointment (no longer needed)
        Set objTestAppt = Nothing
    
        'Create the CMS Configuration object (dllhost will create this from xcmsadm)
        Set CMSConfig = Server.CreateObject("XCMSCOM.CMSConfiguration")
        If (CheckSetError(L_CMSAdmin_Text, L_CreateConfiguration_ErrorMessage)) Then
            Exit Sub
        End If

        ' Get the Zone and free the Config object
        CMSConfig.GetZone "", CMSZone
        Set CMSConfig = Nothing
        If (CheckSetError(L_CMSAdmin_Text, L_GetZone_ErrorMessage)) Then
            Exit Sub
        End If

        ' Call the admin to get the URL
        Dim bstrURL
        bstrURL = CMSZone.URLFromCGOID(CGOID.Value)
        If (CheckSetError(L_CMSAdmin_Text, L_URLFromCGOID_ErrorMessage)) Then
            Exit Sub
        End If
    
        strURL = bstrURL
        If (("Private" <> strPubPriv) And ("" <> strPassword)) Then
            strURL = strURL & "&p=" & strPassword
        End If
    
        objNewAppointment.Fields.Resync
        If (CheckSetError(L_CDO_Text, L_SyncingApptFields_ErrorMessage)) Then
            Exit Sub
        End If

        ' Set the two properties the CMS looks for
        objNewAppointment.Fields(strPropBusyStatus).Value = CLng(0)
        objNewAppointment.Fields(strPropResponseStatus).Value = CLng(3)

        ' Save the URL in the Location field and the NetShowURL field
        ' Not saving in the Location field
        'objNewAppointment.Fields(strPropLocation).Value = strURL
        objNewAppointment.Fields(strPropNetShowURL).Value = strURL
                
        If (CheckSetError(L_CDO_Text, L_SettingApptFields_ErrorMessage)) Then
            Exit Sub
        End If
        
        
        objNewAppointment.Fields.Update
        If (CheckSetError(L_CDO_Text, L_UpdatingApptFields_ErrorMessage)) Then
            Exit Sub
        End If

        objNewAppointment.DataSource.Save
        If (CheckSetError(L_ADO_Text, L_ApptSaveTo1_ErrorMessage & L_Resource_Text & L_ApptSaveTo2_ErrorMessage)) Then
            Exit Sub
        End If

        ' Now that we have updated another field do another resync
        objNewAppointment.Fields.Resync
        If (CheckSetError(L_CDO_Text, L_SyncingApptFields_ErrorMessage)) Then
            Exit Sub
        End If

    ' TEST code
'    Response.Write("<br>After resync #3<br>" & vbNewLine)
'    Response.Write("Online  :" & objNewAppointment.Fields(strPropOnline).Value & "<br>" & vbNewLine)
'    Response.Write("Type    :" & objNewAppointment.Fields(strPropConfType).Value & "<br>" & vbNewLine)
'    Response.Write("Allow   :" & objNewAppointment.Fields(strPropAllowExternal).Value & "<br>" & vbNewLine)
'    If (("Private" <> strPubPriv) And ("" <> strPassword)) Then
'        Response.Write("Password:" & objNewAppointment.Fields(strPropPassword).Value & "<br>" & vbNewLine)
'    End If
'    Response.Write("URL     :" & objNewAppointment.Fields(strPropNetShowURL).Value & "<br>" & vbNewLine)
    
        objNewAppointment.BusyStatus = "Busy"
        If (CheckSetError(L_CDO_Text, L_SettingBusyStatus_ErrorMessage)) Then
            Exit Sub
        End If

        ' Create the calendar message and send it
        Set objCalRequest = objNewAppointment.CreateRequest
        If (CheckSetError(L_CDO_Text, L_ApptCreateRequest_ErrorMessage)) Then
            Exit Sub
        End If

    Response.Write("<br>Writing properties twice<br>" & vbNewLine)
    objCalRequest.Message.Fields(strPropOnline).Value = true
    objCalRequest.Message.Fields(strPropConfType).Value = 2
    If ("Private" <> strPubPriv) Then
        objCalRequest.Message.Fields(strPropAllowExternal).Value = true
        If ("" <> strPassword) Then
            objNewAppointment.Fields(strPropPassword).Value = strPassword
        End If
    Else
        objCalRequest.Message.Fields(strPropAllowExternal).Value = false
    End If
    objCalRequest.Message.Fields(strPropNetShowURL).Value = strURL

    If (CheckSetError(L_CDO_Text, L_SettingApptFields_ErrorMessage)) Then
        Exit Sub
    End If
    
    objCalRequest.Message.Fields.Update
    If (CheckSetError(L_CDO_Text, L_UpdatingApptFields_ErrorMessage)) Then
        Exit Sub
    End If
    
    objCalRequest.Message.Fields.Resync
    If (CheckSetError(L_CDO_Text, L_SyncingApptFields_ErrorMessage)) Then
        Exit Sub
    End If

    ' TEST code
    'Right before we send we want to make sure all of the properties are set correctly
'    Response.Write("<br>Before send properties<br>" & vbNewLine)
'    Response.Write("Online  :" & objCalRequest.Message.Fields(strPropOnline).Value & "<br>" & vbNewLine)
'    Response.Write("Type    :" & objCalRequest.Message.Fields(strPropConfType).Value & "<br>" & vbNewLine)
'    Response.Write("Allow   :" & objCalRequest.Message.Fields(strPropAllowExternal).Value & "<br>" & vbNewLine)
'    If (("Private" <> strPubPriv) And ("" <> strPassword)) Then
'        Response.Write("Password:" & objCalRequest.Message.Fields(strPropPassword).Value & "<br>" & vbNewLine)
'    End If
'    Response.Write("URL     :" & objCalRequest.Message.Fields(strPropNetShowURL).Value & "<br>" & vbNewLine)
    
        objCalRequest.Message.Send
        If (CheckSetError(L_CDO_Text, L_ApptSend_ErrorMessage)) Then
            Exit Sub
        End If

    Response.Write("<br>Writing properties three times<br><br>" & vbNewLine)
    objNewAppointment.Fields(strPropOnline).Value = true
    objNewAppointment.Fields(strPropConfType).Value = 2
    If ("Private" <> strPubPriv) Then
        objNewAppointment.Fields(strPropAllowExternal).Value = true
        If ("" <> strPassword) Then
            objNewAppointment.Fields(strPropPassword).Value = strPassword
        End If
    Else
        objNewAppointment.Fields(strPropAllowExternal).Value = false
    End If
    objNewAppointment.Fields(strPropNetShowURL).Value = strURL

    If (CheckSetError(L_CDO_Text, L_SettingApptFields_ErrorMessage)) Then
        Exit Sub
    End If

    objNewAppointment.Fields.Update
    If (CheckSetError(L_CDO_Text, L_UpdatingApptFields_ErrorMessage)) Then
        Exit Sub
    End If    
    objNewAppointment.Fields.Resync
    If (CheckSetError(L_CDO_Text, L_SyncingApptFields_ErrorMessage)) Then
        Exit Sub
    End If
    
        ' Resave to the senders mailbox
        strCalendarURL = "file://./backofficestorage/" & strFullDomain & "/MBX/" & strUserName & "/calendar"
        objNewAppointment.DataSource.SaveToContainer strCalendarURL
        If (CheckSetError(L_ADO_Text, L_ApptSaveTo1_ErrorMessage & L_Organizer_Text & L_ApptSaveTo2_ErrorMessage)) Then
            Exit Sub
        End If

    ' TEST code
'    strSourceURL = objNewAppointment.DataSource.SourceURL
'    Set objTestAppt = Server.CreateObject("CDO.Appointment")
'    objTestAppt.DataSource.Open strSourceURL
'    'Right after saving we want to make sure all of the properties are set correctly
'    Response.Write("<br>After save properties<br>" & vbNewLine)
'    Response.Write("Online  :" & objTestAppt.Fields(strPropOnline).Value & "<br>" & vbNewLine)
'    Response.Write("Type    :" & objTestAppt.Fields(strPropConfType).Value & "<br>" & vbNewLine)
'    Response.Write("Allow   :" & objTestAppt.Fields(strPropAllowExternal).Value & "<br>" & vbNewLine)
'    If (("Private" <> strPubPriv) And ("" <> strPassword)) Then
'        Response.Write("Password:" & objTestAppt.Fields(strPropPassword).Value & "<br>" & vbNewLine)
'    End If
'    Response.Write("URL     :" & objTestAppt.Fields(strPropNetShowURL).Value & "<br>" & vbNewLine)
    End If
End Sub
%>
<% If (0 = ErrCode) Then %>
</head>
<body bgcolor="#FFCC99" LINK="#660000" ALINK="#660000" VLINK="#660000>
<FONT FACE="VERDANA, ARIAL, HELVETICA, SANSERIF" SIZE="-1">
<% If ((strAuthUser <> "") And (cntRecipients > 0)) Then %>
<%=L_SentTo_Text%><br>
    <% For cnt = 0 To cntRecipients %>
    <%=arrRecipients(cnt)%><br>
    <% Next %>
<% End If %>
<a href="<%=strURL%>"><%=L_Link_Text%></a>
</font>
</body>
</html>
<% End If %>