<%
' global constants and variables '

' main variables '
Dim strCommand, strExtraCommand, strSearch, strPageName, strID

Initialise

' (SS,13/8/04) runs code to be run before all templates '
Sub Initialise
  ' do the delete or buy first from shopping status '
  ' done this way to stay on same page '
  Session("PreloadImageList") = ""
  strPageName = LCase(Request.QueryString("page"))
  strID = Request.QueryString("id")
  strCommand = Request.QueryString("cmd")
  strExtraCommand = Request.QueryString("xcmd")
  If strCommand = "" Then strCommand = Request.Form("cmd")
  If strCommand = "shortlist" Then
    AddToShortList strID
    strPagename = "properties"
    If strExtraCommand <> "details" Then strID = ""
  ElseIf strCommand = "deleteshortlist" Then
    RemoveFromShortList strID
    strPagename = "properties"
    strID = ""
    If strExtraCommand = "shortlist" Then strPagename = "shortlist"
  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,24/5/04) now uses template instead of separate contact.asp amd contact-email.asp pages '
Sub DoContactForm
  Dim LErrorMessage, LShowContactForm
  LErrorMessage = ""

  LShowContactForm = True
  ShowContactHeader
  ' if previously tried to post form then check telephone and email address entered'
  If Request.Form("postform") = "yes" Then
    If (Request.Form("Name") = "") Or (Request.Form("Email") = "" And Request.Form("Telephone") = "") Then
      LErrorMessage = "Please enter your Name and either your email address or telephone."
    Else
      ShowContactThankYou
      LShowContactForm = False
      ' add enquiry to contact database '

      OpenDatabase
      Dim LShortlist
      LShortlist = GetShortlistLinks
      EmptyShortlist
      CloseDatabase ' because it is opened and closed by AddContactToDatabaseAndEmail '

      AddContactToDatabaseAndEmail "Contact", "Name, Address, Postcode, Telephone, Email", "DOB, Smoker, Car Owner, Full Time Employment, Property Type House, Property Type Apartment, Property Type Studio, Property Type Room, Preference, Date Required, Enquiry", LShortlist, True
    End If
  End If
  If LShowContactForm Then ShowContactForm(LErrorMessage)
  ShowContactFooter
End Sub


' 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 = ""

  OpenDatabase
  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
  CloseDatabase

  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")

  '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 '
Sub SendEmail(AEmailAddress, ASubject, ABody)
  ' send the email using Dundas Mailer Control
  Dim objEmail 'Mailer control
  Set objEmail = Server.CreateObject("Dundas.Mailer")

  objEmail.SMTPRelayServers.Add Application("MailServer")

  'set Mailer control properties and collection items
  objEmail.TOs.Add AEmailAddress
  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

Sub DoSpecialOffers
  DoSpecialOffersOrNews("Special Offer")
End Sub

Sub DoNews
  DoSpecialOffersOrNews("News")
End Sub

Sub DoSpecialOffersOrNews(AType)
  Dim LSQL, LPrevMonth, LMonth, LCount
  Dim LRow1or2, LName, LArea, LDescription
  OpenDatabase
  LSQL = "SELECT *, DATE_FORMAT(Date,'%M %Y') AS Month" &_
    " FROM specialoffersnews" &_
    " WHERE Type = '" + AType + "' AND ShowOnWeb <> 0" &_
    " ORDER BY Date, Name, ID"
  OpenQuery(LSQL)

  If Not EndOfQuery Then
    LCount = 0
    LPrevMonth = ""
    Do While Not EndOfQuery
      LMonth = GetQueryValue("Month")
      If LMonth <> LPrevMonth Then
        LCount = 0
        If LPrevMonth <> "" Then ShowSpecialOffersMonthFooter
        ShowSpecialOffersMonthHeader(LMonth)
      End If
      LPrevMonth = LMonth

      LRow1or2 = (LCount Mod 2) + 1
      LName = GetQueryValue("Name")
      LArea = GetQueryValue("Area")
      LDescription = ConvertNewlinesToHTML(GetQueryValue("Description"))

      ShowSpecialOffersItem LRow1or2, LName, LArea, LDescription

      LCount = LCount + 1
      NextQueryRecord
    Loop
    ShowSpecialOffersMonthFooter
  End If

  CloseQuery

  CloseDatabase
End Sub

' (SS,21/1/05) kept following in case it's reinstated
Sub DoSpecialOffersListOldVersion
  Dim LCount
  OpenDatabase

  OpenQuery("SELECT COUNT(*) AS Count FROM specialoffersnews WHERE ShowOnWeb <> 0 AND Type = 'Special Offer'")
  LCount = GetQueryValue("Count")
  CloseQuery

  If LCount > 0 Then
    ShowSpecialOffersListHeader
    Dim LRandom, LDone, LUsed
    LDone = 0
    LUsed = ","
    Do
      LRandom = GetRandomInteger(0, LCount - 1)
      If Instr(LUsed, "," & LRandom & ",") = 0 Then
        OpenQuery("SELECT *, DATE_FORMAT(Date,'%M %Y') AS Month FROM specialoffersnews WHERE ShowOnWeb <> 0 AND Type = 'Special Offer' ORDER BY ID LIMIT " & LRandom & ",1")
        If Not EndOfQuery Then
          ShowSpecialOffersListItem GetQueryValue("ID"), GetQueryValue("Month"), GetQueryValue("Name"), GetQueryValue("Area")
        End If
        CloseQuery
        LUsed = LUsed & LRandom & ","
        LDone = LDone + 1
      End If
    Loop Until (LDone >= Application("MaxSpecialOffers")) Or (LDone >= LCount)
    ShowSpecialOffersListFooter
  End If

  CloseDatabase
End Sub

Sub DoSpecialOffersList
  Dim LCount
  OpenDatabase

  OpenQuery("SELECT COUNT(*) AS Count FROM specialoffersnews WHERE ShowOnWeb <> 0 AND Type = 'Special Offer'")
  LCount = GetQueryValue("Count")
  CloseQuery

  If LCount > 0 Then
    ShowSpecialOffersListHeader
    ' GROUP BY not used because get "Month" returns ????? possible a bug in ODBC driver '
    OpenQuery("SELECT DATE_FORMAT(Date,'%M %Y') AS Month FROM specialoffersnews WHERE ShowOnWeb <> 0 AND Type = 'Special Offer' ORDER BY Date")

    Dim LPrevMonth, LMonth
    LPrevMonth = ""
    Do While Not EndOfQuery
      LMonth = GetQueryValue("Month")
      If LPrevMonth <> LMonth Then
        ShowSpecialOffersListItem LMonth
      End If
      LPrevMonth = LMonth
      NextQueryRecord
    Loop

    CloseQuery

    ShowSpecialOffersListFooter
  End If

  CloseDatabase
End Sub

Sub DoFeedback
  Dim LCount
  OpenDatabase

  OpenQuery("SELECT COUNT(*) AS Count FROM feedback WHERE ShowOnWeb <> 0 AND AgreeToPublish <> 0 AND CommentsForWeb <> ''")
  LCount = GetQueryValue("Count")
  CloseQuery

  If LCount > 0 Then
    Dim LRandom
    LRandom = GetRandomInteger(0, LCount - 1)
    OpenQuery("SELECT * FROM feedback WHERE ShowOnWeb <> 0 And CommentsForWeb <> '' LIMIT " & LRandom & ",1")
    If Not EndOfQuery Then
      ShowFeedback GetQueryValue("Name"), GetQueryValue("JobTitle"), GetQueryValue("Organisation"), ConvertNewlinesToHTML(GetQueryValue("CommentsForWeb"))
    End If
    CloseQuery
  End If

  CloseDatabase
End Sub

Sub DoPricingMenu
  ShowPricingMenuHeader

  Dim LSQL, LPrevArea, LArea, LCount
  Dim LRow1or2, LService
  OpenDatabase
  LSQL = "SELECT *" &_
    " FROM pricingschedule" &_
    " ORDER BY SortOrder, ID"
  OpenQuery(LSQL)

  If Not EndOfQuery Then
    LCount = 1
    LPrevArea = ""
    Do While Not EndOfQuery
      LArea = GetQueryValue("Area")
      If LArea <> LPrevArea And LArea <> "" Then
        LCount = LCount + 1
      End If
      LPrevArea = LArea

      LRow1or2 = (LCount Mod 2) + 1
      LArea = ConvertNewlinesToHTML(GetQueryValue("Area"))
      ' <ind> special token developed by SS & SKB for indenting (c)(tm)21/1/05 '
      LService = Replace(ConvertNewlinesToHTML(GetQueryValue("Service")), "<ind>", "&nbsp;&nbsp;&nbsp;")

      ShowPricingMenuItem LRow1or2, LArea, LService, GetQueryValue("Cost"), GetQueryValue("Fee")

      NextQueryRecord
    Loop
    ShowSpecialOffersMonthFooter
  End If

  CloseQuery
  CloseDatabase

  ShowPricingMenuFooter
End Sub

Function GetFeedbackValue(AFeedbackValue)
  If AFeedbackValue = "" Then
    GetFeedbackValue = "Not Chosen"
  Else
    GetFeedbackValue = AFeedbackValue
  End If
End Function

Sub SaveFeedback
  OpenDatabase
  OpenTable "feedback"
  AddRecord

  PutFieldValue "DateTimeFeedback", Now
  PutFieldValue "Name", Request.Form("Name")
  PutFieldValue "JobTitle", Request.Form("JobTitle")
  PutFieldValue "Organisation", Request.Form("Organisation")
  PutFieldValue "Address", Request.Form("Address")
  PutFieldValue "Telephone", Request.Form("Telephone")
  PutFieldValue "Email", Request.Form("Email")
  PutFieldValue "Comments", Request.Form("Comments")
  PutFieldValue "CommentsForWeb", Request.Form("Comments")
  PutFieldValue "SuggestionsForImprovement", Request.Form("Suggestions")
  PutFieldValue "AgreeToPublish", Iif(Request.Form("AgreeToPublish") = "yes", 1, 0)

  PutFieldValue "SpeedCallsAnswered", GetFeedbackValue(Request.Form("SpeedofCalls"))
  PutFieldValue "Courtesy", GetFeedbackValue(Request.Form("Courtesy"))
  PutFieldValue "SpeedVenuesLocated", GetFeedbackValue(Request.Form("SpeedVenues"))
  PutFieldValue "QualityPresentation", GetFeedbackValue(Request.Form("Presentation"))
  PutFieldValue "VenueKnowledge", GetFeedbackValue(Request.Form("VenueKnowledge"))
  PutFieldValue "NoVenuesOffered", GetFeedbackValue(Request.Form("NoVenues"))
  PutFieldValue "HowWellMatchedVenues", GetFeedbackValue(Request.Form("MatchedVenues"))
  PutFieldValue "OverallImpressionOfCSL", GetFeedbackValue(Request.Form("Overall"))

  PostRecord
  CloseTable
  CloseDatabase

  SendContactEmail "HBOS Feedback Form", "A new feedback has been received. " & Chr(13) + Chr(10) & "To view, see the CSL HBOS Admin database."
End Sub

' (SS,20/1/05) returns random integer between given two numbers inclusive '
Function GetRandomInteger(ALowerBound, AUpperbound)
  Randomize
  GetRandomInteger = Int((AUpperbound - ALowerBound + 1) * Rnd + ALowerBound)
End Function

%>