HEX
Server: Microsoft-IIS/10.0
System: Windows NT ITPWINWEBSVR22 10.0 build 20348 (Windows Server 2022) AMD64
User: www.conferencesearch.co.uk (0)
PHP: 8.3.30
Disabled: NONE
Upload Files
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>&nbsp;</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")%>&nbsp;</td>
      <td><%=GetQueryValue("SpecialRequirements")%>&nbsp;</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 = "&#9650;"
    Else
      LArrow = "&#9660;"
    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>&nbsp;</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")%>&nbsp;</TD>
    <TD width=200><%=GetQueryValue("Address1")%><BR><%=GetQueryValue("Address2")%><BR><%=GetQueryValue("Address3")%><BR><%=GetQueryValue("Address4")%><BR><%=GetQueryValue("Country")%>&nbsp;<%=GetQueryValue("Postcode")%></TD>
    <TD><%=GetQueryValue("Telephone")%>&nbsp;</TD>
    <TD><%=GetQueryValue("CreditCardType")%>&nbsp;<%=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>&nbsp;</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")%>&nbsp;</td>
    <td><%=GetQueryValue("SpecialRequirements")%>&nbsp;</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

%>