File: D:/web/secure/csl/bam/admin/reputils.asp
<%
' (SS,28/10/13) In Sub ReportBookingsWithCreditCardDetails replaced FormatCurrency with FormatNumber and prefixed with Application("Currency")
' (SS,05/11/13) Change to ReportHotelGuestListing and ReportBookingsWithCreditCardDetails to suffix BookingNo with RoomNo, requested by Alan
' (SS,06/10/14) Change to ReportHotelGuestListing - added Organisation, if it's a required field, using the correct label
' (SS,08/10/14) Added new report ReportGuestListingForAllHotels to show full list they can search easily
' (SS,06/02/16) added column sorting
' (SS,16/02/17) corrected CSV issue for Organisation field, it was prefixing the email, i.e. comma in wrong place, also heading was fixed at "Organisation", now uses the label for this multi-use field
Sub ReportHotelGuestListing
' (SS,6/2/16) added LSQL, LHotelID, LHotelName
Dim i, LSQL, LHotelID, LHotelName
' (SS,6/2/16)
LHotelID = Request("HotelID")
LHotelName = GetHotelNameForID(LHotelID)
' OpenQuery(strReportSQL)
' (SS,6/2/16) replaced above with following, also Surname, FirstName, BookingNo with ReportGetOrderBy
LSQL = "SELECT * FROM qryHotelGuestList WHERE HotelID = """ & CleanSQLStr(LHotelID) & """ ORDER BY " & ReportGetOrderBy("")
OpenQuery(LSQL)
' (SS,27/10/11) removed non smoking references, i.e. following two
' <TD>Non Smoking</TD>
' <TD><.=GetQueryValue("NonSmoking").></TD>
' (SS,6/10/14) added Organisation, if it's a required field, using the correct label
' (SS,7/10/14) added GetHotelNameForID because asLKFieldName now holds HotelID instead of name
' (SS,29/4/15) replaced FullName with separate Title, First Name and Surname
' (SS,6/2/16)
' replaced: GetHotelNameForID(Request.Form(asLKFieldName(1))) with LHotelName
%>
<h3>Hotel Guest Listing for "<%=LHotelName%>"</h3>
<table class="report">
<tr>
<th> </th>
<%
' (SS,6/2/16) replaced TD HTML with calls to new ReportHeadingWithSortOrderLink sub
ReportHeadingWithSortOrderLink "Title", "Title"
ReportHeadingWithSortOrderLink "First Name", "FirstName"
ReportHeadingWithSortOrderLink "Surname", "Surname"
If Application("OrganisationRequired") Then
ReportHeadingWithSortOrderLink Application("OrganisationLabel"), "Organisation"
End If
ReportHeadingWithSortOrderLink "Booking No", "BookingNo"
ReportHeadingWithSortOrderLink "Arrival Date", "ArrivalDate"
ReportHeadingWithSortOrderLink "No of Nights", "NoOfNights"
ReportHeadingWithSortOrderLink "Room Type", "RoomType"
ReportHeadingWithSortOrderLink "Sharing With", "SharingWith"
ReportHeadingWithSortOrderLink "Special Requirements", "SpecialRequirements"
%>
</tr>
<%
i = 0
Do While Not EndOfQuery
i = i + 1
' (SS,5/11/13) added "/" and GetQueryValue("RoomNo") to end of BookingNo, to ensure unique no in case people want to cancel
%>
<tr>
<td><%=i%></TD>
<td><%=GetQueryValue("Title")%></td>
<td><%=GetQueryValue("FirstName")%></td>
<td><%=GetQueryValue("Surname")%></td>
<%If Application("OrganisationRequired") Then%>
<td><%=GetQueryValue("Organisation")%></td>
<%End If%>
<td align="center"><%=GetBookingNo(GetQueryValue("BookingNo"))%>/<%=GetQueryValue("RoomNo")%></td>
<td><%=GetQueryValue("ArrivalDate")%></td>
<td align="center"><%=GetQueryValue("NoOfNights")%></td>
<td><%=GetQueryValue("RoomType")%></td>
<td><%=GetQueryValue("SharingWith")%> </td>
<td><%=GetQueryValue("SpecialRequirements")%> </td>
</tr>
<%
NextQueryRecord
Loop
%>
</table>
<%
CloseQuery
End Sub
' (6/2/16)
Function ReportGetOrderBy(ATablePrefix)
Dim LTablePrefix
If ATablePrefix = "" Then
LTablePrefix = ""
Else
LTablePrefix = ATablePrefix & "."
End If
Dim LOrder, LDirection, LOrderBy, LOrderByDirection
LOrder = Request("order")
LDirection = Request("direction")
If LDirection = "desc" Then
LOrderByDirection = " DESC"
Else
LOrderByDirection = ""
End If
Dim LOrderByDefault
LOrderByDefault = LTablePrefix & "Surname" & LOrderByDirection & ", " & LTablePrefix & "FirstName" & LOrderByDirection & ", " & LTablePrefix & "BookingNo" & LOrderByDirection & ", " & LTablePrefix & "RoomNo" & LOrderByDirection
If LOrder = "" Or LOrder = LTablePrefix & "Surname" Then
LOrderBy = LOrderByDefault
ElseIf LOrder = "BookingNo" Then
LOrderBy = LTablePrefix & "BookingNo" & LOrderByDirection & ", " & LTablePrefix & "RoomNo" & LOrderByDirection
ElseIf LOrder = "FullName2" Then
LOrderBy = "Trim(brTitle & "" "" & Trim(brFirstName & "" "" & brSurname))" & LOrderByDirection
Else
LOrderBy = IIf(InStr(",Organisation,Email,RoomType,HotelName,FullName,", "," + LOrder + ",") = 0, LTablePrefix, "") & CleanSQLStr(LOrder) & LOrderByDirection & ", " & LOrderByDefault
End If
ReportGetOrderBy = LOrderBy
End Function
' (6/2/16)
Sub ReportHeadingWithSortOrderLink(AHeadingTitle, AFieldName)
Dim LURL, LOrder, LDirection, LArrow
LOrder = Request("order")
If LOrder = "" Then LOrder = "Surname"
LDirection = Request("direction")
If LDirection = "" Then LDirection = "asc"
' for arrow to show current direction
If LOrder = AFieldName Then
If LDirection = "asc" Then
LArrow = "▲"
Else
LArrow = "▼"
End If
LArrow = "<span style=""color:#aaaaaa"">" & LArrow & "</span>"
Else
LArrow = ""
End If
' for URL
If LDirection = "" Or LOrder <> AFieldName Then
LDirection = "asc"
ElseIf LDirection = "asc" Then
LDirection = "desc"
Else
LDirection = "asc"
End If
LURL = Request.ServerVariables("SCRIPT_NAME") & "?cmd=rep"
If Request("rep") <> "" Then
LURL = LURL & "&rep=" & Request("rep")
End If
If Request("HotelID") <> "" Then
LURL = LURL & "&HotelID=" & Request("HotelID")
End If
If Request("searchfor") <> "" Then
LURL = LURL & "&searchfor=" & Request("searchfor")
End If
LURL = LURL & "&order=" & AFieldName & "&direction=" & LDirection
%>
<th><a href="<%=LURL%>"><%=AHeadingTitle%></a><%=LArrow%></th>
<%
End Sub
Sub ReportBookingsWithCreditCardDetails
Dim i
' (SS,4/12/14) added following, qryBookingsWithCreditCardDetails View no longer required and SQL for "Bookings with Credit Card Details" in reports can be removed
' credit card number is decrypted
Dim LSQL, LHotelID
LHotelID = Request.Form(asLKFieldName(1))
'LSQL = "SELECT *, CAST(AES_DECRYPT(UNHEX(CreditCardNo), CONCAT('" & CleanSQLStr(ENCRYPTION_PASSWORD) & "', BookingNo)) AS CHAR) AS CreditCardNoDecrypted FROM bookings WHERE Hotel = '" & CleanSQLStr(LHotel) & "' AND Cancelled = FALSE ORDER BY BookingNo"
LSQL = "SELECT *, " & GetSQLCreditCardNoDecrypt & " FROM bookings WHERE HotelID = '" & CleanSQLStr(LHotelID) & "' AND Cancelled = FALSE ORDER BY BookingNo"
' (SS,4/12/14) replaced strReportSQL with LSQL
OpenQuery(LSQL)
' (SS,7/10/14) added GetHotelNameForID because asLKFieldName now holds HotelID instead of name
%>
<P><Strong><font size=""3"">Bookings with Credit Card Details for "<%=GetHotelNameForID(Request.Form(asLKFieldName(1)))%>"</font></Strong></P>
<TABLE cellspacing="0" cellpadding="2" border="1">
<TR class=cellheading>
<TD> </TD>
<TD>Booking No</TD>
<TD>Full Name</TD>
<TD>Organisation</TD>
<TD>Address</TD>
<TD>Telephone</TD>
<TD>Credit Card Type</TD>
<TD>Name on Card</TD>
<TD>Credit Card No</TD>
<TD>Expiry</TD>
<TD align="right">Amount</TD>
</TR>
<%
i = 0
Do While Not EndOfQuery
i = i + 1
' (SS,28/10/13) replaced FormatCurrency with FormatNumber and prefixed with Application("Currency")
' (SS,4/12/14) replaced CreditCardNo with CreditCardNoDecrypted
%>
<TR class=celldata>
<TD align="right"><%=i%></TD>
<TD align="center"><%=GetBookingNo(GetQueryValue("BookingNo"))%></TD>
<TD><%=GetQueryValue("Title") + " " + GetQueryValue("FirstName") + " " + GetQueryValue("Surname")%></TD>
<TD width=100><%=GetQueryValue("Organisation")%> </TD>
<TD width=200><%=GetQueryValue("Address1")%><BR><%=GetQueryValue("Address2")%><BR><%=GetQueryValue("Address3")%><BR><%=GetQueryValue("Address4")%><BR><%=GetQueryValue("Country")%> <%=GetQueryValue("Postcode")%></TD>
<TD><%=GetQueryValue("Telephone")%> </TD>
<TD><%=GetQueryValue("CreditCardType")%> <%=GetQueryValue("CreditCardOther")%></TD>
<TD><%=GetQueryValue("NameOnCard")%></TD>
<TD><%=GetQueryValue("CreditCardNoDecrypted")%></TD>
<TD><%=GetQueryValue("ExpiryMonth")%>/<%=GetQueryValue("ExpiryYear")%></TD>
<TD align="right"><%=Application("Currency") & " " & FormatNumber(GetQueryValue("AmountToCharge"), 2, -1, 0, -1)%></TD>
</TR>
<%
NextQueryRecord
Loop
%>
</TABLE>
<%
CloseQuery
End Sub
' (SS,8/10/14) used by ReportGuestListingForAllHotels to do a wildcard search
Function AddToSQLLike(AFieldName, ASearchFor)
Dim LSearchFor
LSearchFor = Replace(ASearchFor, "'", "''")
LSearchFor = Replace(ASearchFor, """", """""")
AddToSQLLike = " OR " + AFieldName + " LIKE '%" & LSearchFor & "%'"
End Function
' (SS,8/10/14) new report which creates one report for all hotels to allow a search in browser for a guest
' also called search.asp to search bookings
' (SS,6/2/16) added column sorting
' (SS,8/2/16) added ACancelledOnly to show only cancelled bookings
' (SS,28/10/16) added create CSV feature
Sub ReportGuestListingForAllHotels(ASearchFor, ACancelledOnly)
Dim i, LBookingNo, LSQL, LWhere, LHeading, LBookingNoShown
' (SS,28/10/16)
Dim LCreateCSV
LCreateCSV = True
If LCreateCSV Then CreateCSVFile("ReportGuestListingForAllHotels.csv")
' (SS,7/12/14) added INNER JOIN Hotels ON Bookings.HotelID = Hotels.HotelID to get HotelName and INNER JOIN RoomTypes ON Bookings.RoomTypeID = Hotels.RoomTypeID to get RoomType
' default SQL from strReportSQL not used
' (SS,29/4/15) added BookingRooms.Title AS brTitle, BookingRooms.FirstName AS brFirstName, BookingRooms.Surname AS brSurname
' due to duplicate field name, couldn't access later using BookingRooms. or "_1" suffix
' (SS,22/10/15) replaced ORDER BY Bookings.Surname, Bookings.FirstName with BookingRooms.Firstname, BookingRooms.Surname
' (SS,6/2/16) added Trim(BookingRooms.Title & "" "" & Trim(BookingRooms.FirstName & "" "" & BookingRooms.Surname)) AS FullName
' (SS,8/2/16) Added Bookings.BookingNo AS bBookingNo due to issues getting booking number from bookings for cancelled books, accessing BookingNo would get it from the linked BookingRooms
' table and couldn't specify the Bookings table using Bookings.BookingNo in GetQueryValue
LSQL = "SELECT *, Bookings.BookingNo AS bBookingNo, BookingRooms.Title AS brTitle, BookingRooms.FirstName AS brFirstName, BookingRooms.Surname AS brSurname," &_
" TRIM(CONCAT(COALESCE(BookingRooms.Title, ''), ' ', TRIM(CONCAT(COALESCE(BookingRooms.FirstName, ''), ' ', COALESCE(BookingRooms.Surname, ''))))) AS FullName" &_
" FROM Bookings" &_
" INNER JOIN BookingRooms ON Bookings.BookingNo = BookingRooms.BookingNo" &_
" INNER JOIN Hotels ON Bookings.HotelID = Hotels.HotelID" &_
" INNER JOIN L_RoomTypes ON BookingRooms.RoomTypeID = L_RoomTypes.RoomTypeID" &_
" WHERE TRUE" ' &_
' " ORDER BY BookingRooms.Surname, BookingRooms.FirstName, Bookings.BookingNo, RoomNo;"
LSQL = LSQL & " ORDER BY " & ReportGetOrderBy("BookingRooms")
' Response.Write(LSQL)
' (SS,8/2/16) added ACancelledOnly
If ACancelledOnly Then
LHeading = "Cancelled Bookings"
LSQL = Replace(LSQL, " INNER JOIN ", " LEFT JOIN ") ' because cancelled bookings will have no bookrooms records
LSQL = Replace(LSQL, " WHERE TRUE ", " WHERE Cancelled = TRUE ")
ElseIf ASearchFor = "" Then
LHeading = "Guest Listing for All Hotels"
Else
LHeading = "Search Results for '" & ASearchFor & "'"
LWhere = ""
' (SS,29/4/15) added Bookings table prefix to Title, FirstName and Surname, replaced FullName with BookingRooms.Title, FirstName and Surname
LWhere = LWhere + AddToSQLLike("Bookings.Title", ASearchFor)
LWhere = LWhere + AddToSQLLike("Bookings.FirstName", ASearchFor)
LWhere = LWhere + AddToSQLLike("Bookings.Surname", ASearchFor)
LWhere = LWhere + AddToSQLLike("Organisation", ASearchFor)
LWhere = LWhere + AddToSQLLike("Email", ASearchFor)
' LWhere = LWhere + AddToSQLLike("FullName", ASearchFor)
LWhere = LWhere + AddToSQLLike("BookingRooms.Title", ASearchFor)
LWhere = LWhere + AddToSQLLike("BookingRooms.FirstName", ASearchFor)
LWhere = LWhere + AddToSQLLike("BookingRooms.Surname", ASearchFor)
LWhere = LWhere + AddToSQLLike("HotelName", ASearchFor) ' (SS,7/12/14) renamed Hotel to HotelName
LWhere = LWhere + AddToSQLLike("RoomType", ASearchFor)
LWhere = LWhere + AddToSQLLike("SharingWith", ASearchFor)
LWhere = LWhere + AddToSQLLike("SpecialRequirements", ASearchFor)
LWhere = LWhere + AddToSQLLike("Address1", ASearchFor)
LWhere = LWhere + AddToSQLLike("Address2", ASearchFor)
LWhere = LWhere + AddToSQLLike("Address3", ASearchFor)
LWhere = LWhere + AddToSQLLike("Address4", ASearchFor)
LWhere = LWhere + AddToSQLLike("Postcode", ASearchFor)
LWhere = LWhere + AddToSQLLike("Country", ASearchFor)
LWhere = LWhere + AddToSQLLike("Telephone", ASearchFor)
LWhere = LWhere + AddToSQLLike("Mobile", ASearchFor)
LSQL = Replace(LSQL, " WHERE TRUE ", " WHERE FALSE " & LWhere)
End If
' (SS,8/2/16) debug code
' Response.Write LSQL
OpenQuery(LSQL)
' (SS,8/2/16) for debugging field names
'Dim LField
'Response.Write BR
'For Each LField in oRS.Fields
'Response.Write LField.name & BR
'Next
%>
<h3><%=LHeading%></h3>
<table class="report">
<tr>
<th> </th>
<%
ReportHeadingWithSortOrderLink "Title", "Title"
ReportHeadingWithSortOrderLink "First Name", "FirstName"
ReportHeadingWithSortOrderLink "Surname", "Surname"
If Application("OrganisationRequired") Then
ReportHeadingWithSortOrderLink Application("OrganisationLabel"), "Organisation"
End If
ReportHeadingWithSortOrderLink "Email", "Email"
ReportHeadingWithSortOrderLink "Hotel", "HotelName"
ReportHeadingWithSortOrderLink "Full Name", "FullName"
ReportHeadingWithSortOrderLink "Booking No", "BookingNo"
ReportHeadingWithSortOrderLink "Arrival Date", "ArrivalDate"
ReportHeadingWithSortOrderLink "No of Nights", "NoOfNights"
ReportHeadingWithSortOrderLink "Room Type", "RoomType"
ReportHeadingWithSortOrderLink "Sharing With", "SharingWith"
ReportHeadingWithSortOrderLink "Special Requirements", "SpecialRequirements"
' (SS,31/10/16) field header
' (SS,16/2/17) replaced "Organisation" with Application("OrganisationLabel")
If LCreateCSV Then
WriteCSVFile "Title" & "," & "FirstName" & "," & "Surname" & IIf(Application("OrganisationRequired"), "," & Application("OrganisationLabel"), "") & "," & "Email" & "," & "HotelName" & "," & "FullName"_
& "," & "BookingNo" & "," & "ArrivalDate" & "," & "NoOfNights" & "," & "SharingWith" & "," & "SpecialRequirements"
End If
%>
</tr>
<%
i = 0
Do While Not EndOfQuery
i = i + 1
LBookingNo = GetQueryValue("bBookingNo") ' (SS,29/11/14) removed Bookings. prefix, (SS,8/2/16) changed from BookingNo to bBookingNo for cancelled bookings
LBookingNoShown = GetBookingNo(LBookingNo) & IIf(NB(GetQueryValue("RoomNo")) = "", "", "/" & GetQueryValue("RoomNo")) ' (SS,31/10/16) now show in two places (i.e. CSV as well)
' (SS,5/11/13) added "/" and GetQueryValue("RoomNo") to end of BookingNo, to ensure unique no in case people want to cancel
' (SS,29/4/15) replaced FullName with Trim(GetQueryValue("BookingRooms.Title") & " " & GetQueryValue("BookingRooms.FirstName") & " " & GetQueryValue("BookingRooms.Surname")))
' (SS,23/10/15) only add href if user has update permissions
' replaced Trim(GetQueryValue("brTitle") & " " & Trim(GetQueryValue("brFirstName") & " " & GetQueryValue("brSurname"))) with GetQueryValue("FullName")
%>
<tr>
<td><%=i%></td>
<td><%=GetQueryValue("Title")%></td>
<td><%=GetQueryValue("FirstName")%></td>
<td><%=GetQueryValue("Surname")%></td>
<%If Application("OrganisationRequired") Then%>
<td><%=GetQueryValue("Organisation")%></td>
<%End If%>
<td><%=GetQueryValue("Email")%></td>
<td><%=GetQueryValue("HotelName")%></td>
<td><%=GetQueryValue("FullName")%></td>
<td align="center">
<%If CanUpdate Then%>
<a href="update.asp?cmd=View&BookingNo=<%=LBookingNo%>">
<%End If%>
<%=LBookingNoShown%>
<%If CanUpdate Then%>
</a>
<%End If%>
</td>
<td><%=GetQueryValue("ArrivalDate")%></td>
<td align="center"><%=GetQueryValue("NoOfNights")%></td>
<td><%=GetQueryValue("RoomType")%></td>
<td><%=GetQueryValue("SharingWith")%> </td>
<td><%=GetQueryValue("SpecialRequirements")%> </td>
</tr>
<%
' (SS,28/10/16)
If LCreateCSV Then
' (SS,16/2/17) corrected comma before Organisation, should have been after
WriteCSVFile GetCSVField("Title") & "," & GetCSVField("FirstName") & "," & GetCSVField("Surname") & "," & IIf(Application("OrganisationRequired"), GetCSVField("Organisation") & ",", "") & GetCSVField("Email") & "," & GetCSVField("HotelName") & "," & GetCSVField("FullName")_
& "," & LBookingNoShown & "," & GetCSVField("ArrivalDate") & "," & GetCSVField("NoOfNights") & "," & GetCSVField("SharingWith") & "," & GetCSVField("SpecialRequirements")
End If
NextQueryRecord
Loop
%>
</table>
<%
CloseQuery
' (SS,28/10/16)
If LCreateCSV Then
CloseCSVFile
%>
<p>
<a href="getcsv.csv" download>Download CSV</a>
</p>
<%
End If
End Sub
' (SS,28/10/16)
Dim FFS, FTextFile
' (SS,28/10/16)
Sub CreateCSVFile(AFileName)
Set FFS = Server.CreateObject("Scripting.FileSystemObject")
Set FTextFile = FFS.CreateTextFile("D:\data\secure\csl\csv\" & AFileName)
End Sub
' (SS,31/10/16) open for read
Sub OpenCSVFile(AFileName)
Set FFS = Server.CreateObject("Scripting.FileSystemObject")
Set FTextFile = FFS.OpenTextFile("D:\data\secure\csl\csv\" & AFileName, 1) ' 1 for reading
End Sub
' (SS,28/10/16)
Function GetCSVField(AFieldName)
Dim LValue
LValue = GetQueryValue(AFieldName)
LValue = ReplaceStr(LValue, """", """""") ' double the quotes
If InStr(LValue, ",") > 0 Then LValue = """" & LValue & """" ' if contains comma then enclose in quotes
GetCSVField = LValue
End Function
' (SS,28/10/16)
Sub WriteCSVFile(AStr)
FTextFile.WriteLine(AStr)
End Sub
' (SS,31/10/16)
Function ReadCSVFile
ReadCSVFile = FTextFile.ReadLine
End Function
' (SS,31/10/16)
Function EndOfCSVFile
EndOfCSVFile = FTextFile.AtEndOfStream
End Function
' (SS,28/10/16)
Sub CloseCSVFile
FTextFile.Close
Set FTextFile = nothing
Set FFS = nothing
End Sub
' (SS,31/10/16)
Sub DoGetCSVFile
Response.ContentType = "text/plain" ' tells browser that it's an plain txt document
OpenCSVFile("ReportGuestListingForAllHotels.csv")
Do While Not EndOfCSVFile
Response.Write ReadCSVFile & Chr(13) + Chr(10)
Loop
CloseCSVFile
End Sub
%>