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%>