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/itpplates/from bam/jsonapi.asp
<%Option Explicit%>
<!--#include file="dbfunctions.asp"-->
<!--#include file="commonutils.asp"-->
<!--#include file="apputils.asp"-->
<!--#include file="jsonObject.class.asp" -->
<%

' (SS,30/10/17) BAM API using JSON
' Version 1.01
' (SS,31/10/17) Changed Region to MembershipNo, now using ORGANISATION_FIELD_LABEL 

' useful JSON ormatting pages:
' https://jsonlint.com/
' https://www.freeformatter.com/json-formatter.html
' http://www.json.org/
' http://jsonapi.org/

Const ALLOWED_BAM = "bam4"
Const ALLOWED_SCRIPT_NAME = "/bam4/jsonapi.asp"
Const API_KEY = "n4bw55hdbVIuMYzFUR1ylZBxojnirI5j"
Const ORGANISATION_FIELD_LABEL = "MembershipNo" ' (was "Region")

Dim oJSONResponse ' used to hold the return JSONobject 
Dim oJSONRequest ' used to hold the request JSON

' (SS,27/10/17) following are globals used by apputils.asp to create booking (also defined in booking.asp)
Dim strTitle, strFirstName, strSurname, strOrganisation, strAddress1, strAddress2, strAddress3, strAddress4
Dim strPostcode, strCountry, strTelephone, strMobile, strEmail, strEmailConfirm
Dim strError, i, n
Dim strHotelID, strArrivalDate(20), strNoOfNights(20)
Dim strTitleArray(20), strFirstNameArray(20), strSurnameArray(20)
Dim strRoomType(20), strSharingWith(20)
Dim strNonSmoking(20), strSpecialReq(20)
Dim strCreditCardType, strCreditCardOther, strCreditCardNo, strCreditCardName, strExpiryMonth, strExpiryYear
Dim dblTotalCost, intBookingNo
Dim strSQL

Response.ContentType = "application/json"

API_Run

Sub API_Run
  Dim LResult

  ' instantiate the class
  Set oJSONResponse = New JSONobject
  Set oJSONRequest = New JSONobject
  
  'oJSONRequest.debug = True
  'oJSONResponse.debug = True

  ' add default properties
  oJSONResponse.Add "status", 400
  oJSONResponse.Add "message", "Unknown error"
 
  On Error Resume Next ' start the error handling
  
  LResult = API_ReadRequest ' read request into object  
  If Err.Number <> 0 Then LResult = Err.Description
  
  If LResult = "" Then ' if no error then continue
    LResult = API_Authenticate ' check API key etc
    If Err.Number <> 0 Then LResult = Err.Description
    If LResult = "" Then
      LResult = API_ProcessRequest ' process the request
      If Err.Number <> 0 Then LResult = Err.Description
    End If
  End If
  
  On Error GoTo 0 ' cancel the error handling   
  
  ' if no error then change status code to 200
  If LResult = "" Then
    oJSONResponse.Change "status", 200  
  End If
  oJSONResponse.Change "message", LResult
  
  ' write the response
  oJSONResponse.Write()
  
  ' log the response
  API_Log "Response", oJSONResponse.Serialize
  
  ' free the object created earlier, might not be necessary
  Set oJSONResponse = Nothing
  Set oJSONRequest = Nothing
End Sub

' reads the request from JSON, returns "" if okay, error message otherwise
Function API_ReadRequest
  Dim LResult, LByteCount, LBytes, LStream, LJSONString 

  LResult = ""
  LJSONString = ""
  
  LByteCount = Request.TotalBytes
  LBytes = Request.BinaryRead(LByteCount)
  
  If LByteCount = 0 Then
    LResult = "No request specified"
  Else
    ' with help from https://stackoverflow.com/questions/2682280/get-classic-asp-variable-from-posted-json
    ' gets request into a string
    Set LStream = Server.CreateObject("ADODB.Stream")
    LStream.Type = 1 ' adTypeBinary              
    LStream.Open()                                   
    LStream.Write(LBytes)
    LStream.Position = 0                             
    LStream.Type = 2 ' adTypeText                
    LStream.Charset = "utf-8"                      
    LJSONString = LStream.ReadText() ' json request as a string                
    LStream.Close()
    Set LStream = Nothing
    
    If LJSONString = "" Then
      LResult = "Empty request"
    Else
      oJSONRequest.Parse(LJSONString)
    End If        
  End If
  
  API_Log "Request", LJSONString
  API_ReadRequest = LResult
End Function

' check the BAM number and API key, returns "" if okay, error message otherwise
Function API_Authenticate
  Dim LResult, LValue
  LResult = ""
  ' check the correct script and bam is being used
  If LCase(Request.ServerVariables("SCRIPT_NAME")) <> ALLOWED_SCRIPT_NAME Then
    LResult = "Incorrect script name or BAM. Should be " & ALLOWED_SCRIPT_NAME
  Else
    LValue = oJSONRequest.Value("apikey")
    If IsNull(LValue) Then
      LResult = "API Key (apikey) is missing"
    ElseIf LValue <> API_KEY Then
      LResult = "API Key is invalid"
    End If
  End If
  
  API_Authenticate = LResult
End Function

' process the request
Function API_ProcessRequest
  Dim LResult, LCommand
  LResult = ""
  
  LCommand = oJSONRequest.Value("command")
  
  If IsNull(LCommand) Then
    LResult = "Command (command) is missing"
  ElseIf LCommand = "GetHotelList" Then
    API_GetHotelList False
  ElseIf LCommand = "GetArrivalDates" Then 
    API_GetArrivalDates False 
  ElseIf LCommand = "GetNumberOfNights" Then 
    API_GetNumberOfNights False       
  ElseIf LCommand = "GetRoomTypes" Then 
    API_GetRoomTypes False
  ElseIf LCommand = "GetAllLookups" Then 
    API_GetAllLookups 
  ElseIf LCommand = "CreateBooking" Then 
    LResult = API_CreateBooking
  ElseIf LCommand = "GetBooking" Then   
    LResult = API_GetBooking
  ElseIf LCommand = "CancelBooking" Then 
    LResult = API_CancelBooking
  ElseIf LCommand = "GetAvailability" Then
    API_GetAvailability
  ElseIf LCommand = "GetHotelGuestList" Then
    LResult = API_GetHotelGuestList
  ElseIf LCommand = "GetTestData" Then   
    API_GetTestData
  Else
    LResult = "Command invalid"
  End If  
  
  API_ProcessRequest = LResult  
End Function

Sub API_GetHotelList(AMultiple)
  ' Response.Write(GetLookupComboDiffFormField("qryHotelsAvailable", "HotelName", "Hotel", "SortOrder", strHotelID, "--> Please choose", "HotelID", "ShowOnWeb = 'Yes'"))
  API_LoadRecordsetFromSQL AMultiple, "HotelList", "SELECT HotelID, HotelName FROM qryHotelsAvailable WHERE ShowOnWeb = 'Yes' ORDER BY SortOrder"
End Sub

Sub API_GetArrivalDates(AMultiple)
  'Response.Write(GetLookupComboDiffFormField("L_ArrivalDates", "ArrivalDate", "ArrivalDate" & i, "ArrivalDate", strArrivalDate(i), "Blank", "", "ShowOnWeb = 'Yes'"))
  API_LoadRecordsetFromSQL AMultiple, "ArrivalDates", "SELECT ArrivalDate FROM l_arrivaldates WHERE ShowOnWeb = 'Yes' ORDER BY ArrivalDate"
End Sub

Sub API_GetNumberOfNights(AMultiple)
  'Response.Write(GetLookupComboDiffFormField("L_NoOfNights", "NoOfNights", "NoOfNights" & i, "", strNoOfNights(i), "Blank", "", "ShowOnWeb = 'Yes'"))
  API_LoadRecordsetFromSQL AMultiple, "NumberOfNights", "SELECT NoOfNights FROM L_NoOfNights WHERE ShowOnWeb = 'Yes' ORDER BY NoOfNights"
End Sub

Sub API_GetRoomTypes(AMultiple)
  'Response.Write(GetLookupComboDiffFormField("L_RoomTypes", "RoomType", "RoomType" & i, "SortOrder", strRoomType(i), "Blank", "RoomTypeID", "ShowOnWeb = 'Yes'"))
  API_LoadRecordsetFromSQL AMultiple, "RoomTypes", "SELECT RoomTypeID, RoomType FROM l_roomtypes WHERE ShowOnWeb = 'Yes' ORDER BY SortOrder"
End Sub

Sub API_GetTestData
  ' API_LoadRecordsetFromSQL False, "bookingrooms", "SELECT * FROM bookingrooms WHERE BookingNo = 6"
  API_LoadRecordsetFromSQL False, "bookingrooms", "SELECT Title, FirstName, Surname, ArrivalDate, NoOfNights, RoomTypeID, SharingWith, SpecialRequirements FROM bookingrooms WHERE BookingNo = 6"
End Sub

Sub API_GetAllLookups
  API_GetHotelList True
  API_GetArrivalDates True
  API_GetNumberOfNights True
  API_GetRoomTypes True
End Sub

Sub API_GetAvailability
  API_LoadRecordsetFromSQL False, "Availability", "SELECT * FROM qryRoomsAvailableTotal WHERE Remaining > 0"
End Sub

Function API_GetHotelGuestList
  Dim LResult, LSQL, LHotelID
  
  LResult = ""
  LHotelID = oJSONRequest.Value("HotelID")
  
  If IsNull(LHotelID) Or LHotelID = "" Then
    LResult = "Hotel ID is missing"
  Else
    LSQL = "SELECT Title, FirstName, Surname, Organisation AS " + ORGANISATION_FIELD_LABEL + ", BookingNo, RoomNo, ArrivalDate, NoOfNights, RoomType, SharingWith, SpecialRequirements, HotelID, Hotel AS HotelName " &_
      "FROM qryHotelGuestList WHERE HotelID = '" & LHotelID & "' ORDER BY Surname, FirstName"
    API_LoadRecordsetFromSQL False, "HotelGuestList", LSQL      
  End If
  
  API_GetHotelGuestList = LResult
End Function

Function API_GetBooking
  Dim LResult, LSQL, LBookingNo, LRecs
  
  LResult = ""
  LBookingNo = oJSONRequest.Value("BookingNo")
  
  If IsNull(LBookingNo) Or LBookingNo = "" Then
    LResult = "Booking No is missing"
  Else
    LSQL = "SELECT BookingNo, BookingDate, Title, FirstName, Surname, Organisation AS " + ORGANISATION_FIELD_LABEL + ", Telephone, Mobile, Email, bookings.HotelID, hotels.HotelName, Cancelled, DateCancelled FROM bookings" &_
      " INNER JOIN hotels ON hotels.HotelID = bookings.HotelID" &_
      " WHERE BookingNo = '" & LBookingNo & "'"
    LRecs = API_LoadRecordsetFromSQL(True, "Booking", LSQL)
    If LRecs = 0 Then
      LResult = "No such booking"
    Else
      LSQL = "SELECT BookingNo, RoomNo, Title, FirstName, Surname, ArrivalDate, NoOfNights, bookingrooms. RoomTypeID, l_roomtypes.RoomType, SharingWith, SpecialRequirements FROM bookingrooms" &_
        " INNER JOIN l_roomtypes ON l_roomtypes.RoomTypeID = bookingrooms.RoomTypeID" &_
        " WHERE BookingNo = '" & LBookingNo & "' ORDER BY RoomNo"
      API_LoadRecordsetFromSQL True, "BookingRooms", LSQL
    End If
  End If
  
  API_GetBooking = LResult
End Function

Function API_CreateBooking
  Dim LResult
  
  ' get the main values
  strTitle = oJSONRequest.Value("Title")
  strFirstName = oJSONRequest.Value("FirstName")
  strSurname = oJSONRequest.Value("Surname")
  strOrganisation = oJSONRequest.Value(ORGANISATION_FIELD_LABEL)
  strTelephone = oJSONRequest.Value("Telephone")
  strMobile = oJSONRequest.Value("Mobile")
  strEmail = oJSONRequest.Value("Email")
  strEmailConfirm = strEmail
  
  strHotelID = oJSONRequest.Value("HotelID")

  Dim LItem, LJSONString, LBookingRoomCount

  Dim oJSONoutput
  
  LJSONString = oJSONRequest.Value("data").Serialize  
  
  Set oJSONoutput = oJSONRequest.Parse(LJSONString)
  
  LBookingRoomCount = 0
  
  ' more readable loop
  For Each LItem in oJSONoutput.items
    If isObject(LItem) And typeName(LItem) = "JSONobject" Then
      LBookingRoomCount = LBookingRoomCount + 1
      strTitleArray(LBookingRoomCount) = LItem.Value("Title") 
      strFirstNameArray(LBookingRoomCount) = LItem.Value("FirstName") 
      strSurnameArray(LBookingRoomCount) = LItem.Value("Surname") 
      strArrivalDate(LBookingRoomCount) = Left(LItem.Value("ArrivalDate"), 10) ' 09/04/2017" ' **** 
      strNoOfNights(LBookingRoomCount) = LItem.Value("NoOfNights") 
      strRoomType(LBookingRoomCount) = LItem.Value("RoomTypeID") 
      strSharingWith(LBookingRoomCount) = LItem.Value("SharingWith") '
      strSpecialReq(LBookingRoomCount) = LItem.Value("SpecialRequirements")      
    End if
  Next  
    
  LResult = ""
  If Not CheckValidPersonalDetails Then
    LResult = strError
  ElseIf Not CheckValidAccommodationDetails Then
    LResult = strError
  ElseIf LBookingRoomCount = 0 Then
    LResult = "Booking rooms missing"
  Else
    CreateBookingNightTempRecords ' in apputils.asp
    ' CheckAvailabilityAndCost returns -1 if not all available, else it returns total cost
    dblTotalCost = CheckAvailabilityAndCost() ' in apputils.asp
    If dblTotalCost = -1 Then 
      'LResult = "One of these dates is now fully booked"
	  ' (SS,14/12/17) replaced above with following as requested by Alan (email of 14/12/17)
	  LResult = "One or more of these nights is fully booked. Please select another hotel."
    Else
      AddBooking ' in apputils.asp
      oJSONResponse.Add "BookingNo", intBookingNo  ' return booking number 
    End If
  End If
  
  API_CreateBooking = LResult
End Function
  
Function API_CancelBooking
  Dim LResult, LCancelled, LBookingNo
  LResult = ""
  LBookingNo = oJSONRequest.Value("BookingNo")
  
  If Not CheckKeyExists("bookings", "BookingNo", CStr(LBookingNo)) Then
    LResult = "No such booking"
  Else
    OpenQuery("SELECT * FROM Bookings WHERE BookingNo = " & LBookingNo)
    LCancelled = GetQueryValue("Cancelled")
    CloseQuery

    If LCancelled Then
      LResult = "Booking already cancelled"
    Else
      ExecuteQuery("DELETE FROM BookingNights WHERE BookingNo = " & LBookingNo)
      ' delete booking room records '
      ExecuteQuery("DELETE FROM BookingRooms WHERE BookingNo = " & LBookingNo)
      ' set the new values in AmountToCharge, DateLastChanged, Cancelled, DateCancelled '
      ExecuteQuery("UPDATE Bookings SET AmountToCharge = 0, LastChange=NOW(), Cancelled = True, DateCancelled = NOW() WHERE BookingNo = " & LBookingNo)
    End If
  End If
    
  API_CancelBooking = LResult
End Function

' loads the recordset from SQL into JSON response, returns number of records
Function API_LoadRecordsetFromSQL(AMultiple, AName, ASQL)
  If AMultiple And AName <> "" Then
    'oJSONResponse.defaultPropertyName = AName
    
    ' following used to prevent error "A property already exists with the name: [[JSONroot]]."
    ' due to limitation of aspJSON
    ' see https://github.com/rcdmk/aspJSON/issues/36 for workaround
    
    Dim LJSON2
    Set LJSON2 = New JSONobject
  End If

  Dim oRS
  ' oConn is a global held in dbfunctions.asp and refers to the database which should already be opened by Initialise in commonutils.asp 
  ' nRecs is also another global in dbfunctions.asp  
  Set oRS = oConn.Execute(ASQL, nRecs, adCmdText)
    
  If AMultiple And AName <> "" Then
    LJSON2.LoadRecordset oRS
    oJSONResponse.Add AName, LJSON2.Parse(LJSON2.Serialize())
    Set LJSON2 = Nothing
  Else
    oJSONResponse.LoadRecordset oRS
  End If
  
  Set oRS = Nothing
  
  API_LoadRecordsetFromSQL = nRecs
End Function

Sub API_Log(AType, ALog)
  Dim LSQL
  LSQL = "INSERT INTO api_log SET LogDateTime = NOW(), IPAddress = '" & CleanSQLStr(Request.ServerVariables("REMOTE_ADDR")) & "', SessionID = '" & Session.SessionID & "', Type = '" & AType & "', Log = '" & CleanSQLStr(ALog) & "'"
  ExecuteQuery LSQL
End Sub
  
%>

<%Finalise%>