File: D:/web archive/conferencesearch (old) (to delete)/book/apputils.asp
<%
' Changes
' -------
' (SS,31/5/06) corrected problem where delegates records with awaiting status were
' being counted as bookings, but should be ignored, i.e. treated as cancelled.
' made changes to two queries by adding Status <> "Awaiting".
' (SS,31/8/06) Changes to SelectConference to default to Venue if only one exists
' Added Finalise sub which closes database and added OpenDatabase to Initialise
' Moved all occurrences of OpenDatabase and CloseDatabase. This is now only
' done in Initialise and Finalise
' (SS,9/06) Many changes for new system that creates a complete site
' (SS,28/9/06) Added "If LAreRecords Then" to CalculateDelegateCost to fix bug when valuelist is empty
' (SS,9/11/06) Minor change in CheckValidPersonalDetails and
' to not force filling in of cancellation terms and set delegate fee to zero if delegate not attending
' Added new function GetDelegateIsAttending, also change to CalculateDelegateFee to set fee to zero if not attending
' (SS,15/12/06) Added ConvertURLToHTML to GetRegistrationFormLink to be W3C compliant
' (SS,5/2/07) added BF_TITLE
' (SS,22/3/07) change to SendBookingEmail and ReplaceTokens to allow extra fields to be individually added to email text
' (SS,21/5/07) added a CleanSQLStr to CheckCounters to fix error where it was failing with SQL error when ExtraField contain an apostrophe
' (SS,4/7/07) added SendEmailCopy, CheckDelegateIDAndPassword and GetConferenceDetails
' to send email from Admin program, also added booking-email.asp which calls the SendEmailCopy routine
' Added AAlwaysSend parameter to SendBookingEmail
' (SS,4/12/07) change to GetConfirmationMessage to show make another booking link on confirmation message
' (SS,24/1/08) change to Sub DoBookingForm to clear BookingAlreadyMade flag when not confirmation
' Hopefully will prevent the Booking Already Made problem they've been getting sometimes.
' (SS,8/12/08) removed date from SendBookingEmail, as requested by Ruth
' (SS,8/5/09) change to SendEmailWithAttachedInvoice to prevent duplicate error
' (SS,1/7/09) added FBccEmailAddress to send an extra copy of email
' (SS,16/7/09) Now using same version of dbfunctions.asp as shopping site
' Replaced IntAsBool to IntToBool
' (SS,27/7/09) Added Function HasCounterReachedMaximum, changes to CheckCounters and ShowBookingFormExtraFields
' (SS,29/7/09) Minor change to SendBookingEmail
' (SS,21/12/10) Added Sub CheckVAT to change the VAT on 4/1/2011, called from Sub Initialise
' (SS,26/06/13) "Date Booked" line removed from Sub SendBookingEmail at Alan's request
' (SS,01/04/14) Correction to Sub SendEmailWithAttachedInvoice, Bcc emails not being sent due to missing SendEmail
' (SS,07/10/14) Changes to add new optional PurchaseOrderNo field
' global constants and variables '
Dim CRLF ' carriage return and line feed '
CRLF = CHR(13) & CHR(10)
' main variables '
Dim strTitle, strFirstName, strSurname, strNameOnBadge, strJobTitle
Dim strOrganisation, strAddress, strAddressLine1, strAddressLine2, strTown, strCounty, strPostcode, strCountry
' (SS,7/10/14) added strPurchaseOrderNo
Dim strTelephone, strFax, strEmail, strRetypeEmail, strPurchaseOrderNo, strDietaryNeeds, strSpecialNeeds, strAttendanceConfirmation, strCancellationConditions
Dim FDelegateID
Dim FConferenceID, FConferenceName, FConferenceDescription, FConfirmationMessage
Dim FVenueID, FVenueName, FVenueDate, FVenueDescription, FVenueWebsite, FDelegateCostIncVAT, FDelegateCostExcVAT
Dim ITP_ErrorMessage
' (SS,1/7/09) added FBccEmailAddress
Dim FPassword, FCSLEmailAddress, FEmailCopyToCSL, FBookingFieldsAllowed, FBccEmailAddress
Dim FDirectDelegateLink
Dim FPastBookingEndDateForDirectLink
Dim FHasMakeAnotherBookingLink, FHasAccommodationLink ' (SS,5/9/06)
Dim FDelegateCost, FDelegateCostRate2, FApplyRate2Date ' (SS,13/9/06)
Dim FChargeVAT, FShowVAT ' (SS,14/9/06)
Dim FCheckValidPassword, FValidPassword, FExistingStatus, FDelegatePassword ' (SS,2/12/06)
Dim FDateTimeBooked ' (SS,15/2/07)
' (SS,21/2/05) Booking Fields to Allowed constants '
Const BF_TITLE = "Title" ' (SS,5/2/07)
Const BF_NAME_ON_BADGE = "Name on Badge"
Const BF_JOB_TITLE = "Job Title"
Const BF_ORGANISATION = "Organisation"
Const BF_ADDRESS = "Address"
Const BF_TELEPHONE = "Telephone"
Const BF_FAX = "Fax"
Const BF_EMAIL = "Email"
Const BF_PURCHASE_ORDER_NO = "Purchase Order No" ' (SS,7/10/14)
Const BF_DIETARY_NEEDS = "Dietary Needs"
Const BF_SPECIAL_NEEDS = "Special Needs"
Const BF_ATTENDANCE_CONFIRMATION = "Attendance Confirmation"
Const BF_CANCELLATION_CONDITIONS = "Cancellation Conditions"
' (SS,21/2/05) status values now held as constants '
Const STATUS_CANCELLED = "Cancelled"
Const STATUS_APPLIED = "Applied"
Const STATUS_AWAITING = "Awaiting" ' (SS,31/5/06)
Const STATUS_PAID = "Paid" ' (SS,1/9/06)
' (SS,14/10/05) input types for extra fields
Const IT_TEXT = "Text"
Const IT_MEMO = "Memo"
Const IT_CHECK_BOX = "Check Box"
Const IT_COMBO_BOX = "Combo Box"
Const IT_RADIO = "Radio"
Const EMAIL_LABEL_LENGTH = 14 ' (SS,14/10/05)
Const PM_PAYPAL = "PayPal" ' (SS,1/9/06)
Initialise
' (SS,13/8/04) runs code to be run before all templates '
Sub Initialise
OpenDatabase ' (SS,31/8/06) '
FConferenceID = ""
FVenueID = "" ' (SS,14/7/05) '
FDelegateID = "" ' (SS,14/7/05) '
FDirectDelegateLink = False ' (SS,14/7/05) will be true when direct link to delegate click (i.e for new Awaiting status) '
FPastBookingEndDateForDirectLink = False
FCheckValidPassword = InternalCheckValidPassword ' (SS,2/12/06) moved here from inc-pages.asp was called CheckValidPassword
CheckVAT ' (SS,21/12/10) added to make sure VAT rate is correct
' SetDebugLevel 3
'DebugOn
End Sub
' (SS,31/8/06) '
Sub Finalise
CloseDatabase
End Sub
' (SS,21/12/10) added VAT change from 17.5% to 20% on 4/1/2011
Sub CheckVAT
Dim LVATRate
LVATRate = CDbl(GetSetting("Application", "VATRate"))
' if date is >= 4/1/2011 and VAT Rate is 17.5% then change to 20% in settings table
If DateDiff("d", "4/1/2011", Date) >= 0 And LVATRate = 0.175 Then
LVATRate = 0.20
SetSetting "Application", "VATRate", LVATRate
End If
End Sub
' (SS,3/2/04) looks at list of form fields specified (comma separated) '
' returns list of the ones that have a blank value '
' i.e. have not been entered '
Function GetListOfMissingFields(ARequiredList)
Dim i, c, LLength, LFieldName, LMissingFields
LMissingFields = ""
LLength = Len(ARequiredList)
LFieldName = ""
For i = 1 To LLength
c = Mid(ARequiredList, i, 1)
' if comma or last char, i.e. we have a field '
If c <> "," Then LFieldName = LFieldName + c
If c = "," Or i = LLength Then
LFieldName = Trim(LFieldName)
If LFieldName <> "" Then
If Request.Form(LFieldName) = "" Then
LMissingFields = LMissingFields + Iif(LMissingFields = "", "", ", ") + LFieldName
End If
End If
LFieldName = ""
End If
Next
GetListOfMissingFields = LMissingFields
End Function
' (SS,2/12/06) returns the result of InternalCheckValidPassword run from Initialise
Function CheckValidPassword
CheckValidPassword = FCheckValidPassword
End Function
' (SS,11/1/05) '
' (SS,2/12/06) was called CheckValidPassword
' (SS,2/12/06) few other changes
Function InternalCheckValidPassword
InternalCheckValidPassword = False
' (SS,14/7/05) added following for delegate id and password supplied
FDelegateID = Request("did")
FDelegatePassword = Request("pw")
If FDelegateID <> "" Then
FVenueID = GetVenueIDForDelegateAndCheckPassword(FDelegateID, FDelegatePassword) ' (SS,2/12/06) now sets FValidPassword to true if password is valid
If FVenueID <> "" Then
FConferenceID = GetConferenceIDForVenueID(FVenueID)
If FConferenceID <> "" Then
InternalCheckValidPassword = FValidPassword
FDirectDelegateLink = True
' (SS,2/12/06) show error message if status is not awaiting or applied
If FExistingStatus <> STATUS_AWAITING And FExistingStatus <> STATUS_APPLIED Then
gsErrorMessage = "Sorry, you can no longer edit your details. " + Chr(13) + "Please contact Conference Search on 0161 427 7057."
InternalCheckValidPassword = False
End If
End If
End If
Else
' if id has been supplied and it exists then go straight to conference by indicated password is valid '
If Request("id") <> "" Then
FConferenceID = Request("id") ' (SS,2/12/06)
If CheckValidConferenceID(FConferenceID) Then
InternalCheckValidPassword = True
End If
End If
End if
End Function
Sub DoGetPassword
ShowPasswordHeader
ShowPasswordForm gsErrorMessage
ShowPasswordFooter
End Sub
' (SS,24/11/04) shows conference selector if required, returns true if it was shown '
Function SelectConference
Dim LErrorMessage, LSQL, LShowConferenceSelectorForm, LConferenceComboHTML
LErrorMessage = ""
LShowConferenceSelectorForm = True
' (SS,17/1/05) added If '
If FConferenceID = "" Then
FConferenceID = Request("id")
End If
If FConferenceID = "" Then
LShowConferenceSelectorForm = True
If Request.Form("postconferenceform") = "yes" Then
LErrorMessage = "Please select a Conference."
End If
Else
If Not CheckValidConferenceID(FConferenceID) Then
LErrorMessage = gsErrorMessage
Else
LShowConferenceSelectorForm = False
' (SS,31/8/06) if only one Venue exists then default to it
OpenQuery("SELECT VenueID FROM venues WHERE ConferenceID = '" + FConferenceID + "' AND BookingEndDate >= CURDATE() ORDER BY VenueID")
If Not EndOfQuery Then
FVenueID = GetQueryValue("VenueID")
NextQueryRecord
If Not EndOfQuery Then FVenueID = ""
End If
CloseQuery
End If
End If
If LShowConferenceSelectorForm Then
LSQL = "SELECT * FROM conferences WHERE Status='Open'"
If FPassword = "" Then
LSQL = LSQL + " AND Password = ''"
Else
LSQL = LSQL + " AND (Password = '' OR Password = '" + CleanSQLStr(FPassword) + "')"
End If
LConferenceComboHTML = GetLookupCombo(LSQL, "ConferenceName", "SortOrder", FConferenceID, "-- please select a conference --", "id", "", "", "ConferenceID")
ShowConferenceSelectorHeader
ShowConferenceSelectorForm LErrorMessage, LConferenceComboHTML
ShowConferenceSelectorFooter
End If
SelectConference = LShowConferenceSelectorForm
End Function
' (SS,26/9/04) shows venue selector if required, returns true if it was shown '
Function SelectVenue
Dim LErrorMessage, LShowVenueSelectorForm
LErrorMessage = ""
LShowVenueSelectorForm = True
' (SS,14/7/05) added If FVenueID = "" because FVenueID may already be supplied if
' i.e. when direct link to delegate record '
If FVenueID = "" Then FVenueID = Request.Form("venue")
If Not CheckValidVenueID(FVenueID) Then
If Not FDirectDelegateLink Then
If Request.Form("postvenueform") = "yes" Then
LErrorMessage = "Please select a Venue."
End If
Else ' (SS,14/7/05)
FPastBookingEndDateForDirectLink = True
LShowVenueSelectorForm = False
End If
ElseIf Not CheckVenuePlaces Then
LErrorMessage = Application("NoPlacesMessage")
Else
LShowVenueSelectorForm = False
End If
If LShowVenueSelectorForm Then
Dim LVenueComboHTML, LSQL, LValueValue, s, LDefaultValue, LBlankValue
LSQL = "SELECT *, DATE_FORMAT(StartDate, '%D %M %Y') AS StartDateNiceFormat, DATE_FORMAT(EndDate, '%D %M %Y') AS EndDateNiceFormat FROM venues WHERE ConferenceID='" & FConferenceID & "' AND BookingEndDate >= CURDATE() ORDER BY SortOrder, VenueName"
' build up the special combo which also contains the dates '
s = "<select name=""venue"" class=""form"">"
LDefaultValue = FVenueID
LBlankValue = "-- please select a venue --"
If LDefaultValue = "" Then
s = s + "<option value = """" selected>" & LBlankValue & "</option>"
Else
s = s + "<option value = """">" & LBlankValue & "</option>"
End If
OpenQuery(LSQL)
Do While Not EndOfQuery
LValueValue = GetQueryValue("VenueID")
s = s + "<option value=""" + LValueValue + """"
If LValueValue = LDefaultValue Then s = s + " selected"
s = s + ">" + GetQueryValue("VenueName") & " (" & GetQueryValue("StartDateNiceFormat")
If GetQueryValue("StartDateNiceFormat") <> GetQueryValue("EndDateNiceFormat") Then
s = s + " to " + GetQueryValue("EndDateNiceFormat")
End If
s = s + ")"
s = s + "</option>" + Chr(13) + Chr(10) ' Chr(13) + Chr(10) to made HTML more readable
NextQueryRecord
Loop
CloseQuery
LVenueComboHTML = s
' LVenueComboHTML = GetLookupCombo(LSQL, "VenueName", "SortOrder", FVenueID, "-- please select a venue --", "venue", "", "","VenueID")
ShowVenueSelectorHeader FConferenceName, ConvertNewlinesToHTML(Replace(FConferenceDescription, " ", " "))
ShowVenueSelectorForm LErrorMessage, FConferenceID, LVenueComboHTML
ShowVenueSelectorFooter
End If
SelectVenue = LShowVenueSelectorForm
End Function
' (SS,21/2/05) added If BookingFieldAllowed '
Function CheckValidPersonalDetails
Dim strError
strError = ""
If BookingFieldAllowed(BF_TITLE) AND strTitle = "" Then strError = strError + IIf(strError = "", "", ", ") + "Title" ' (SS,5/2/07) added BookingFieldAllowed(BF_TITLE) AND
If strFirstName = "" Then strError = strError + IIf(strError = "", "", ", ") + "First Name"
If strSurname = "" Then strError = strError + IIf(strError = "", "", ", ") + "Surname"
If BookingFieldAllowed(BF_NAME_ON_BADGE) And strNameOnBadge = "" Then strError = strError + IIf(strError = "", "", ", ") + "Name on Badge"
' If strOrganisation = "" Then strError = strError + IIf(strError = "", "", ", ") + "Organisation"
If BookingFieldAllowed(BF_ADDRESS) Then
If strAddressLine1 = "" Then strError = strError + IIf(strError = "", "", ", ") + "Address Line 1"
If strTown = "" Then strError = strError + IIf(strError = "", "", ", ") + "Town/City"
If strPostcode = "" Then strError = strError + IIf(strError = "", "", ", ") + "Postcode/Zip"
If strCountry = "" Then strError = strError + IIf(strError = "", "", ", ") + "Country"
If strTelephone = "" Then strError = strError + IIf(strError = "", "", ", ") + "Telephone"
End If
If BookingFieldAllowed(BF_EMAIL) Then
If strEmail = "" Then strError = strError + IIf(strError = "", "", ", ") + "Email Address"
End If
If BookingFieldAllowed(BF_ATTENDANCE_CONFIRMATION) Then
If strAttendanceConfirmation = "" Then strError = strError + IIf(strError = "", "", ", ") + "I wish to attend"
End If
' (SS,9/11/06) added And (Not BookingFieldAllowed(BF_ATTENDANCE_CONFIRMATION) Or strAttendanceConfirmation <> "No"
' to not show cancellation not entered error if they are not attending
If BookingFieldAllowed(BF_CANCELLATION_CONDITIONS) And GetDelegateIsAttending Then
If strCancellationConditions = "" Then strError = strError + IIf(strError = "", "", ", ") + "Cancellation conditions"
End If
' (SS,14/10/05) validate the extra fields
Dim LCheckValidExtraFields
LCheckValidExtraFields = CheckValidExtraFields
If LCheckValidExtraFields <> "" Then
strError = strError + IIf(strError = "", "", ", ") + LCheckValidExtraFields
End If
If strError <> "" Then strError = "Following fields must be filled in: " + strError + "."
' check that email and confirm email matches
If BookingFieldAllowed(BF_EMAIL) AND strError = "" Then
If Instr(strEmail, "@") = 0 Then
strError = "Email address must contain an '@'."
ElseIf Len(strEmail) - Len(Replace(strEmail, "@", "")) > 1 Then
strError = "Email address must contain only one '@'."
ElseIf Instr(strEmail, "..") <> 0 Then
strError = "Email address must not contain more than one '.' in a row."
ElseIf Instr(strEmail, " ") <> 0 Then
strError = "Email address must not contain spaces."
ElseIf strEmail <> strRetypeEmail Then
strError = "Email and Retyped Email must match."
End If
End If
gsErrorMessage = strError
CheckValidPersonalDetails = (strError = "")
End Function
' (SS,14/10/05) checks extra fields to make sure required ones have been filled in
' returns blank if all okay, else returns list if fields that won't filled in
Function CheckValidExtraFields
Dim LResult, LFieldName, LDelegateField, LInputType, LFormLabel, LFormValue
LResult = ""
OpenQueryExtraFields False
Do While Not EndOfQuery
LFieldName = GetQueryValue("FieldName")
LDelegateField = GetQueryValue("DelegateField")
LInputType = GetQueryValue("InputType")
LFormValue = Trim(Request.Form(LFieldName))
' translate checked to Yes or No for Check Box
If LInputType = IT_CHECK_BOX Then
If LCase(LFormValue) = "checked" then
LFormValue = "Yes"
Else
If LCase(LFormValue) <> "yes" Then ' (SS,14/9/06) added If due to this now also being a hidden field
LFormValue = "No"
End if
End If
End If
' store value in session for defaulting in form to value already entered
Session("EF_" + LDelegateField) = LFormValue
If IntToBool(GetQueryValue("Required")) Then
LFormLabel = GetQueryValue("FormLabel")
If LFormLabel = "" Then LFormLabel = LFieldName
If LFormValue = "" Then LResult = LResult + IIf(LResult = "", "", ", ") + LFormLabel
End If
NextQueryRecord
Loop
CloseQuery
CheckValidExtraFields = LResult
End Function
' (SS,14/10/05) check counters, returns true if enough available else gsErrorMessage is set to error
Function CheckCounters
' DebugOn
gsErrorMessage = "" ' clear error message
Dim LFieldName, LDelegateField, LInputType, LFormLabel, LFormValue, LCounterName, LDelegateCount, LVenueCount, LForError
OpenQueryExtraFields False
Do While Not EndOfQuery
LFieldName = GetQueryValue("FieldName")
LFormLabel = GetQueryValue("FormLabel")
If LFormLabel = "" Then LFormLabel = LFieldName
LDelegateField = GetQueryValue("DelegateField")
LInputType = GetQueryValue("InputType")
LFormValue = Trim(Request.Form(LFieldName))
If LDelegateField <> "" Then
' translate checked to Yes or No for Check Box
If LInputType = IT_CHECK_BOX Then
If LCase(LFormValue) = "checked" then
LFormValue = "Yes"
Else
LFormValue = "No"
End If
End If
' determine counter name
LCounterName = ""
LForError = ""
If (LFormValue <> "") And (LInputType = IT_COMBO_BOX Or LInputType = IT_CHECK_BOX Or LInputType = IT_RADIO) Then
LForError = " for " + LFormLabel ' used for more info when fully booked to say which field
OpenQuery2("SELECT * FROM valuelists WHERE TableName = 'conferences' AND RecordID = '" + CleanSQLStr(FConferenceID) + "' AND FieldName = '" + CleanSQLStr(LFieldName) + "' AND ValueListName = '" + CleanSQLStr(LFormValue) + "'")
If Not EndOfQuery2 Then
LCounterName = GetQueryValue2("CounterAssigned")
End If
CloseQuery2
End If
' now we should have which field in delegates table to check
' and what value to check for and counter for venue to compare with
If LCounterName <> "" Then
' (SS,27/7/09) replaced old code with HasCounterReachedMaximum
' delegate has reached venue count then
'If LDelegateCount >= LVenueCount Then
If HasCounterReachedMaximum(LCounterName, True) < 0 Then
gsErrorMessage = gsErrorMessage + IIf(gsErrorMessage = "", "", ", ") + LCounterName + " fully booked"
' (SS,12/3/07) moved LForError to separate line to only add if application, not applicable if Checkbox and yes
' i.e. it doesn't make sense saying "Second Night fully booked for Second Night"
If LInputType <> IT_CHECK_BOX Or LFormValue <> "Yes" Then gsErrorMessage = gsErrorMessage + LForError
End If
End If
End If ' If LDelegateField <> "" Then
NextQueryRecord
Loop ' Do While
CloseQuery
If gsErrorMessage <> "" Then gsErrorMessage = gsErrorMessage + ". Please change your selection."
CheckCounters = gsErrorMessage = ""
End Function
' (SS,15/7/09) returns zero if counter matches MaxCount, positive >0 is returned if enough left
' i.e. returns max counter - total count
' routine assumes that FConferenceID, FVenueID and FDelegateID have been set, ACounterName is the counter name being checked
' Added IncludeForm parameter to count form values passed back to server
Function HasCounterReachedMaximum(ACounterName, AIncludeForm)
' query to get list of FieldName, ValueListName, DelegateField and MaxCounter (MaxCounter is across all the records, value just looked up in same query)
Dim LSQL
LSQL = "SELECT v.FieldName, v.ValueListName, v.CounterAssigned, e.DelegateField, c.MaxCounter FROM valuelists v " &_
"INNER JOIN extrafields e ON e.TableName = v.TableName AND e.RecordID = v.RecordID AND e.FieldName = v.FieldName " &_
"INNER JOIN counters c ON c.TableName = 'venues' AND c.RecordID = '" & CleanSQLStr(FVenueID) & "' AND c.CounterName = v.CounterAssigned " &_
"WHERE v.TableName = 'conferences' AND v.RecordID = '" & CleanSQLStr(FConferenceID) & "' AND CounterAssigned = '" & CleanSQLStr(ACounterName) & "'"
OpenQuery3(LSQL)' NB. 3 used instead of 2 because calling routine may use 1 or 2
' for each of the records, count the delegate records totalling them up
Dim LTotalCount, LDelegateFieldName, LValueListName, LThisDelegateCount, LMaxCounter
LTotalCount = 0
LThisDelegateCount = 0
Do While Not EndOfQuery3
LDelegateFieldName = GetQueryValue3("DelegateField")
LValueListName = GetQueryValue3("ValueListName")
' count all delegate records
LSQL = "SELECT COUNT(*) AS TotalCount FROM delegates WHERE VenueID = '" & CleanSQLStr(FVenueID) & "' AND Status <> '" & STATUS_CANCELLED & "' AND Status <> '" & STATUS_AWAITING & "' AND " + LDelegateFieldName + " = '" + CleanSQLStr(LValueListName) + "'"
LTotalCount = LTotalCount + GetValueFromQuery("TotalCount", LSQL)
' Response.Write "#Max count A: " & GetValueFromQuery("TotalCount", LSQL) & " for " & ACounterName & " and " & LDelegateFieldName & "#<br>"
' (SS,27/7/09) also include selected value from form
If AIncludeForm Then
If Trim(Request.Form(GetQueryValue3("FieldName"))) = LValueListName Then
LTotalCount = LTotalCount + 1
End If
End If
' count this delegate only
If FDelegateID <> "" Then
LSQL = LSQL + " AND DelegateID = " + FDelegateID
LThisDelegateCount = LThisDelegateCount + GetValueFromQuery("TotalCount", LSQL)
End If
NextQueryRecord3
Loop ' Do While
CloseQuery3
' lookup max counter
LMaxCounter = GetValueFromQuery("MaxCounter", "SELECT MaxCounter FROM counters WHERE TableName = 'venues' AND RecordID = '" & CleanSQLStr(FVenueID) & "' AND CounterName = '" & CleanSQLStr(ACounterName) & "'")
' ignore the count of existing delegate record (i.e. can happen when changing existing record)
LTotalCount = LTotalCount - LThisDelegateCount
' Response.Write "#LTotalCount: " & LTotalCount & " " & ACounterName & "#"
' return max counter - total count
HasCounterReachedMaximum = LMaxCounter - LTotalCount
' Response.Write "#HasCounterReachedMaximum: " & LMaxCounter - LTotalCount & " " & ACounterName & "#"
End Function
Sub DoMessagePage
ShowPasswordHeader
ShowMessage(gsErrorMessage)
ShowPasswordFooter
End Sub
' (SS,26/9/04) '
Sub DoBookingForm
Dim LShowBookingForm, LShowThankYou, LShowBookingConfirmation, LIsConfirmation, LIsSubmit
gsErrorMessage = ""
LShowBookingForm = True
LShowThankYou = False ' (SS,24/01/05)
LShowBookingConfirmation = False ' (SS,14/9/06)
' (SS,14/9/06)
LIsConfirmation = Request("Submit") = "Confirm"
LIsSubmit = Request("Submit") = "Submit"
' (SS,1/9/06)
If Request("new") = "true" Then
Session("BookingAlreadyMade") = False
PlacesValuesInSession
End If
' (SS,24/1/08) if not confirmation page then clear the BookingAlreadyMade flag
If Not LIsConfirmation Then
Session("BookingAlreadyMade") = False
End If
' if previously tried to post form then check telephone and email address entered'
If Request.Form("postbookingform") = "yes" Then
' (SS,13/9/06) added test mode, so that booking already made not done if testing
' (SS,14/9/06) added LIsConfirmation
If (Session("BookingAlreadyMade") = True) And (Application("TestMode") <> True) And LIsConfirmation Then
ShowBookingMakeAnother(True)
LShowBookingForm = False
FHasMakeAnotherBookingLink = True
Else
PlacesValuesInSession
If CheckValidPersonalDetails Then
If CalculateDelegateCost Then ' (SS,13/9/06)
' (SS,14/10/05) added If CheckCounters
If CheckCounters Then
LShowBookingForm = False
' (SS,14/9/06)
If LIsSubmit Then
LShowBookingConfirmation = True
End If
' (SS,14/9/06)
If LIsConfirmation Then
LShowThankYou = True ' (SS,24/1/05) also moved ShowBookingThankYou FConfirmationMessage below
' (SS,13/9/06) if not test mode then save booking and send email
If Application("TestMode") <> True Then
AddBookingToDatabase
SendBookingEmail(False) ' (SS,1/9/06) moved code into separate procedure
Session("BookingAlreadyMade") = True
End If
End If
' ShowBookingMakeAnother(False) ' specifically removed, Alan says it might cause confusion
End If ' If CheckCounters
End if ' If CalculateDelegateCost
End If ' If CheckValidPersonalDetails Then
End If
End If
If LShowThankYou Then
' (SS,14/7/05) added separate message if they cancelled '
' (SS,31/08/06) only show the old header if old version
If Not IsNewVersion Then
ShowBookingHeader FConferenceName, FVenueID, FVenueName, FVenueDate, ""
End If
If Session("t_Status") = STATUS_CANCELLED Then
ShowBookingThankYou "Thank you for advising us that you're unable to attend."
Else
' (SS,24/01/05) show booking header without description
ShowBookingThankYou GetConfirmationMessage
End if
' (SS,4/9/06) save the delegate id for next stage
Session("DelegateID") = FDelegateID
Else
' (SS,24/01/05) following moved here from above
ShowBookingHeader FConferenceName, FVenueID, FVenueName, FVenueDate, FVenueDescription
End If
' (SS,4/9/06) this bit is now also reached when payment method has been selected
' i.e. pm=cbt or pm=pp (pp when returning from PayPal), ppc if paypal cancelled
If LShowBookingForm Then
Dim LPaymentMethod
LPaymentMethod = Request("pm")
If LPaymentMethod = "" Then
' (SS,14/7/05) add following to get values from existing record if not posting form'
If FDirectDelegateLink And Request.Form("postbookingform") <> "yes" Then
GetOrderDetails FDelegateID
End If
' (SS,2/12/06) added FDelegateID and FDelegatePassword
ShowBookingForm gsErrorMessage, FConferenceID, FVenueID, FDelegateID, FDelegatePassword
Else
FDelegateID = Session("DelegateID") ' retreive the DelegateID from Session
GetOrderDetails FDelegateID
If LPaymentMethod = "cbt" Then
SendEmailWithAttachedInvoice
ShowBookingThankYou GetBankTransferChequeConfirmation
ElseIf LPaymentMethod = "ppc" Then
ShowBookingThankYou GetPayPalCancelMessage
ElseIf LPaymentMethod = "pp" Then
' SendEmailPayPalReceipt
ShowBookingThankYou GetPayPalConfirmation
End If
End If
End If
' (SS,14/9/06)
If LShowBookingConfirmation Then
' (SS,2/12/06) added FDelegateID and FDelegatePassword to following
ShowBookingConfirmation FConferenceID, FVenueID, FDelegateID, FDelegatePassword, FDelegateCostIncVAT, FDelegateCostExcVAT, FShowVAT
End If
If FHasMakeAnotherBookingLink Then SetUpMakeAnotherBookingForm ' (SS,5/9/06)
If FHasAccommodationLink Then SetUpAccommodationForm ' (SS,5/9/06)
ShowBookingFooter
ITP_ErrorMessage = gsErrorMessage
End Sub
Function GetConfirmationMessage
Dim LConfirmationMessage
LConfirmationMessage = FConfirmationMessage
' (SS,27/7/09) replaced GetAppSettingMemo with GetSettingMemo
LConfirmationMessage = Replace(LConfirmationMessage, "[CSLADDRESS]", "<b>" & GetSettingMemo("Application", "CompanyAddress") & "</b>")
LConfirmationMessage = Replace(LConfirmationMessage, "[REFERENCE]", "<b>" & GetBookingReference & "</b>")
LConfirmationMessage = Replace(LConfirmationMessage, "[AMOUNTINCVAT]", "<b>" & "�" & FDelegateCostIncVAT & "</b>")
LConfirmationMessage = Replace(LConfirmationMessage, "[AMOUNTEXCVAT]", "<b>" & "�" & FDelegateCostExcVAT & "</b>")
LConfirmationMessage = Replace(LConfirmationMessage, "[WEBSITE]", "<a href=""" & FVenueWebsite & """ target=""_blank"">" & FVenueWebsite & "</a>")
LConfirmationMessage = ReplaceWithLinks(LConfirmationMessage) ' (SS,4/12/07) moved here from below
' if there is a cost then show the payment links '
If FDelegateCostIncVAT > 0 Then
' create paypal form
If PayPalAllowed Then SetUpPayPalForm
' (SS,4/12/07) following moved above, mainly to handle "[ANOTHERBOOKINGLINK]" when no payment
' LConfirmationMessage = ReplaceWithLinks(LConfirmationMessage)
End If
GetConfirmationMessage = LConfirmationMessage
End Function
' (SS,4/7/07) added always send parameter
Sub SendBookingEmail(AAlwaysSend)
' send email '
Dim LSubject, LDetails
LSubject = "Confirmation of Attendance (Ref: " & GetBookingReference & ")"
GetOrderDetails FDelegateID
LDetails = CRLF
LDetails = LDetails + "Conference: " & Session("t_ConferenceName") & CRLF
LDetails = LDetails + "Venue: " & Session("t_VenueName") & CRLF
' (SS,8/12/08) removed the date as requested by Ruth in email
' LDetails = LDetails + "Date : " & Session("t_VenueDate") & CRLF
LDetails = LDetails + "Your Reference: " & Session("t_Reference") & CRLF
' LDetails = LDetails + "Date Booked : " & Session("t_DateTimeBooked") & CRLF
' (SS,26/6/13) above removed at Alan's request
' (SS,21/2/05) added If DelegateFieldAllowed for some fields which are now optional '
If BookingFieldAllowed(BF_NAME_ON_BADGE) Then
LDetails = LDetails + "Name on Badge: " & Session("t_NameOnBadge") & CRLF
End If
' (SS,1/5/15) improved look in variable font plain text emails by remove spaces before colon and replacing "Address" label with "Your Details" and move Full name, Job Title, Organisation to it
LDetails = LDetails + CRLF + "Your Details:" & CRLF
LDetails = LDetails + Session("t_FullName") & CRLF
If BookingFieldAllowed(BF_JOB_TITLE) Then
LDetails = LDetails + Session("t_JobTitle") & CRLF
End If
If BookingFieldAllowed(BF_ORGANISATION) Then
LDetails = LDetails + Session("t_Organisation") & CRLF
End If
If BookingFieldAllowed(BF_ADDRESS) Then
LDetails = LDetails + Session("t_Address") & CRLF
End If
If BookingFieldAllowed(BF_TELEPHONE) Then
LDetails = LDetails + "Telephone: " & Session("t_Telephone") & CRLF
End If
If BookingFieldAllowed(BF_FAX) Then
LDetails = LDetails + "Fax: " & Session("t_Fax") & CRLF
End If
If BookingFieldAllowed(BF_EMAIL) Then
LDetails = LDetails + "Email: " & Session("t_Email") & CRLF
End If
LDetails = LDetails & CRLF ' (SS,1/5/15)
' (SS,7/10/14)
If BookingFieldAllowed(BF_PURCHASE_ORDER_NO) Then
LDetails = LDetails + "PO No: " & Session("t_PurchaseOrderNo") & CRLF
End If
If BookingFieldAllowed(BF_DIETARY_NEEDS) Then
LDetails = LDetails + "Dietary Needs: " & Session("t_DietaryNeeds") & CRLF
End If
If BookingFieldAllowed(BF_SPECIAL_NEEDS) Then
LDetails = LDetails + "Special Needs: " & Session("t_SpecialNeeds") & CRLF
End If
LDetails = LDetails & CRLF ' (SS,1/5/15)
' (SS,14/10/05) get the extra field details
OpenQueryExtraFields False
' (SS,22/3/07) added following two lines
Dim LExtraFieldList
LExtraFieldList = ""
If Not EndOfQuery Then
Dim LFieldName, LDelegateField, LFormLabel
Do While Not EndOfQuery
LFieldName = GetQueryValue("FieldName")
LDelegateField = GetQueryValue("DelegateField")
' (SS,27/7/09) added If... as requested by Alan to not show the ones with "No" where "Yes" or "No" answer
' (SS,29/7/09) added LCase(Session("EF_" + LDelegateField)) <> ""
If LCase(Session("EF_" + LDelegateField)) <> "no" And LCase(Session("EF_" + LDelegateField)) <> "" Then
LFormLabel = GetQueryValue("FormLabel")
If LFormLabel = "" Then LFormLabel = LFieldName
'LDetails = LDetails + IIf(Len(LFormLabel) >= EMAIL_LABEL_LENGTH, LFormLabel, Left(LFormLabel + Space(EMAIL_LABEL_LENGTH), EMAIL_LABEL_LENGTH)) + ": "
' (SS,1/5/15) replaced above with following to improve look in variable font plane text emails
LDetails = LDetails + LFormLabel + ": "
LDetails = LDetails & Session("EF_" + LDelegateField) & CRLF
End If
' (SS,22/3/07) added following to create list of extra fields, to allow extra fields to be placed individually in the email
LExtraFieldList = LExtraFieldList + Iif(LExtraFieldList = "", "", ",") + LDelegateField
NextQueryRecord
Loop
End If
CloseQuery
Dim LVenueEmailText, LBody
LVenueEmailText = GetVenueFieldForVenueID("EmailText")
If IsNull(LVenueEmailText) Then LVenueEmailText = ""
LBody = "Attn: " + Session("t_FullName") & CRLF & CRLF
LBody = LBody + LVenueEmailText
LBody = ReplaceTokens(LBody, LDetails, LExtraFieldList) ' (SS,22/3/07) added LExtraFieldList
' (SS,14/12/04) removed Application("ContactEmailAddress") from 2nd parameter because it was being sent to nigel instead of ruth
' so possibly means that blind copies not reliable under dundas mailer
' (SS,24/1/05) replaced Application("ContactEmailFromAddress") in following with FCSLEmailAddress
' (SS,21/2/05) added If DelegateFieldAllowed(DF_EMAIL) to ensure email only send if email address is accepted from user '
' (SS,22/2/05) email only sent if status is applied, not if cancelled (i.e. not attending)
' (SS,4/7/07) added AAlwaysSend to always send i.e. when called from Delphi Admin app
If AAlwaysSend Or Session("t_Status") = STATUS_APPLIED Then
If BookingFieldAllowed(BF_EMAIL) Then
SendEmail strEmail, "", FCSLEmailAddress, LSubject, LBody, ""
End If
' (SS,9/12/04) ccs were going to wrong person, so added following to hopefully solve this '
' could be a bug in their mail server, were going sometimes to sales or nigel instead of Ruth '
' (SS,24/1/05) replaced Application("ContactEmailAddress") and Application("ContactEmailFromAddress") in following with FCSLEmailAddress
' (SS,27/1/05) added if FEmailCopyToCSL to only send this email if ticked in conference '
If FEmailCopyToCSL Then
SendEmail FCSLEmailAddress, "", FCSLEmailAddress, LSubject, LBody, ""
' (SS,1/7/09) added following for Bcc, NB not using second parameter because found to be not reliable in the past
If FBccEmailAddress <> "" Then SendEmail FBccEmailAddress, "", FCSLEmailAddress, LSubject, LBody, ""
End If
End If
End Sub
' (SS,4/9/06) moved from SendBookingEmail to here, used elsewhere
' (SS,22/3/07) added AExtraFields, a list of used comma separated extra fields
Function ReplaceTokens(AText, ADetails, AExtraFields)
Dim LText
LText = AText
LText = ReplaceStr(LText, "[VENUEADDRESS]", Session("t_VenueAddress"))
LText = ReplaceStr(LText, "[DETAILS]", ADetails)
LText = ReplaceStr(LText, "[AMOUNTINCVAT]", "�" & Session("t_AmountChargedIncVAT"))
LText = ReplaceStr(LText, "[AMOUNTEXCVAT]", "�" & Session("t_AmountChargedExcVAT"))
LText = ReplaceStr(LText, "[CSLADDRESS]", Session("t_PaymentAddress"))
LText = ReplaceStr(LText, "[WEBSITE]", Session("t_Website"))
LText = ReplaceStr(LText, "[INVOICENO]", Session("t_Reference"))
LText = ReplaceStr(LText, "[INVOICEDATE]", Session("t_InvoiceDate"))
' (SS,22/3/07) added following to allow Alan to separately add the extra fields to the email
If AExtraFields <> "" Then
Dim a, i, LExtraField
a = Split(AExtraFields, ",")
For i = 0 To UBound(a)
LExtraField = a(i)
LText = ReplaceStr(LText, "[" + UCase(LExtraField) & "]", Session("EF_" + LExtraField))
Next
End If
ReplaceTokens = LText
End Function
' (SS,3/7/07) added following to trigger an email from delphi admin program via browser
Sub SendEmailCopy(AType, ADelegateID, APassword)
If CheckDelegateIDAndPassword(ADelegateID, APassword) Then
GetOrderDetails ADelegateID
Response.Write("<table>")
Response.Write("<tr><td>Conference:</td><td><b>" & Session("t_ConferenceName") & "</b></td></tr>")
Response.Write("<tr><td>Venue:</td><td><b>" & Session("t_VenueName") & "</b></td></tr>")
Response.Write("<tr><td>Delegate ID:</td><td><b>" & ADelegateID & "</b></td></tr>")
Response.Write("<tr><td>Delegate Name:</td><td><b>" & Session("t_FullName") & "</b></td></tr>")
Response.Write("<tr><td>Status:</td><td><b>" & Session("t_Status") & "</b></td></tr>")
Response.Write("<tr><td>Amount Charged:</td><td><b>" & Session("t_AmountChargedIncVAT") & "</b></td></tr>")
Response.Write("<tr><td>Email:</td><td><b>" & Session("t_Email") & "</b></td></tr>")
Response.Write("</table>")
If AType = "c" Then
FDelegateID = ADelegateID ' SendBookingEmail requires this
FConferenceID = Session("t_ConferenceID")
GetConferenceDetails(FConferenceID)
SendBookingEmail(True) ' True to always send even if status is cancelled
Response.Write("<br>Confirmation Email has been sent.")
Else
SendEmailWithAttachedInvoice
Response.Write("<br>Payment Instructons Email has been sent.")
End If
Else
Response.Write("Invalid DelegateID/Password.")
End If
End Sub
' (SS,3/7/07) returns true if given delegate id and password are valid
Function CheckDelegateIDAndPassword(ADelegateID, APassword)
CheckDelegateIDAndPassword = Not IsNull(GetValueFromQuery("DelegateID", "SELECT DelegateID FROM delegates WHERE DelegateID = '" & ADelegateID & "' AND Password = '" & APassword & "'"))
End Function
' (SS,4/9/06)
Sub SendEmailWithAttachedInvoice
Dim LSubject, LBody, LConferenceDescription, LPaymentInstructions, LPDFFileName, LInvoiceHeading
LSubject = "Payment Instructions (Ref: " + Session("t_Reference") + ")"
LBody = GetConferenceDetailField(FConferenceID, "Text", "Bank Trans/Chq Email", "Text")
LBody = ReplaceTokens(LBody, "", "") ' (SS,22/3/07) added extra "" parameter
LConferenceDescription = GetConferenceDetailField(FConferenceID, "Text", "Title", "Text")
LConferenceDescription = LConferenceDescription & CRLF & GetConferenceDetailField(FConferenceID, "Text", "Summary", "Text")
LConferenceDescription = Replace(LConferenceDescription, "<br>", CRLF)
LInvoiceHeading = GetConferenceDetailField(FConferenceID, "Text", "Invoice Heading", "Text")
LPaymentInstructions = GetConferenceDetailField(FConferenceID, "Text", "Bank Trans/Chq Details", "Text")
LPDFFileName = Server.MapPath(".") & "\pdftemp\Invoice " & FDelegateID & ".pdf"
' (SS,8/5/09) added following here as well, because duplicate record error was occurring even though this is run after sending email
' delete the record
ExecuteQuery("DELETE FROM pdfreporter WHERE SessionID = '" & Session.SessionID & "'")
' create the pdf report record
OpenTable "pdfreporter"
AddRecord
PutFieldValue "SessionID", Session.SessionID
PutFieldValue "ReportFileName", Server.MapPath(".") & "\invoice.fr3"
PutFieldValue "PDFFileName", LPDFFileName
' changed from SQL to SQLSelect
PutFieldValue "SQLSelect", "SELECT * FROM pdfreporter p LEFT JOIN delegates d ON d.DelegateID = p.DelegateID WHERE p.SessionID = '" + Session.SessionID + "'"
PutFieldValue "DelegateID", FDelegateID
PutFieldValue "InvoiceNo", Session("t_Reference")
PutFieldValue "AmountExcVAT", Session("t_AmountChargedExcVAT")
PutFieldValue "InvoiceHeading", LInvoiceHeading
PutFieldValue "Address", Session("t_Address")
PutFieldValue "ConferenceDescription", LConferenceDescription
PutFieldValue "PaymentInstructions", LPaymentInstructions
PutFieldValue "PaymentInstructions", LPaymentInstructions
PutFieldValue "ShowVAT", FShowVAT ' (SS,14/9/06)
PostRecord
CloseTable
' call the pdf reporter to create the PDF file
Set objShell = CreateObject("WScript.Shell")
Dim objShell, objExecObject
Dim LCommand
LCommand = Application("PDFReporterPath") & " " & Session.SessionID & " " & Application("PDFReporterDatabase") & " " & Application("PDFReporterUserName") & " " & Application("PDFReporterPassword")
Set objExecObject = objShell.Exec(LCommand)
Dim LLine
Do While Not objExecObject.StdOut.AtEndOfStream
objExecObject.StdOut.ReadLine()
Loop
Set objExecObject = Nothing
Set objShell = Nothing
' send the attached email
SendEmail Session("t_Email"), "", FCSLEmailAddress, LSubject, LBody, LPDFFileName
If FEmailCopyToCSL Then
SendEmail FCSLEmailAddress, "", FCSLEmailAddress, LSubject, LBody, LPDFFileName
' (SS,1/7/09) added following for Bcc, NB not using second parameter because found to be not reliable in the past
' (SS,1/4/14) added missing SendEmail which was causing type mismatch error, it only had the parameters, SendEmail was missing
If FBccEmailAddress <> "" Then SendEmail FBccEmailAddress, "", FCSLEmailAddress, LSubject, LBody, LPDFFileName
End If
' delete the record and the file
ExecuteQuery("DELETE FROM pdfreporter WHERE SessionID = '" & Session.SessionID & "'")
DeleteFile(LPDFFileName)
End Sub
' (SS,4/9/06) called from PayPal callback
Sub SendEmailPayPalReceipt(ADelegateID)
FDelegateID = ADelegateID
OpenQuery("SELECT * FROM delegates d LEFT JOIN venues v ON v.VenueID = d.VenueID LEFT JOIN conferences c ON c.ConferenceID = v.ConferenceID WHERE d.DelegateID = '" & FDelegateID & "'")
FConferenceID = GetQueryValue("ConferenceID")
FCSLEmailAddress = GetQueryValue("CSLEmailAddress")
FBccEmailAddress = Trim(GetQueryValue2("BccEmailAddress")) ' (SS,1/7/09)
FEmailCopyToCSL = Iif(GetQueryValue("EmailCopyToCSL") = 0, False, True)
CloseQuery
GetOrderDetails(FDelegateID)
Dim LSubject, LBody, LConferenceDescription, LPaymentInstructions, LPDFFileName
LSubject = "PayPal Receipt (Ref: " + Session("t_Reference") + ")"
LBody = GetConferenceDetailField(FConferenceID, "Text", "PayPal Email", "Text")
LBody = ReplaceTokens(LBody, "", "") ' (SS,22/3/07) added extra "" parameter
' send the email
SendEmail Session("t_Email"), "", FCSLEmailAddress, LSubject, LBody, ""
If FEmailCopyToCSL Then
SendEmail FCSLEmailAddress, "", FCSLEmailAddress, LSubject, LBody, ""
' (SS,1/7/09) added following for Bcc, NB not using second parameter because found to be not reliable in the past
If FBccEmailAddress <> "" Then FBccEmailAddress, "", FCSLEmailAddress, LSubject, LBody, ""
End If
End Sub
' (SS,14/10/05) made into sub due to being required in 3 difference places
Sub OpenQueryExtraFields(AQueryTwo)
Dim LSQL
LSQL = "SELECT * FROM extrafields WHERE TableName = 'conferences' AND RecordID = '" + CleanSQLStr(FConferenceID) + "' AND ShowOnWeb <> 0 ORDER BY SortOrder, FieldName"
If AQueryTwo Then
OpenQuery2(LSQL)
Else
OpenQuery(LSQL)
End If
End Sub
' (SS,14/10/05) shows the extra fields for current conference
Sub ShowBookingFormExtraFields
Dim LInputType, LFieldName, LDelegateField, LLabel, LHelpText, LDefaultValue, LRequired, LWidth, LHeight, LComboList, LValue, LRadioList
Dim LMaxReached, LCounterAssigned ' (SS,27/7/09)
OpenQueryExtraFields False
Do While Not EndOfQuery
LInputType = GetQueryValue("InputType")
LFieldName = GetQueryValue("FieldName")
LDelegateField = GetQueryValue("DelegateField")
LLabel = GetQueryValue("FormLabel")
LHelpText = GetQueryValue("HelpText")
LDefaultValue = GetQueryValue("DefaultValue")
LRequired = IntToBool(GetQueryValue("Required"))
LWidth = GetQueryValue("Width")
LHeight = GetQueryValue("Height")
' if this form is being reposted then take entered values as defaults
If Request.Form("postbookingform") = "yes" Or FDirectDelegateLink Then
LDefaultValue = Session("EF_" + LDelegateField)
End If
' tidy the defaults
If LInputType = IT_TEXT then
If LWidth = 0 Then
LWidth = 40
End If
ElseIf LInputType = IT_MEMO Then
If LWidth = 0 Then
LWidth = 39
End If
If LHeight = 0 Then
LHeight = 2
End If
ElseIf LInputType = IT_CHECK_BOX Then
' translate default value to boolean for check box being ticked or not
If UCase(LDefaultValue) = "YES" Or UCase(LDefaultValue) = "TRUE" Or UCase(LDefaultValue) = "CHECKED" Or UCase(LDefaultValue) = "TICKED" Or LDefaultValue = "1" Or LDefaultValue = "-1" Then
LDefaultValue = True
Else
LDefaultValue = False
End If
ElseIf LInputType = IT_RADIO Then
' build the radio list
LRadioList = ""
OpenQuery2("SELECT * FROM valuelists WHERE TableName = 'conferences' AND RecordID = '" + CleanSQLStr(FConferenceID) + "' AND FieldName = '" + CleanSQLStr(LFieldName) + "' ORDER BY SortOrder, ValueListName")
Do While Not EndOfQuery2
LValue = GetQueryValue2("ValueListName")
LRadioList = LRadioList + "<input type=""radio"" name=""" + LFieldName + """ value=""" + LValue + """"
If LValue = LDefaultValue Then
LRadioList = LRadioList + " checked"
End If
LRadioList = LRadioList + ">" + LValue + CRLF
NextQueryRecord2
Loop
CloseQuery2
LDefaultValue = LRadioList ' for passing to ShowBookingFormExtraField
ElseIf LInputType = IT_COMBO_BOX Then
' build the combo list
LComboList = ""
OpenQuery2("SELECT * FROM valuelists WHERE TableName = 'conferences' AND RecordID = '" + CleanSQLStr(FConferenceID) + "' AND FieldName = '" + CleanSQLStr(LFieldName) + "' ORDER BY SortOrder, ValueListName")
If LDefaultValue = "" Then
LComboList = LComboList + "<option value = """" selected></option>" + CRLF
Else
LComboList = LComboList + "<option value = """"></option>" + CRLF
End If
Do While Not EndOfQuery2
' (SS,27/7/09) added If statement to only add item if maximum counter value not reached
LCounterAssigned = NB(GetQueryValue2("CounterAssigned"))
If LCounterAssigned <> "" Then
' HasCounterReachedMaximum will record 0 or less if maximum has been reached
LMaxReached = HasCounterReachedMaximum(LCounterAssigned, False)
Else
LMaxReached = 1 ' i.e. > 0
End If
If LMaxReached >= 1 Then
LValue = GetQueryValue2("ValueListName")
LComboList = LComboList + "<option value = """ & LValue & """"
If LValue = LDefaultValue Then
LComboList = LComboList + " selected"
End If
LComboList = LComboList + ">" + LValue + "</option>" + CRLF
End If
NextQueryRecord2
Loop
CloseQuery2
LDefaultValue = LComboList ' for passing to ShowBookingFormExtraField
End If
If LLabel = "" Then LLabel = LFieldName
ShowBookingFormExtraField LInputType, LFieldName, LLabel, LHelpText, LDefaultValue, LRequired, LWidth, LHeight
NextQueryRecord
Loop
CloseQuery
End Sub
' (SS,14/9/06)
Sub ShowBookingConfirmationExtraFields
OpenQueryExtraFields False
If Not EndOfQuery Then
Dim LFieldName, LFormLabel, LDefaultValue
Do While Not EndOfQuery
LFieldName = GetQueryValue("FieldName")
LFormLabel = GetQueryValue("FormLabel")
If LFormLabel = "" Then LFormLabel = LFieldName
LDefaultValue = Session("EF_" + GetQueryValue("DelegateField"))
ShowBookingConfirmationExtraField LFieldName, LFormLabel, LDefaultValue
NextQueryRecord
Loop
End If
CloseQuery
End Sub
' (SS,21/2/05) returns true if field is allowed '
' fields are separated by newlines, thats why Chr(13) + Chr(10) is used here '
' FBookingFieldsAllowed is also starts and ends with Chr(13) + Chr(10) '
Function BookingFieldAllowed(AFieldName)
If Instr(FBookingFieldsAllowed, Chr(13) + Chr(10) + AFieldName + Chr(13) + Chr(10)) = 0 Then
BookingFieldAllowed = False
Else
BookingFieldAllowed = True
End If
End Function
' (SS,28/8/04) values are placed in variables now, not Session because it's designed to work without cookies '
' (SS,5/9/06) added ANew parameter, now also called when make another booking clicked
Sub PlacesValuesInSession
strTitle = Request.Form("Title")
strFirstName = Trim(Request.Form("FirstName"))
strSurname = Trim(Request.Form("Surname"))
strNameOnBadge = Trim(Request.Form("NameOnBadge"))
strJobTitle = Trim(Request.Form("JobTitle"))
strOrganisation = Trim(Request.Form("Organisation"))
strAddressLine1 = Trim(Request.Form("AddressLine1"))
strAddressLine2 = Trim(Request.Form("AddressLine2"))
strTown = Trim(Request.Form("Town"))
strCounty = Trim(Request.Form("County"))
strPostcode = Trim(Request.Form("Postcode"))
strCountry = Trim(Request.Form("Country"))
strTelephone = Trim(Request.Form("Telephone"))
strFax = Trim(Request.Form("Fax"))
strEmail = Trim(Request.Form("Email"))
strPurchaseOrderNo = Trim(Request.Form("PurchaseOrderNo")) ' (SS,7/10/14)
strRetypeEmail = Trim(Request.Form("RetypeEmail"))
strDietaryNeeds = Trim(Request.Form("DietaryNeeds"))
strSpecialNeeds = Trim(Request.Form("SpecialNeeds"))
strAttendanceConfirmation = Request.Form("AttendanceConfirmation")
strCancellationConditions = Request.Form("CancellationConditions")
End Sub
Sub AddBookingToDatabase
Dim LStatus
' (SS,21/2/05) added If BookingFieldAllowed '
If BookingFieldAllowed(BF_ATTENDANCE_CONFIRMATION) And strAttendanceConfirmation = "No" Then
LStatus = STATUS_CANCELLED
Else
LStatus = STATUS_APPLIED
End If
' (SS,14/7/05) added If FDelegateDirectLink and open of existing record '
If FDirectDelegateLink Then
Dim LSQL
' (SS,15/2/07) removed DateTimeBooked=NOW(), booking date/time now stays at the original
LSQL = "UPDATE delegates SET VenueID='" & CleanSQLStr(FVenueID) & "', "
LSQL = LSQL + "Title='" + CleanSQLStr(strTitle) + "', FirstName='" + CleanSQLStr(strFirstName) + "', "
LSQL = LSQL + "Surname='" + CleanSQLStr(strSurname) + "', NameOnBadge='" + CleanSQLStr(strNameOnBadge) + "', "
LSQL = LSQL + "JobTitle='" + CleanSQLStr(strJobTitle) + "', Organisation='" + CleanSQLStr(strOrganisation) + "', "
LSQL = LSQL + "AddressLine1='" + CleanSQLStr(strAddressLine1) + "', AddressLine2='" + CleanSQLStr(strAddressLine2) + "', "
LSQL = LSQL + "Town='" + CleanSQLStr(strTown) + "', County='" + CleanSQLStr(strCounty) + "', "
LSQL = LSQL + "Postcode='" + CleanSQLStr(strPostcode) + "', Country='" + CleanSQLStr(strCountry) + "', "
LSQL = LSQL + "Telephone='" + CleanSQLStr(strTelephone) + "', Fax='" + CleanSQLStr(strFax) + "', Email='" + CleanSQLStr(strEmail) + "', "
LSQL = LSQL + "DietaryNeeds='" + CleanSQLStr(strDietaryNeeds) + "', SpecialNeeds='" + CleanSQLStr(strSpecialNeeds) + "', "
LSQL = LSQL + "AmountCharged=" + CleanSQLStr(FDelegateCostIncVAT) + ", Status='" + CleanSQLStr(LStatus) + "', "
LSQL = LSQL + "SessionID='" + CleanSQLStr(Session.SessionID) + "' "
LSQL = LSQL + "WHERE DelegateID = " & CleanSQLStr(FDelegateID)
ExecuteQuery(LSQL)
Else
FDelegateID = GetNextOrderNo
OpenTable "delegates"
AddRecord
PutFieldValue "DelegateID", FDelegateID
PutFieldValue "VenueID", FVenueID
PutFieldValue "DateTimeBooked", Now
PutFieldValue "Title", strTitle
PutFieldValue "FirstName", strFirstName
PutFieldValue "Surname", strSurname
PutFieldValue "NameOnBadge", strNameOnBadge
PutFieldValue "JobTitle", strJobTitle
PutFieldValue "Organisation", strOrganisation
PutFieldValue "AddressLine1", strAddressLine1
PutFieldValue "AddressLine2", strAddressLine2
PutFieldValue "Town", strTown
PutFieldValue "County", strCounty
PutFieldValue "Postcode", strPostcode
PutFieldValue "Country", strCountry
PutFieldValue "Telephone", strTelephone
PutFieldValue "Fax", strFax
PutFieldValue "Email", strEmail
PutFieldValue "PurchaseOrderNo", strPurchaseOrderNo ' (SS,7/10/14)
PutFieldValue "DietaryNeeds", strDietaryNeeds
PutFieldValue "SpecialNeeds", strSpecialNeeds
PutFieldValue "AmountCharged", FDelegateCostIncVAT
PutFieldValue "Status", LStatus
PutFieldValue "SessionID", Session.SessionID
PutFieldValue "Password", GetRandomPassword(3) ' (SS,14/7/05)
PostRecord
CloseTable
End If
' (SS,14/10/05) save the extra fields using Update query
OpenQueryExtraFields False
LSQL = ""
If Not EndOfQuery Then
Dim LDelegateField
Do While Not EndOfQuery
LDelegateField = GetQueryValue("DelegateField")
If LDelegateField <> "" Then
LSQL = LSQL + IIf(LSQL = "", "", ", ") + LDelegateField + "='" + CleanSQLStr(Session("EF_" + LDelegateField)) + "'"
End If
NextQueryRecord
Loop
If LSQL <> "" Then
LSQL = "UPDATE delegates SET " + LSQL
LSQL = LSQL + " WHERE DelegateID = " & CleanSQLStr(FDelegateID)
End If
End If
CloseQuery
If LSQL <> "" Then ExecuteQuery(LSQL)
End Sub
' (SS,25/11/04) check whether conference exists, if found and open it gets the ConferenceName and Description into two globals '
Function CheckValidConferenceID(AConferenceID)
OpenQuery("SELECT * FROM conferences WHERE ConferenceID = '" + CleanSQLStr(AConferenceID) + "'")
If Not EndOfQuery Then
If GetQueryValue("Status") <> "Open" Then
gsErrorMessage = "Sorry, on-line registration for this conference is now closed"
CheckValidConferenceID = False
Else
GetConferenceDetails(AConferenceID) ' (SS,4/7/07) moved code to separate GetConferenceDetails routine
CheckValidConferenceID = True
End If
Else
gsErrorMessage = ""
CheckValidConferenceID = False
End If
CloseQuery
End Function
' (SS,4/7/07) added following with code from CheckValidConferenceID
Sub GetConferenceDetails(AConferenceID)
OpenQuery2("SELECT * FROM conferences WHERE ConferenceID = '" + CleanSQLStr(AConferenceID) + "'")
If Not EndOfQuery2 Then
FConferenceName = GetQueryValue2("ConferenceName")
FConferenceDescription = GetQueryValue2("ConferenceDescription")
FConfirmationMessage = GetQueryValue2("ConfirmationMessage")
FCSLEmailAddress = Trim(GetQueryValue2("CSLEmailAddress")) ' (SS,24/1/05) ' (SS,1/7/09) added Trim
FEmailCopyToCSL = Iif(GetQueryValue2("EmailCopyToCSL") = 0, False, True) ' (SS,27/1/05)
FBccEmailAddress = Trim(GetQueryValue2("BccEmailAddress")) ' (SS,1/7/09)
FPassword = GetQueryValue2("Password")
FBookingFieldsAllowed = Chr(13) + Chr(10) & GetQueryValue2("BookingFieldsAllowed") & Chr(13) + Chr(10) ' (SS,21/2/05)
FChargeVAT = GetQueryValue2("ChargeVAT") = 1 ' (SS,14/9/06)
FShowVAT = GetQueryValue2("ShowVAT") = 1 ' (SS,14/9/06)
End If
CloseQuery2
End Sub
' (SS,14/7/05) get VenueID for given Delegate '
' (SS,2/12/06) now always returns Password and sets FValidPassword to true if password is valid
Function GetVenueIDForDelegateAndCheckPassword(ADelegateID, APassword)
Dim LSQL
FValidPassword = False ' (SS,2/12/06)
FExistingStatus = "" ' (SS,2/12/06)
' (SS,15/2/07) added DateTimeBooked to following
LSQL = "SELECT VenueID, Password, Status, DateTimeBooked FROM delegates WHERE DelegateID = '" + CleanSQLStr(ADelegateID) + "'"
OpenQuery(LSQL)
If Not EndOfQuery Then
GetVenueIDForDelegateAndCheckPassword = GetQueryValue("VenueID")
FValidPassword = GetQueryValue("Password") = APassword ' (SS,2/12/06)
FExistingStatus = GetQueryValue("Status") ' (SS,2/12/06)
FDateTimeBooked = GetQueryValue("DateTimeBooked") ' (SS,15/2/07)
Else
GetVenueIDForDelegateAndCheckPassword = ""
gsErrorMessage = "No such Delegate, or invalid password"
End If
CloseQuery
End Function
' (SS,14/7/05) get ConferenceID for given Venue '
Function GetConferenceIDForVenueID(AVenueID)
Dim LSQL
LSQL = "SELECT ConferenceID FROM venues WHERE VenueID = '" + CleanSQLStr(AVenueID) + "'"
OpenQuery(LSQL)
If Not EndOfQuery Then
GetConferenceIDForVenueID = GetQueryValue("ConferenceID")
Else
GetConferenceIDForVenueID = ""
gsErrorMessage = "No such Venue"
End If
CloseQuery
End Function
' (SS,26/9/2004) returns true if venue id was found and puts the ID in FVenueID '
' also puts VenueName, VenueDescription globals '
Function CheckValidVenueID(AVenueID)
Dim LSQL
' (SS,14/7/05) added "BookingEndDate - " which was missing '
LSQL = "SELECT *, DATE_FORMAT(StartDate, '%D %M %Y') AS StartDateNiceFormat, " &_
"DATE_FORMAT(EndDate, '%D %M %Y') AS EndDateNiceFormat, " &_
"BookingEndDate - CURDATE() AS DaysBeforeBookingEnd FROM venues WHERE VenueID = '" + CleanSQLStr(AVenueID) + "'"
OpenQuery(LSQL)
If Not EndOfQuery Then
CheckValidVenueID = True
FVenueName = GetQueryValue("VenueName")
FVenueDescription = GetQueryValue("VenueDescription")
FVenueWebsite = GetQueryValue("Website")
' get the costing fields
' CDbl necessary in following to prevent type mismatch error
' possibly because they end up as a string from ODBC (due to MySQL decimal type?)
FDelegateCost = CDbl(GetQueryValue("DelegateCost"))
FDelegateCostRate2 = CDbl(GetQueryValue("DelegateCostRate2"))
FApplyRate2Date = GetQueryValue("ApplyRate2Date")
FVenueDate = GetQueryValue("StartDateNiceFormat")
If GetQueryValue("StartDateNiceFormat") <> GetQueryValue("EndDateNiceFormat") Then
FVenueDate = FVenueDate + " to " + GetQueryValue("EndDateNiceFormat")
End If
If GetQueryValue("DaysBeforeBookingEnd") < 0 Then
gsErrorMessage = Application("ClosedMessage")
CheckValidVenueID = False
End If
Else
gsErrorMessage = "No such Venue"
CheckValidVenueID = False
End If
CloseQuery
End Function
' (SS,13/9/06) values FDelegateCost, FApplyRate2Date, FDelegateCostRate2
' used here would already have been looked up by CheckValidVenueID
Function CalculateDelegateCost
CalculateDelegateCost = True
Dim LUseRate2, LDelegateCost, LRateField
' (SS,9/11/06) if delegate is not attending then set the fee to zero
If Not GetDelegateIsAttending Then
LDelegateCost = 0
Else
If (DateDiff("d", GetBookingDate, FApplyRate2Date) <= 0) Then ' (SS,15/2/07) replaced date with GetBookingDate
LUseRate2 = True
LRateField = "Rate2"
Else
LUseRate2 = False
LRateField = "Rate1"
End If
If LUseRate2 Then
LDelegateCost = FDelegateCostRate2
Else
LDelegateCost = FDelegateCost
End If
' determine if main is set
Dim LMainFieldField, LMainValueListName, LHasMain, LHasDisallows, LAreRecords
LMainFieldField = ""
LMainValueListName = ""
LHasMain = False
LHasDisallows = False
OpenQuery("SELECT * FROM valuelists WHERE TableName = 'conferences' AND RecordID = '" + CleanSQLStr(FConferenceID) + "' ORDER BY FieldName, SortOrder, ValueListName")
LAreRecords = Not EndOfQuery ' (SS,28/9/06)
Do While Not EndOfQuery
If IntToBool(GetQueryValue("Main")) Then
LHasMain = True
LMainFieldField = GetQueryValue("FieldName")
LMainValueListName = GetQueryValue("ValueListName")
End If
If IntToBool(GetQueryValue("DisallowIfMainSelected")) Then
LHasDisallows = True
End If
NextQueryRecord
Loop
Dim LMainSet, LEFDelegateFieldName
LMainSet = False
If LMainFieldField <> "" Then
LEFDelegateFieldName = GetEFDelegateFieldName(LMainFieldField)
If Session("EF_" + LEFDelegateFieldName) = LMainValueListName Then
LMainSet = True
End If
End If
Dim LCost, LIncludeCost, LDisallowsSet
LDisallowsSet = False
If LAreRecords Then ' (SS,28/9/06) added to prevent error "Either BOF or EOF is True, or the current record has been deleted" in FirstQueryRecord when no records in query
FirstQueryRecord
Do While Not EndOfQuery
LCost = GetQueryValue(LRateField)
If IsNull(LCost) Then
LCost = 0
Else
LCost = CDbl(LCost)
End If
' add the cost if selected value matches
LEFDelegateFieldName = GetEFDelegateFieldName(GetQueryValue("FieldName"))
If LEFDelegateFieldName <> "" And Session("EF_" + LEFDelegateFieldName) = GetQueryValue("ValueListName") Then
If IntToBool(GetQueryValue("DisallowIfMainSelected")) Then LDisallowsSet = True
LIncludeCost = False
If IntToBool(GetQueryValue("Main")) Then
If LMainSet Then LIncludeCost = True
Else
If LMainSet Then
If Not IntToBool(GetQueryValue("PriceIncludedInMain")) Then LIncludeCost = True
Else
LIncludeCost = True
End If
End If
If LIncludeCost Then LDelegateCost = LDelegateCost + LCost
End if
NextQueryRecord
Loop
End If
CloseQuery
If (LMainSet And LDisallowsSet) Or (LHasMain And LHasDisallows And Not LMainSet And Not LDisallowsSet) Then
CalculateDelegateCost = False
gsErrorMessage = "Inappropriate choice made. Please correct."
End If
End If ' If Not GetDelegateIsAttending
FDelegateCostExcVAT = FormatNumber(LDelegateCost, 2)
FDelegateCostIncVAT = FormatNumber(GetIncVATAmount(FDelegateCostExcVAT), 2)
End Function
' (SS,15/2/07) returns booking date, if delegate record hasn't yet been created then it assumes today's date
Function GetBookingDate
If FDelegateID = "" Then
GetBookingDate = Date
Else
GetBookingDate = FDateTimeBooked
End If
End Function
' (SS,13/9/06) EF stands for Extra Field
Function GetEFDelegateFieldName(AFieldName)
GetEFDelegateFieldName = ""
OpenQueryExtraFields(True)
Do While Not EndOfQuery2
If GetQueryValue2("FieldName") = AFieldName Then
GetEFDelegateFieldName = GetQueryValue2("DelegateField")
Exit Do
End If
NextQueryRecord2
Loop
CloseQuery2
End Function
' (SS,26/9/2004) returns given venue field value '
Function GetVenueFieldForVenueID(AFieldName)
OpenQuery("SELECT * FROM venues WHERE VenueID = '" + CleanSQLStr(FVenueID) + "'")
If Not EndOfQuery Then
GetVenueFieldForVenueID = GetQueryValue(AFieldName)
Else
GetVenueFieldForVenueID = ""
End If
CloseQuery
End Function
' (SS,26/9/2004) returns true if venue places available '
Function CheckVenuePlaces
Dim LVenuePlaces, LPlacesRequired
' (SS,14/7/05) if direct link then no need to check for places '
If FDirectDelegateLink Then
CheckVenuePlaces = True
Exit Function
End If
OpenQuery("SELECT * FROM venues WHERE VenueID = '" + CleanSQLStr(FVenueID) + "'")
If Not EndOfQuery Then
CheckVenuePlaces = True
LVenuePlaces = GetQueryValue("MaxDelegates")
Else
LVenuePlaces = 0
End If
CloseQuery
' (SS,31/5/06) added Status <> "Awaiting" to not count these as booked '
OpenQuery("SELECT COUNT(*) AS PlacesRequired FROM delegates WHERE VenueID = '" + CleanSQLStr(FVenueID) + "' AND Status <> '" & STATUS_CANCELLED & "' AND Status <> '" & STATUS_AWAITING & "'")
LPlacesRequired = GetQueryValue("PlacesRequired")
CloseQuery
CheckVenuePlaces = (LPlacesRequired < LVenuePlaces)
End Function
' use for adding web form contact enquiry to database
' called from email asps
' (SS,3/2/04) changed to allow any number of form values to be added, as listed in AFieldList
' also up to 3 special values
' (SS,4/2/04) wanted to used optional parameters but they don't work in vbscript
' (SS,6/8/04) added ASendMail parameter, so things can be added to database without email being sent
' (SS,16/8/04) added AExtraForEnquiryField to allow adding string to Enquiry field
Sub AddContactToDatabaseAndEmail(AType, AFieldList, AEnquiryFieldList, AExtraForEnquiryField, ASendEmail)
Dim NL
NL = Chr(13) + Chr(10) + Chr(13) + Chr(10) ' *** may be a better way?
Dim LEmailBody
Dim i, c, LLength, LFieldName, LFieldValue, LEnquiryFieldValue
LEmailBody = ""
OpenTable "contacts"
AddRecord
PutFieldValue "Type", AType
PutFieldValue "DateTimeContacted", Now
' go through list of fields placing the values
LLength = Len(AFieldList)
LFieldName = ""
For i = 1 To LLength
c = Mid(AFieldList, i, 1)
' if comma or last char, i.e. we have a field '
If c <> "," Then LFieldName = LFieldName + c
If c = "," Or i = LLength Then
LFieldName = Trim(LFieldName)
If LFieldName <> "" Then
LFieldValue = Request.Form(LFieldName)
If LFieldValue <> "" Then
PutFieldValue LFieldName, LFieldValue
LEmailBody = LEmailBody + LFieldName + ": " & LFieldValue & NL
End If
LFieldName = ""
End If
End If
Next
' go through list of fields in Enquiry Fields placing the values
LLength = Len(AEnquiryFieldList)
LFieldName = ""
LEnquiryFieldValue = ""
For i = 1 To LLength
c = Mid(AEnquiryFieldList, i, 1)
' if comma or last char, i.e. we have a field '
If c <> "," Then LFieldName = LFieldName + c
If c = "," Or i = LLength Then
LFieldName = Trim(LFieldName)
If LFieldName <> "" Then
LFieldValue = Request.Form(LFieldName)
If LFieldValue <> "" Then
LEnquiryFieldValue = LEnquiryFieldValue + LFieldName + ": " & LFieldValue & NL
LEmailBody = LEmailBody + LFieldName + ": " & LFieldValue & NL
End If
LFieldName = ""
End If
End If
Next
' add the extra enquiry value '
If AExtraForEnquiryField <> "" Then
LEmailBody = LEmailBody & AExtraForEnquiryField
If LEnquiryFieldValue = "" Then
LEnquiryFieldValue = AExtraForEnquiryField
Else
LEnquiryFieldValue = LEnquiryFieldValue & AExtraForEnquiryField
End If
End If
If LEnquiryFieldValue <> "" Then
PutFieldValue "Enquiry", LEnquiryFieldValue
End If
PostRecord
CloseTable
If ASendEmail Then SendContactEmail AType + " Form", LEmailBody
End Sub
' (SS,3/2/04) new routine which just sends the email
' given subject and body, uses mail server and email addresses from table
Sub SendContactEmail(ASubject, ABody)
' send the email using Dundas Mailer Control
Dim objEmail 'Mailer control
Set objEmail = Server.CreateObject("Dundas.Mailer")
objEmail.SMTPRelayServers.Add Application("MailServer")
If Application("MailServer2") <> "" Then
objEmail.SMTPRelayServers.Add Application("MailServer2")
End If
'set Mailer control properties and collection items'
objEmail.TOs.Add Application("ContactEmailAddress")
If Application("ContactEmailBCC1") <> "" Then objEmail.BCCs.Add Application("ContactEmailBCC1")
If Application("ContactEmailBCC2") <> "" Then objEmail.BCCs.Add Application("ContactEmailBCC2")
objEmail.FromAddress = Application("ContactEmailFromAddress")
objEmail.Subject = ASubject
objEmail.Body = ABody
'send email
objEmail.SendMail
'you can test for the success/failure of the operation by examining VBScript's Err object here
Set objEmail = Nothing
End Sub
' (SS,6/8/04) sends email to given address '
' (SS,27/9/04) added ABCCEmailAddress '
' (SS,14/12/04) avoid using ABCCEmailAddress, found that it might be unreliable '
' nigel@conferencesearch.co.uk (i.e. postmaster) was getting emails BCCed to ruth@conferencesearch.co.uk '
' possible fault with BCCs property of dundas mailer '
Sub SendEmail(AEmailAddress, ABCCEmailAddress, AFromEmailAddress, ASubject, ABody, AAttachedFileName)
' send the email using Dundas Mailer Control
Dim objEmail 'Mailer control
Set objEmail = Server.CreateObject("Dundas.Mailer")
objEmail.SMTPRelayServers.Add Application("MailServer")
If Application("MailServer2") <> "" Then
objEmail.SMTPRelayServers.Add Application("MailServer2")
End If
'set Mailer control properties and collection items
objEmail.TOs.Add AEmailAddress
If ABCCEmailAddress <> "" Then objEmail.BCCs.Add ABCCEmailAddress
objEmail.FromAddress = AFromEmailAddress
objEmail.Subject = ASubject
objEmail.Body = ABody
If AAttachedFileName <> "" Then objEmail.Attachments.Add AAttachedFileName
'send email
objEmail.SendMail
'you can test for the success/failure of the operation by examining VBScript's Err object here
Set objEmail = Nothing
End Sub
' (SS,13/8/04) appends to WHERE clause of SQL '
Sub AddToWhere(AAdd, AWhere, AToAdd, AOperator)
If AAdd Then
If AWhere = "" Then
AWhere = AToAdd
Else
AWhere = AWhere + " " & AOperator & " " + AToAdd
End If
End If
End Sub
' get next order no from setting or orders table '
' (SS,27/9/04) modified for DelegateID '
Function GetNextOrderNo
Dim LOrderNoFromSettings, LHighestOrderNoUsed, LNextOrderNo
ExecuteQuery("LOCK TABLES settings WRITE, delegates READ") ' (SS,14/7/05) lock table, wait until available '
' (SS,27/7/09) replaced GetAppSetting with GetSetting
LOrderNoFromSettings = GetSetting("Application", "NextOrderNo") ' GetSetting always returns a string value or null if not found
If IsNull(LOrderNoFromSettings) Then
LOrderNoFromSettings = 1
Else
LOrderNoFromSettings = CInt(LOrderNoFromSettings)
If LOrderNoFromSettings <= 0 Then LOrderNoFromSettings = 1
End If
LHighestOrderNoUsed = GetValueFromQuery("HighestOrderNoUsed", "SELECT MAX(DelegateID) AS HighestOrderNoUsed FROM delegates")
If IsNull(LHighestOrderNoUsed) Then LHighestOrderNoUsed = 0
If LHighestOrderNoUsed > LOrderNoFromSettings Then
LNextOrderNo = LHighestOrderNoUsed + 1
Else
LNextOrderNo = LOrderNoFromSettings
End If
' set next order no to be used in settings table
' (SS,27/7/09) replaced SetAppSetting with SetSetting
SetSetting "Application", "NextOrderNo", LNextOrderNo + 1
' return the next order no '
GetNextOrderNo = LNextOrderNo
ExecuteQuery("UNLOCK TABLES") ' (SS,14/7/05) release lock placed earlier
End Function
Function GetFullName(ATitle, AFirstName, ASurname)
Dim LFullName
LFullName = ""
If ATitle <> "" Then LFullName = ATitle
If AFirstName <> "" Then LFullName = LFullName + Iif(LFullName = "", "", " ") + AFirstName
If ASurname <> "" Then LFullName = LFullName + Iif(LFullName = "", "", " ") + ASurname
GetFullName = LFullName
End Function
' get order details for given order into session variables '
' used to display on web page or send as email '
' Session variables are prefixed by "t_" so they don't interfere with other session variables '
' (SS,14/7/05) modified to get values into str.. for DirectLink feature '
Function GetOrderDetails(AOrderNo)
' get main order details into session '
Dim LSQL
' (SS,4/9/06) added InvoiceDateNiceFormat
LSQL = "SELECT *, delegates.Status AS DelegateStatus, DATE_FORMAT(DateTimeBooked, '%D %M %Y %l:%i %p') AS DateTimeBookedNiceFormat, " &_
"DATE_FORMAT(DateTimeBooked, '%D %M %Y') AS InvoiceDateNiceFormat, " &_
"DATE_FORMAT(StartDate, '%D %M %Y') AS StartDateNiceFormat, " &_
"DATE_FORMAT(EndDate, '%D %M %Y') AS EndDateNiceFormat " &_
"FROM delegates " &_
"INNER JOIN venues ON venues.VenueID = delegates.VenueID " &_
"INNER JOIN conferences ON conferences.ConferenceID = venues.ConferenceID " &_
"WHERE DelegateID = " & AOrderNo
OpenQuery(LSQL)
' (SS,3/7/07) moved following two lines here from SendEmailPayPalReceipt because emails may be sent via booking-email.asp
FCSLEmailAddress = Trim(GetQueryValue("CSLEmailAddress")) ' (SS,1/7/09) added Trim
FEmailCopyToCSL = Iif(GetQueryValue("EmailCopyToCSL") = 0, False, True)
FBccEmailAddress = Trim(GetQueryValue("BccEmailAddress")) ' (SS,1/7/09)
If EndOfQuery Then
GetOrderDetails = False
Else
GetOrderDetails = True
' (SS,15/9/06) required because this may be called by order-print.asp
' and FChargeVAT is used by GetExcVATAmount, a bit messy, will do for now
' in future hold the ExcVAT price in delegate record
FChargeVAT = GetQueryValue("ChargeVAT") = 1 ' (SS,14/9/06)
FShowVAT = GetQueryValue("ShowVAT") = 1 ' (SS,14/9/06)
Session("t_AmountChargedIncVAT") = FormatNumber(GetQueryValue("AmountCharged"), 2)
Session("t_AmountChargedExcVAT") = FormatNumber(GetExcVATAmount(GetQueryValue("AmountCharged")), 2)
Session("t_DateTimeBooked") = GetQueryValue("DateTimeBookedNiceFormat")
Session("t_InvoiceDate") = GetQueryValue("InvoiceDateNiceFormat")
Session("t_ConferenceID") = GetQueryValue("ConferenceID") ' (SS,4/7/07)
Session("t_ConferenceName") = GetQueryValue("ConferenceName")
Session("t_VenueName") = GetQueryValue("VenueName")
Session("t_VenueAddress") = GetQueryValue("VenueAddress")
Session("t_VenueAddressForHTML") = ConvertNewlinesToHTML(Session("t_VenueAddress"))
Session("t_VenueDate") = GetQueryValue("StartDateNiceFormat")
If GetQueryValue("StartDateNiceFormat") <> GetQueryValue("EndDateNiceFormat") Then
Session("t_VenueDate") = Session("t_VenueDate") & " to " & GetQueryValue("EndDateNiceFormat")
End If
Session("t_Website") = GetQueryValue("Website")
Session("t_Reference") = GetBookingReferenceFrom(GetQueryValue("RefNoPrefix"), GetQueryValue("VenueID"), GetQueryValue("DelegateID"))
Session("t_FullName") = GetFullName(GetQueryValue("Title"), GetQueryValue("FirstName"), GetQueryValue("Surname"))
Session("t_NameOnBadge") = GetQueryValue("NameOnBadge")
Session("t_JobTitle") = GetQueryValue("JobTitle") ' (SS,21/2/05) '
Session("t_Organisation") = GetQueryValue("Organisation")
Session("t_Address") = GetQueryValue("AddressLine1")
If GetQueryValue("AddressLine2") <> "" Then Session("t_Address") = Session("t_Address") & CRLF & GetQueryValue("AddressLine2")
If GetQueryValue("Town") <> "" Then Session("t_Address") = Session("t_Address") & CRLF & GetQueryValue("Town")
If GetQueryValue("County") <> "" Then Session("t_Address") = Session("t_Address") & CRLF & GetQueryValue("County")
If GetQueryValue("Postcode") <> "" Then Session("t_Address") = Session("t_Address") & CRLF & GetQueryValue("Postcode")
If GetQueryValue("Country") <> "" Then Session("t_Address") = Session("t_Address") & CRLF & GetQueryValue("Country")
Session("t_AddressForHTML") = ConvertNewlinesToHTML(Session("t_Address"))
Session("t_Telephone") = GetQueryValue("Telephone")
Session("t_Fax") = GetQueryValue("Fax")
Session("t_Email") = GetQueryValue("Email")
Session("t_PurchaseOrderNo") = GetQueryValue("PurchaseOrderNo") ' (SS,7/10/14)
Session("t_DietaryNeeds") = GetQueryValue("DietaryNeeds")
Session("t_SpecialNeeds") = GetQueryValue("SpecialNeeds")
' (SS,21/2/05) had to use delegates.Status AS DelegatesStatus in folowing
' because get delegates.Status does not work, Status gets Status from Conferences
Session("t_Status") = GetQueryValue("DelegateStatus")
' (SS,27/7/09) replaced GetAppSettingMemo with GetSettingMemo
Session("t_PaymentAddress") = GetSettingMemo("Application", "CompanyAddress")
' (SS,1/9/06) added following for PayPal use
Session("t_DelegateID") = GetQueryValue("DelegateID")
Session("t_FirstName") = GetQueryValue("FirstName")
Session("t_Surname") = GetQueryValue("Surname")
Session("t_AddressLine1") = GetQueryValue("AddressLine1")
Session("t_AddressLine2") = GetQueryValue("AddressLine2")
Session("t_Town") = GetQueryValue("Town")
Session("t_County") = GetQueryValue("County")
Session("t_Postcode") = GetQueryValue("Postcode")
Session("t_Country") = GetQueryValue("Country")
' (SS,5/9/06) for passing on to make another booking and accommodation form
Session("Title") = GetQueryValue("Title")
Session("FirstName") = GetQueryValue("FirstName")
Session("Surname") = GetQueryValue("Surname")
Session("Organisation") = GetQueryValue("Organisation")
Session("AddressLine1") = GetQueryValue("AddressLine1")
Session("AddressLine2") = GetQueryValue("AddressLine2")
Session("Town") = GetQueryValue("Town")
Session("County") = GetQueryValue("County")
Session("Postcode") = GetQueryValue("Postcode")
Session("Country") = GetQueryValue("Country")
Session("Telephone") = GetQueryValue("Telephone")
Session("Email") = GetQueryValue("Email")
' (SS,14/7/05) this gets values for use when showing existing data on form '
If FDirectDelegateLink Then
strTitle = GetQueryValue("Title")
strFirstName = GetQueryValue("FirstName")
strSurname = GetQueryValue("Surname")
strNameOnBadge = GetQueryValue("NameOnBadge")
strJobTitle = GetQueryValue("JobTitle")
strOrganisation = GetQueryValue("Organisation")
strAddressLine1 = GetQueryValue("AddressLine1")
strAddressLine2 = GetQueryValue("AddressLine2")
strTown = GetQueryValue("Town")
strCounty = GetQueryValue("County")
strPostcode = GetQueryValue("Postcode")
strCountry = GetQueryValue("Country")
strTelephone = GetQueryValue("Telephone")
strFax = GetQueryValue("Fax")
strEmail = GetQueryValue("Email")
strRetypeEmail = GetQueryValue("Email")
strDietaryNeeds = GetQueryValue("DietaryNeeds")
strSpecialNeeds = GetQueryValue("SpecialNeeds")
' (SS,18/10/05) get extra field values
OpenQueryExtraFields True
If Not EndOfQuery2 Then
Dim LDelegateField
Do While Not EndOfQuery2
LDelegateField = GetQueryValue2("DelegateField")
If LDelegateField <> "" Then
Session("EF_" + LDelegateField) = GetQueryValue(LDelegateField)
End If
NextQueryRecord2
Loop
CloseQuery2
End If
End If
End If
CloseQuery
End Function
' (SS,28/9/2004) sends email with the browser info, inc form values etc. '
' also writes to file '
Sub WebDebugLog(AParameter)
Dim NL
NL = Chr(13) & Chr(10)
If Application("WebDebugLogType") = "" Then Exit Sub
Dim LBody, LName, LKeyName, i
LBody = ""
LBody = LBody & "----------------" & NL
LBody = LBody & "Server Date/Time" & NL
LBody = LBody & "----------------" & NL
LBody = LBody & Now & NL
LBody = LBody & NL
LBody = LBody & "------------------------" & NL
LBody = LBody & "Parameter to WebDebugLog" & NL
LBody = LBody & "------------------------" & NL
LBody = LBody & AParameter & NL
LBody = LBody & NL
LBody = LBody & "----------------------" & NL
LBody = LBody & "QueryString Collection" & NL
LBody = LBody & "----------------------" & NL
For Each LName in Request.QueryString
LBody = LBody & LName & " = " & Request.QueryString(LName) & NL
Next
LBody = LBody & NL
LBody = LBody & "---------------" & NL
LBody = LBody & "Form Collection" & NL
LBody = LBody & "---------------" & NL
For Each LName in Request.Form
LBody = LBody & LName & " = " & Request.Form(LName) & NL
Next
LBody = LBody & NL
LBody = LBody & "------------------" & NL
LBody = LBody & "Cookies Collection" & NL
LBody = LBody & "------------------" & NL
For Each LName in Request.Cookies
If Request.Cookies(LName).HasKeys Then 'cookies with keys '
For Each LKeyName in Request.Cookies(LName)
LBody = LBody & LName & "(" & LKeyName & ")" & " = " & Request.Cookies(LName)(LKeyName) & NL
Next
Else ' normal cookies '
LBody = LBody & LName & " = " & Request.Cookies(LName) & NL
End If
Next
LBody = LBody & NL
LBody = LBody & "-----------------" & NL
LBody = LBody & "Session Variables" & NL
LBody = LBody & "-----------------" & NL
For Each LName in Session.Contents
If IsArray(Session(LName)) Then
For i = LBound(Session(LName)) To UBound(Session(LName))
LBody = LBody & LName & "(" & i & ")" & " = " & Session(LName)(i) & NL
Next
Else
LBody = LBody & LName & " = " & Session.Contents(LName) & NL
End If
Next
LBody = LBody & NL
LBody = LBody & "----------------------" & NL
LBody = LBody & "Session Static Objects" & NL
LBody = LBody & "----------------------" & NL
For Each LName in Session.StaticObjects
LBody = LBody & LName & " = " & LName & NL
Next
LBody = LBody & NL
LBody = LBody & "---------------------" & NL
LBody = LBody & "Application Variables" & NL
LBody = LBody & "---------------------" & NL
For Each LName in Application.Contents
If IsArray(Application(LName)) Then
For i = LBound(Application(LName)) To UBound(Application(LName))
LBody = LBody & LName & "(" & i & ")" & " = " & Application(LName)(i) & NL
Next
Else
LBody = LBody & LName & " = " & Application.Contents(LName) & NL
End If
Next
LBody = LBody & NL
LBody = LBody & "--------------------------" & NL
LBody = LBody & "Application Static Objects" & NL
LBody = LBody & "--------------------------" & NL
For Each LName in Application.StaticObjects
LBody = LBody & LName & " = " & LName & NL
Next
LBody = LBody & NL
LBody = LBody & "----------------" & NL
LBody = LBody & "Server Variables" & NL
LBody = LBody & "----------------" & NL
For Each LName in Request.ServerVariables
LBody = LBody & LName & " - " & Request.ServerVariables(LName) & NL
Next
LBody = LBody & NL
If Application("WebDebugLogType") = "File" Or Application("WebDebugLogType") = "Both" Then
WriteToFile "logs/webdebug.txt", "***** START *****" & NL & NL & LBody & NL & "***** END *****" & NL & NL & NL
End If
If Application("WebDebugLogType") = "Email" Or Application("WebDebugLogType") = "Both" Then
If Application("WebDebugLogEmail") <> "" Then
SendEmail Application("WebDebugLogEmail"), "", Application("WebDebugLogEmail"), "Web Debug Log", LBody, ""
End If
End If
End Sub
' (SS,29/9/04) writes given text to given file name '
' if file exists it is appended to else a new file created '
' there must be modify and write access for Internet Guest account to this file or folder '
Sub WriteToFile(AFileName, LText)
Const ForAppending = 8
Application.Lock
Dim LobjOpenFile, LobjFSO, LstrPath
LstrPath = Server.MapPath(AFileName)
Set LobjFSO = Server.CreateObject("Scripting.FileSystemObject")
If LobjFSO.FileExists(LstrPath) Then
Set LobjOpenFile = LobjFSO.OpenTextFile(LstrPath, ForAppending)
Else
Set LobjOpenFile = LobjFSO.CreateTextFile(LstrPath)
End If
LobjOpenFile.Write LText
LobjOpenFile.Close
Set LobjOpenFile = Nothing
Set LobjFSO = Nothing
Application.UnLock
End Sub
Function GetVATRate
' (SS,14/9/06) added If FChargeVAT
If FChargeVAT Then
' (SS,27/7/09) replaced GetAppSetting with GetSetting
GetVATRate = CDbl(GetSetting("Application", "VATRate"))
Else
GetVATRate = 0
End If
End Function
' (SS,15/9/06)
Function GetIncVATAmount(AExcVATAmount)
GetIncVATAmount = CDbl(FormatNumber(CDbl(AExcVATAmount) * (1 + GetVATRate), 2))
End Function
Function GetExcVATAmount(AIncVATAmount)
GetExcVATAmount = CDbl(FormatNumber(CDbl(AIncVATAmount) * (1 / (1 + GetVATRate)), 2))
End Function
' (SS,14/7/05) returns x letter password with letters betten "A" and "Z" in uppercase '
Function GetRandomPassword(ANoOfLetters)
Dim i, LPassword
Const ALLOWED_LETTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Randomize
LPassword = ""
For i = 1 To ANoOfLetters
LPassword = LPassword + Mid(ALLOWED_LETTERS, Int(Rnd * Len(ALLOWED_LETTERS)) + 1, 1)
Next
GetRandomPassword = LPassword
End Function
' (SS,1/9/06)
Function GetRegistrationFormLink(AIsNew)
Dim LDelegateDirectLink, LLink
'If FDirectDelegateLink Then
' LDelegateDirectLink = "did=" & Request("did") & "&pw=" & Request("pw")
'End If
' LLink = Iif(LDelegateDirectLink = "", "?", "&") + "id=" + Request("id") + "&page=" + Request("page") + "&cmd=form"
' (SS,2/12/06) replaced above with following
LLink = "?" + "id=" + (FConferenceID) + "&page=registration" + "&cmd=form"
If AIsNew Then LLink = LLink + "&new=true"
GetRegistrationFormLink = ConvertURLToHTML("index.asp" + LLink) ' (SS,15/12/06) added ConvertURLToHTML
End Function
' (SS,15/9/06)
Function GetContactFormLink
GetContactFormLink = "index.asp?id=" + Request("id") + "&page=" + Request("page")
End Function
' (SS,1/9/06)
Function GetConferenceField(AFieldName)
OpenQuery("SELECT " + AFieldName + " FROM conferences WHERE ConferenceID = '" + FConferenceID + "'")
If Not EndOfQuery Then
GetConferenceField = GetQueryValue(AFieldName)
Else
GetConferenceField = ""
End If
CloseQuery
End Function
' (SS,1/9/06)
Function GetPaymentMethod
GetPaymentMethod = GetConferenceField("PaymentMethod")
End Function
' (SS,1/9/06)
Function PayPalAllowed
PayPalAllowed = GetPaymentMethod = PM_PAYPAL
End Function
' (SS,1/9/06)
Function GetBookingReferenceFrom(ARefNoPrefix, AVenueID, ADelegateID)
Dim LRefPrefix
LRefPrefix = Trim(ARefNoPrefix)
If LRefPrefix = "" Then LRefPrefix = AVenueID ' if no ref prefix then use VenueID
GetBookingReferenceFrom = LRefPrefix & ADelegateID
End Function
' (SS,1/9/06)
Function GetBookingReference
GetBookingReference = GetBookingReferenceFrom(GetConferenceField("RefNoPrefix"), FVenueID, FDelegateID)
End Function
' (SS,1/9/06) modified version from shopping
Sub SetUpPayPalForm
Dim LBusiness, LReturnURL, LCancelURL, LDescription, LAmount, LCurrency, LInvoiceNo
Dim LEmail, LFirstName, LLastName, LAddress1, LAddress2, LCity, LCounty, LPostcode, LCountry
LBusiness = Application("PayPalBusiness")
LReturnURL = Application("SiteURL") + "/" + GetRegistrationFormLink(False) + "&pm=pp"
LCancelURL = Application("SiteURL") + "/" + GetRegistrationFormLink(False) + "&pm=ppc"
LDescription = Left("Conference Registration Fee (Ref: " + Session("t_Reference") + " - " + Session("t_FullName") + ")", 127) ' can be 127 chars long
LAmount = Session("t_AmountChargedIncVAT")
LCurrency = "GBP"
LInvoiceNo = Session("t_DelegateID")
LEmail = Left(Session("t_Email"), 127)
LFirstName = Left(Session("t_FirstName"), 32)
LLastName = Left(Session("t_Surname"), 64)
LAddress1 = Left(Session("t_AddressLine1"), 100)
LAddress2 = Left(Session("t_AddressLine2"), 100)
LCity = Left(Session("t_Town"), 40)
LCounty = Left(Session("t_County"), 32)
LPostcode = Left(Session("t_Postcode"), 32)
LCountry = GetCountyISOCode(Session("t_Country"))
Dim LActionURLPrefix
If Application("PayPalTestMode") Then
LActionURLPrefix = "https://www.sandbox.paypal.com"
Else
LActionURLPrefix = "https://www.paypal.com"
End If
%>
<form name = "frmPayPal" action="<%=LActionURLPrefix%>/cgi-bin/webscr" method="post" class="nospace">
<input type="hidden" name="cmd" value="_xclick">
<input type="hidden" name="business" value="<%=LBusiness%>">
<input type="hidden" name="return" value="<%=LReturnURL%>">
<input type="hidden" name="item_name" value="<%=LDescription%>">
<input type="hidden" name="amount" value="<%=LAmount%>">
<input type="hidden" name="invoice" value="<%=LInvoiceNo%>">
<input type="hidden" name="custom" value="<%=Session.SessionID%>">
<input type="hidden" name="currency_code" value="<%=LCurrency%>">
<input type="hidden" name="no_shipping" value="1">
<input type="hidden" name="cancel_return" value="<%=LCancelURL%>">
<input type="hidden" name="no_note" value="1">
<input type="hidden" name="rm" value="2">
<input type="hidden" name="email" value="<%=LEmail%>">
<input type="hidden" name="first_name" value="<%=LFirstName%>">
<input type="hidden" name="last_name" value="<%=LLastName%>">
<input type="hidden" name="address1" value="<%=LAddress1%>">
<input type="hidden" name="address2" value="<%=LAddress2%>">
<input type="hidden" name="city" value="<%=LCity%>">
<input type="hidden" name="state" value="<%=LCounty%>">
<input type="hidden" name="zip" value="<%=LPostcode%>">
<input type="hidden" name="country" value="<%=LCountry%>">
</form>
<%
End Sub
' (SS,1/9/06)
Function GetCountyISOCode(ACountry)
GetCountyISOCode = ""
OpenQuery("SELECT * FROM Countries WHERE Country = '" + ACountry + "'")
If Not EndOfQuery Then
GetCountyISOCode = GetFieldValue("CodeA2")
End If
CloseQuery
End Function
' (SS,1/9/06) returns filter criteria to use for country combo
Function GetCriteriaForCountryCombo
GetCriteriaForCountryCombo = "Enabled='Yes'"
End Function
' this routine gets called by paypal-callback.asp which is normally call '
' by PayPal callback when payment has been made '
Sub ProcessPayPalCallback()
Dim LSQL, LOrderNo, LSessionID, Lbusiness, Lfirst_name, Llast_name
Dim Lpayment_date, Lpayment_gross, Lpayment_type, Lpayment_status, Lpayment_fee, Litem_name
Dim Litem_number, Ltest_ipn, Lquantity, Lmc_currency, Lmc_gross, Lmc_fee, Lshipping
Dim Ltax, Lpayer_status, Lpayer_email, Lpayer_id, Lreceiver_id, Lreceiver_email
Dim Ltxn_type, Ltxn_id, Lverify_sign, Lcharset, Lnotify_version
' get values from query forms etc (passed on values) '
LOrderNo = CleanSQLStr(Request.Form("invoice"))
LSessionID = CleanSQLStr(Request.Form("custom"))
If LOrderNo = "" Or LSessionID = "" Then
Response.Write("<br><br>Both Order No and Session ID must be specified.<br>")
Exit Sub
End If
' PayPal values '
Lbusiness = CleanSQLStr(Request.Form("business"))
Lfirst_name = CleanSQLStr(Request.Form("first_name"))
Llast_name = CleanSQLStr(Request.Form("last_name"))
Lpayment_date = CleanSQLStr(Request.Form("payment_date"))
Lpayment_gross = CleanSQLStr(Request.Form("payment_gross"))
Lpayment_type = CleanSQLStr(Request.Form("payment_type"))
Lpayment_status = CleanSQLStr(Request.Form("payment_status"))
Lpayment_fee = CleanSQLStr(Request.Form("payment_fee"))
Litem_name = CleanSQLStr(Request.Form("item_name"))
Litem_number = CleanSQLStr(Request.Form("item_number"))
Ltest_ipn = CleanSQLStr(Request.Form("test_ipn"))
Lquantity = CleanSQLStr(Request.Form("quantity"))
Lmc_currency = CleanSQLStr(Request.Form("mc_currency"))
Lmc_gross = CleanSQLStr(Request.Form("mc_gross"))
Lmc_fee = CleanSQLStr(Request.Form("mc_fee"))
Lshipping = CleanSQLStr(Request.Form("shipping"))
Ltax = CleanSQLStr(Request.Form("tax"))
Lpayer_status = CleanSQLStr(Request.Form("payer_status"))
Lpayer_email = CleanSQLStr(Request.Form("payer_email"))
Lpayer_id = CleanSQLStr(Request.Form("payer_id"))
Lreceiver_id = CleanSQLStr(Request.Form("receiver_id"))
Lreceiver_email = CleanSQLStr(Request.Form("receiver_email"))
Ltxn_type = CleanSQLStr(Request.Form("txn_type"))
Ltxn_id = CleanSQLStr(Request.Form("txn_id"))
Lverify_sign = CleanSQLStr(Request.Form("verify_sign"))
Lcharset = CleanSQLStr(Request.Form("charset"))
Lnotify_version = CleanSQLStr(Request.Form("notify_version"))
' insert the record '
LSQL = "INSERT INTO paypalcallbacks SET OrderNo=" & LOrderNo &_
", SessionID='" & LSessionID & "'" &_
", business='" & Lbusiness & "'" &_
", first_name='" & Lfirst_name & "'" &_
", last_name='" & Llast_name & "'" &_
", payment_date='" & Lpayment_date & "'" &_
", payment_gross='" & Lpayment_gross & "'" &_
", payment_type='" & Lpayment_type & "'" &_
", payment_status='" & Lpayment_status & "'" &_
", payment_fee='" & Lpayment_fee & "'" &_
", item_name='" & Litem_name & "'" &_
", item_number='" & Litem_number & "'" &_
", test_ipn='" & Ltest_ipn & "'" &_
", quantity='" & Lquantity & "'" &_
", mc_currency='" & Lmc_currency & "'" &_
", mc_gross='" & Lmc_gross & "'" &_
", mc_fee='" & Lmc_fee & "'" &_
", shipping='" & Lshipping & "'" &_
", tax='" & Ltax & "'" &_
", payer_status='" & Lpayer_status & "'" &_
", payer_email='" & Lpayer_email & "'" &_
", payer_id='" & Lpayer_id & "'" &_
", receiver_id='" & Lreceiver_id & "'" &_
", receiver_email='" & Lreceiver_email & "'" &_
", txn_type='" & Ltxn_type & "'" &_
", txn_id='" & Ltxn_id & "'" &_
", verify_sign='" & Lverify_sign & "'" &_
", charset='" & Lcharset & "'" &_
", notify_version='" & Lnotify_version & "'"
ExecuteQuery(LSQL)
' if paid then mark the order as paid and send email
If Lpayment_status = "Completed" And LOrderNo <> "" Then
' following will update the status, send email and empty basket
ProcessOrderThirdPartyPayment True, LOrderNo, LSessionID, Ltxn_id
End If
End Sub
' (SS,1/9/06) called from PayPal auto return browser link and PayPal IPN callback'
Sub ProcessOrderThirdPartyPayment(AFromCallback, AOrderNo, ASessionID, APaymentRef)
If AOrderNo <> "" Then
' if payment hasn't already been processed
If Not CheckPaymentReceived(AOrderNo) Then
Dim LPaymentRef
LPaymentRef = APaymentRef
' if no payment ref defined then create one
If LPaymentRef = "" Then LPaymentRef = "BRWRTN-" & ASessionID ' BRWRTN stands for browser return
UpdateOrderStatusForOrderPlaced AOrderNo, STATUS_PAID, "PayPal", LPaymentRef
SendEmailPayPalReceipt(AOrderNo)
End If
' show thank if from customer's browser (not callback from ThirdParty payment server)
' (SS,1/9/06) following not used here
' If Not AFromCallback Then ShowOrderThankYou AOrderNo, Application("CompanyName")
End If
End Sub
' (SS,1/9/06)
Sub UpdateOrderStatusForOrderPlaced(AOrderNo, AStatus, APaymentMethod, APaymentReference)
' set the status and date on the order record (only if it's not Paid, this prevents a second callback from overwriting the same record, in case user goes back and makes another payment)
ExecuteQuery("UPDATE delegates SET Status='" & AStatus & "', DateBanked=CURDATE(), PaymentMethod='" + APaymentMethod + "', PaymentReference='" + APaymentReference + "' WHERE DelegateID = " & AOrderNo & " AND Status <> '" & STATUS_PAID & "'")
End Sub
' (SS,1/9/06) returns true if payment already made for given order, or order completed
Function CheckPaymentReceived(AOrderNo)
OpenQuery("SELECT COUNT(*) AS RecCount FROM delegates WHERE DelegateID=" & AOrderNo & " AND Status='" & STATUS_PAID & "'")
CheckPaymentReceived = GetQueryValue("RecCount") > 0
CloseQuery
End Function
' (SS,9/11/06)
Function GetDelegateIsAttending
GetDelegateIsAttending = Not BookingFieldAllowed(BF_ATTENDANCE_CONFIRMATION) Or strAttendanceConfirmation <> "No"
End Function
%>