File: D:/web/secure/csl/bam/commonutils.asp
<%
' (SS,5/12/14) new common utils used by both front and back ends, to be placed after dbfunctions.asp
'DebugOn ' ***
'SetDebugLevel 2 ' ***
Const ENCRYPTION_PASSWORD = "bam123" ' (SS,4/12/14)
Const ENCRYPTION_SALT = "srMubgRxx9l8eh8nizpS" ' (SS,5/12/14)
Dim MAX_ROOMS ' (SS,4/12/14) was a constant, now a variable setting in settings, kept the name the same
' (SS,7/12/14) email types
Const ET_BOOKING = 1
Const ET_AMENDMENT = 2
Const ET_CONFIRMATION = 3
Dim gsFocusForm, gsFocusField ' (SS,7/12/14)
Initialise
' (SS,7/12/14)
Sub Initialise
OpenDatabase
GetSettings
MaintainCreditCardYears
' default focus field to no field
gsFocusForm = ""
gsFocusField = ""
End Sub
' (SS,7/12/14)
Sub Finalise
CloseDatabase
SetFocusField gsFocusForm, gsFocusField
End Sub
' (SS,7/12/14) sets the focus field in Javascript, relies on relies on function uSetFocus() and globals itp_focus_form and itp_focus_field already be defined
Sub SetFocusField(AForm, AField)
If AForm <> "" And AField <> "" Then
%>
<script>
var itp_focus_form = "<%=AForm%>";
var itp_focus_field = "<%=AField%>";
</script>
<%
End If
End Sub
Sub GetSettings
Application("BookingNoPrefix") = GetSetting("BookingNoPrefix")
Application("ConferenceName") = GetSetting("ConferenceName")
Application("Subtitle1") = GetSetting("Subtitle1")
Application("Subtitle2") = GetSetting("Subtitle2")
Application("Subtitle3") = GetSetting("Subtitle3")
Application("AvailabilityMessage") = GetSetting("AvailabilityMessage")
Application("RoomRateMessage") = GetSetting("RoomRateMessage")
Application("SpecialRequirementsMessage") = GetSetting("SpecialRequirementsMessage")
Application("CancellationMessage") = GetSetting("CancellationMessage")
Application("Currency") = GetSetting("CurrencyCode")
Application("TotalCostSuffix") = GetSetting("TotalCostSuffix") ' " + 14.4% TAX" ' (SS,18/4/14)
MAX_ROOMS = CInt(GetSetting("MaxRoomsPerBooking"))
Application("OrganisationLabel") = GetSetting("OrganisationLabel")
If Application("OrganisationLabel") = "" Then Application("OrganisationLabel") = "Organisation"
Application("OrganisationRequired") = GetSetting("OrganisationRequired") = "Yes"
Application("AddressEnabled") = GetSetting("AddressEnabled") = "Yes"
Application("CreditCardEnabled") = GetSetting("CreditCardEnabled") = "Yes"
Application("SiteClosed") = GetSetting("SiteClosed") = "Yes"
Application("FromEmailAddress") = "events@conferencesearch.co.uk" ' (SS,14/1/14) was ruth@, then bam@, back to ruth@ ' (SS,22/10/15) from bam@ to events@
Application("BCCEmailAddress1") = "bam@itpartnership.com" ' (SS,9/1/14) changed from surinder@ to bam@
Application("BCCEmailAddress2") = "events@conferencesearch.co.uk" ' (SS,14/1/14) was ruth@ ' (SS,22/10/15) from bam@ to events@
End Sub
' (SS,5/12/14) gets setting from settings table which has one record
Function GetSetting(ASettingName)
GetSetting = GetSQLValueAsString("SELECT " & ASettingName & " FROM settings WHERE ID = 1")
End Function
' (SS,7/12/14) make sure years exist only from this year and 20 years from now, only update if earliest record is less than current year
Sub MaintainCreditCardYears
Dim i, LCurrentYear
LCurrentYear = CInt(Right(CStr(Year(Now)), 2)) ' right 2 digits
If GetSQLRecordExists("SELECT * FROM l_creditcardyears WHERE Year < " & LCurrentYear) Then
ExecuteQuery "TRUNCATE l_creditcardyears"
For i = 0 To 20
ExecuteQuery "INSERT INTO l_creditcardyears SET Year = " & LCurrentYear + i
Next
' add years that are smaller than current and already entered into bookings table
ExecuteQuery "INSERT INTO l_creditcardyears SELECT ExpiryYear FROM bookings WHERE NOT ISNULL(ExpiryYear) AND ExpiryYear < " & LCurrentYear & " GROUP BY ExpiryYear"
End If
End Sub
' (SS,4/12/14)
Function GetSQLCreditCardNoEncrypt(ACreditCardNo)
GetSQLCreditCardNoEncrypt = "CreditCardNo = HEX(AES_ENCRYPT('" & CleanSQLStr(strCreditCardNo) & "', CONCAT('" & CleanSQLStr(ENCRYPTION_PASSWORD + ENCRYPTION_SALT) & "', BookingNo)))"
End Function
' (SS,4/12/14)
Function GetSQLCreditCardNoDecrypt
GetSQLCreditCardNoDecrypt = "CAST(AES_DECRYPT(UNHEX(CreditCardNo), CONCAT('" & CleanSQLStr(ENCRYPTION_PASSWORD + ENCRYPTION_SALT) & "', BookingNo)) AS CHAR) AS CreditCardNoDecrypted"
End Function
' (SS,4/12/14) delete all bookings ready for new BAM, Truncate is used so that Autoinc starts from 1.
Sub DeleteAllBookings
ExecuteQuery("TRUNCATE bookingnights")
ExecuteQuery("TRUNCATE bookingrooms")
ExecuteQuery("TRUNCATE bookings")
End Sub
' (SS,6/12/14)
Function GetHotelNameForID(AHotelID)
GetHotelNameForID = GetSQLValueAsString("SELECT HotelName FROM Hotels WHERE HotelID = '" & CleanSQLStr(AHotelID) & "'")
End Function
' ===============
' Following 3 routines GetAccessRights, GetAccessLevel and ChangePassword moved here, might not be used
' Definitely not used, but now used by latest BAM which now uses MySQL
' (SS,15/10/01) get access rights
Function GetAccessRights(AUserID, APassword)
GetAccessRights = "" ' default to no access rights
' (SS,6/12/14) added SHA1 and salt
OpenQuery("SELECT * FROM Users WHERE UserID = '" + CleanSQLStr(AUserID) + "' AND Password = SHA1('" + CleanSQLStr(ENCRYPTION_SALT + ":" + APassword) + "')")
If Not EndOfQuery Then
GetAccessRights = GetQueryValue("Rights")
End If
CloseQuery
End Function
' (SS,15/10/01) get access rights
Function GetAccessLevel(AAccessRights)
GetAccessLevel = 0 ' default to minimum access level
OpenQuery("SELECT * FROM Rights WHERE Rights = '" + CleanSQLStr(AAccessRights) + "'")
If Not EndOfQuery Then
GetAccessLevel = GetQueryValue("AccessLevel")
End If
CloseQuery
End Function
' (SS,25/10/01) change password
' (SS,6/12/14) improved to store SHA1 with salt
Function ChangePassword(AUserID, APassword, ANewPassword)
If GetSQLRecordExists("SELECT * FROM Users WHERE UserID = '" + CleanSQLStr(AUserID) + "' AND Password = SHA1('" + CleanSQLStr(ENCRYPTION_SALT + ":" + APassword) + "')") Then
ExecuteQuery "UPDATE users SET Password = SHA1('" + CleanSQLStr(ENCRYPTION_SALT + ":" + ANewPassword) + "') WHERE UserID = '" + CleanSQLStr(AUserID) + "'"
ChangePassword = True
Else
ChangePassword = False ' default to not successful
End If
End Function
' ===============
' (SS,1/5/03) new function which allows form field name to be different
' same as GetLookupCombo above but added new AFormFieldName parameter
' alse changed AShowBlank from boolean to string "" and "Blank" are special values
' added Value =
' (SS,29/11/14) added following from dbfunction.asp in BAM, might be useful elsewhere, and also because this dbfunctions.asp is used in latest BAM
' (SS,6/12/14) added AOptionValueFieldName, this can can be blank to assume same as AFieldName, otherwise it's a field from which option value is taken e.g. and ID and showing the name
' (SS,30/4/15) added AWhereClause for filtering purposes
Function GetLookupComboDiffFormField(ATableName, AFieldName, AFormFieldName, AOrderField, ADefaultValue, AShowBlank, AOptionValueFieldName, AWhereClause)
Dim s, LDisplayValue, LOptionValue ' (SS,6/12/14) replaced strFieldValue with LDisplayValue, added LOptionValue
s = "<select name=""" + AFormFieldName + """>"
If AShowBlank <> "" Then
If AShowBlank = "Blank" Then AShowBlank = ""
If ADefaultValue = AShowBlank Then
s = s + "<option selected>" + AShowBlank + "</option>"
Else
s = s + "<option>" + AShowBlank + "</option>"
End If
End If
If AOrderField = "" Then AOrderField = AFieldName
' (SS,30/4/15) added AWhereClause
OpenQuery("SELECT * FROM " + ATableName + Iif(AWhereClause = "", "", " WHERE " + AWhereClause) + " ORDER BY " + AOrderField)
Do While Not EndOfQuery
LDisplayValue = GetQueryValue(AFieldName)
If AOptionValueFieldName = "" Then
LOptionValue = LDisplayValue
Else
LOptionValue = GetQueryValue(AOptionValueFieldName)
End If
' (SS,6/12/14) added CStr to convert types to string, to sort an issue when dates where the same but comparison was false
' (SS,8/12/14) added NB to prevent Invalid use of Null error, remove CStr because NB converts to string if not already a string
If NB(LOptionValue) = NB(ADefaultValue) Then
s = s + "<option value=""" & LOptionValue & """ selected>"
Else
s = s + "<option value=""" & LOptionValue & """>"
End If
's = s + strFieldValue + "</option>" + Chr(13) + Chr(10) ' Chr(13) + Chr(10) to made HTML more readable
' (SS,29/11/14) replaced above with following, i.e. + replaced with & to prevent type mismatch error or not a string type e.g. date
s = s & LDisplayValue & "</option>" + Chr(13) + Chr(10) ' Chr(13) + Chr(10) to made HTML more readable
NextQueryRecord
Loop
CloseQuery
s = s + "</select>"
GetLookupComboDiffFormField = s
End Function
' (SS,26/2/02) AType = "LOGONOFF", or "INVOICE"
' "OFF" is no longer used global.asa used instead
' (SS,3/12/14) moved here from BAM, rewritten fro MySQL using INSERT and UPDATE SQL commands
' may need to move to different include file, shouldn't really be in dbfunctions.asp
Sub RecordLog(AType, ANotes)
If (AType <> "LOGONOFF") OR (AType = "LOGONOFF" AND ANotes = "") Then
ExecuteQuery "INSERT INTO audit SET Type = '" & CleanSQLStr(AType) & "', TimeOn = NOW(), UserID = '" & Session("UserName") & "', SessionID = '" & Session.SessionID & "', Notes = '" & CleanSQLStr(ANotes) & "'"
End If
' if logonoff type then get the ID for use when user logs off
If AType = "LOGONOFF" Then
If ANotes = "" Then
Session("AuditID") = GetSQLLastInsertID
ElseIf Session("AuditID") <> "" Then
' following also appears in global.asa but doesn't always get called
ExecuteQuery "UPDATE audit SET TimeOff = NOW(), Length = TIMESTAMPDIFF(MINUTE, TimeOn, NOW()), EndType = '" & CleanSQLStr(Session("EndType")) & "' WHERE ID = '" & CleanSQLStr(Session("AuditID")) & "'"
End If
End If
End Sub
' (SS,7/12/14) moved here from apputils in main and admin (was repeated and different)
' added ABookingNo, replaced AConfirmation with AEmailType whih can be ET_BOOKING, ET_AMENDMENT or ET_CONFIRMATION
Sub EmailBooking(ABookingNo, AEmailType)
Dim NL
NL = Chr(13) + Chr(10)
Dim strBody
' (SS,7/12/14) added link to hotels to get hotel name
OpenQuery("SELECT * FROM bookings LEFT JOIN hotels ON hotels.HotelID = bookings.HotelID WHERE BookingNo = '" & CleanSQLStr(ABookingNo) & "'")
strBody =_
"IMPORTANT INFORMATION - PLEASE READ" & NL &_
"--------------------------" & NL &_
Application("ConferenceName") & NL &_
"--------------------------" & NL &_
"Accommodation Booking" & NL &_
"--------------------------" & NL &_
"" & NL
' (SS,29/8/03) added new confirmation feature
' (SS,7/12/14) AConfirmation with AEmailType, now handles 3 types
If AEmailType = ET_AMENDMENT Then
strBody = strBody &_
"Your booking has been amended." & NL &_
"Please check the following details:"
ElseIf AEmailType = ET_CONFIRMATION Then
strBody = strBody & Trim(GetSetting("EmailConfirmationHeader"))
Else ' ET_BOOKING
strBody = strBody &_
"Thank you for booking your accommodation online." & NL &_
"Please check the following details:"
End If
' (SS,16/2/17) removed spaces before the ":", due to looking untidy in plain text emails, i.e. when fixed width font not used in email client
strBody = strBody &_
"" & NL & NL &_
"----------------" & NL &_
"Personal Details" & NL &_
"----------------" & NL &_
"Title: " & GetQueryValue("Title") & NL &_
"First Name: " & GetQueryValue("FirstName") & NL &_
"Surname: " & GetQueryValue("Surname") & NL &_
Application("OrganisationLabel") & String(Max(0, 12 - Len(Application("OrganisationLabel"))), " ") & ": " & GetQueryValue("Organisation") & NL
' (SS,3/10/14) in above replaced "Organisation: " with Application("OrganisationLabel") & " : " etc
' (SS,3/2/17) replaced strOrganisation above with GetQueryValue("Organisation") to fix bug where it was blank for emails from Admin
' (SS,3/10/14) only show address details if address is enabled
If Application("AddressEnabled") Then
strBody = strBody &_
"Address 1: " & GetQueryValue("Address1") & NL &_
"Address 2: " & GetQueryValue("Address2") & NL &_
"Address 3: " & GetQueryValue("Address3") & NL &_
"Address 4: " & GetQueryValue("Address4") & NL &_
"Postcode/Zip: " & GetQueryValue("Postcode") & NL &_
"Country: " & GetQueryValue("Country") & NL
End If
strBody = strBody &_
"Telephone: " & GetQueryValue("Telephone") & NL &_
"Mobile: " & GetQueryValue("Mobile") & NL &_
"Email: " & GetQueryValue("Email") & NL &_
"" & NL
Dim LCancelled, LAmountToCharge, LEmailAddress, LHotelID, LHotelName
LCancelled = GetQueryValue("Cancelled")
LAmountToCharge = GetQueryValue("AmountToCharge")
LEmailAddress = GetQueryValue("Email")
LHotelID = GetQueryValue("HotelID")
LHotelName = GetQueryValue("HotelName")
CloseQuery
If LCancelled Then
strBody = strBody & "Your booking has been cancelled" & NL & NL
Else
strBody = strBody + "---------------------" & NL &_
"Accommodation Details" & NL &_
"---------------------" & NL &_
"Hotel: " & LHotelName & NL & NL
' (SS,7/12/14) added link to L_roomtypes to get room type
OpenQuery("SELECT * FROM bookingrooms LEFT JOIN l_roomtypes ON l_roomtypes.RoomTypeID = bookingrooms.RoomTypeID WHERE BookingNo = '" & CleanSQLStr(ABookingNo) & "' ORDER BY RoomNo")
Dim i
i = 0
Do While Not EndOfQuery
i = i + 1
' (SS,27/10/11) removed: "Non smoking : " & GetQueryValue("NonSmoking") & NL &_
' (SS,29/4/15) replaced GetQueryValue("FullName") with Trim(GetQueryValue("Title") & " " & Trim(GetQueryValue("FirstName") & " " & GetQueryValue("Surname")))
strBody = strBody +_
"------" & NL &_
"Room " & i & NL &_
"------" & NL &_
"Full Name: " & Trim(GetQueryValue("Title") & " " & Trim(GetQueryValue("FirstName") & " " & GetQueryValue("Surname"))) & NL &_
"Arrival Date: " & GetQueryValue("ArrivalDate") & NL &_
"No of Nights: " & GetQueryValue("NoOfNights") & NL &_
"Room Type: " & GetQueryValue("RoomType") & NL
' (SS,22/10/15) added if to only show if these values aren't blank
If GetQueryValue("SharingWith") <> "" Then
strBody = strBody & "Sharing with: " & GetQueryValue("SharingWith") & NL
End If
If GetQueryValue("SpecialRequirements") <> "" Then
strBody = strBody & "Special req: " & GetQueryValue("SpecialRequirements") & NL
End If
strBody = strBody & NL
NextQueryRecord
Loop
CloseQuery
' (SS,4/4/13) replaced ".. GBP " & dblTotalCost with CurrencyAmount(dblTotalCost)
' (SS,18/4/14) added Application("TotalCostSuffix")
' (SS,3/10/14) added "If" to only show cost if credit card enabled
' (SS,7/12/14) replaced dblTotalCost with LAmountToCharge
If Application("CreditCardEnabled") Then
strBody = strBody &_
"Total Cost: " & CurrencyAmount(LAmountToCharge) & " " & Application("TotalCostSuffix") & NL & NL
End If
End If
strBody = strBody &_
"Booking No: " & GetBookingNo(ABookingNo) & NL & NL
' add foot notes
Dim LFootNotes
LFootNotes = GetFootNotesForHotel(LHotelID)
If LFootNotes & "" <> "" Then strBody = strBody & LFootNotes & NL & NL
strBody = strBody & Trim(GetSetting("EmailFooter"))
' send the email using Dundas Mailer Control
Dim objEmail 'Mailer control
Set objEmail = Server.CreateObject("Dundas.Mailer")
objEmail.SMTPRelayServers.Add "mail.itpartnership.com"
objEmail.SMTPRelayServers.Add "mail.ontheworldweb.com"
'set Mailer control properties and collection items
objEmail.Subject = "Important - Ref: " + Application("ConferenceName") + " Accommodation Booking (No: " & GetBookingNo(ABookingNo) & ")"
objEmail.Body = strBody
objEmail.Priority = 1
objEmail.TOs.Clear
objEmail.TOs.Add LEmailAddress
objEmail.FromAddress = Application("FromEmailAddress")
On Error Resume Next
objEmail.SendMail
If Application("BCCEmailAddress1") <> "" Then
objEmail.TOs.Clear
objEmail.TOs.Add Application("BCCEmailAddress1")
objEmail.FromAddress = LEmailAddress
On Error Resume Next
objEmail.SendMail
End If
If Application("BCCEmailAddress2") <> "" Then
objEmail.TOs.Clear
objEmail.TOs.Add Application("BCCEmailAddress2")
objEmail.FromAddress = LEmailAddress
On Error Resume Next
objEmail.SendMail
End If
'you can test for the success/failure of the operation by examining VBScript's Err object here
Set objEmail = Nothing
If AEmailType <> ET_BOOKING Then
Response.Write("<p><strong>Email has been sent to " & LEmailAddress & ".</strong></p>")
End If
End Sub
' (SS,7/12/14) moved here from apputils in main and admin
Function GetBookingNo(ABookingNo)
GetBookingNo = Application("BookingNoPrefix") & Right("0000" & ABookingNo, 4)
End Function
' (SS,5/12/14) added CleanSQLStr and replaced HotelName with HotelID
' (SS,7/12/14) moved here from apputils in main and admin
Function GetFootNotesForHotel(AHotelID)
OpenQuery("SELECT * FROM Hotels WHERE HotelID = '" & CleanSQLStr(AHotelID) & "'")
GetFootNotesForHotel = GetQueryValue("FootNotes")
CloseQuery
End Function
' (SS,4/4/13) returns given amount prefixed with Currency code
Function CurrencyAmount(AAmount)
CurrencyAmount = Application("Currency") & " " & AAmount
End Function
' (SS,8/12/14) called from editutils.asp if it exists
Function RelatedRecordsCheck(ATableName, AKeyFieldName, AKeyFieldValue, ByRef AErrorMessage)
Dim LTableName
RelatedRecordsCheck = True
LTableName = LCase(ATableName)
If LTableName = "hotels" Then
If RelatedRecordsExist("hotelrooms", AKeyFieldName, AKeyFieldValue, AErrorMessage) Then Exit Function
If RelatedRecordsExist("bookings", AKeyFieldName, AKeyFieldValue, AErrorMessage) Then Exit Function
If RelatedRecordsExist("bookingnights", AKeyFieldName, AKeyFieldValue, AErrorMessage) Then Exit Function
ElseIf LTableName = "l_roomtypes" Then
If RelatedRecordsExist("hotelrooms", AKeyFieldName, AKeyFieldValue, AErrorMessage) Then Exit Function
If RelatedRecordsExist("bookingrooms", AKeyFieldName, AKeyFieldValue, AErrorMessage) Then Exit Function
If RelatedRecordsExist("bookingnights", AKeyFieldName, AKeyFieldValue, AErrorMessage) Then Exit Function
End If
RelatedRecordsCheck = False
End Function
' (SS,8/12/14) called from RelatedRecordsCheck above to make each check and set error message if records found
Function RelatedRecordsExist(ATableName, AFieldName, AFieldValue, ByRef AErrorMessage)
If GetSQLRecordExists("SELECT " + AFieldName + " FROM " + ATableName + " WHERE " + AFieldName + " = '" & CleanSQLStr(AFieldValue) & "' LIMIT 1") Then
RelatedRecordsExist = True
AErrorMessage = "Related records exist in table " + ATableName + " for field " + AFieldName
Else
RelatedRecordsExist = False
End If
End Function
%>