File: D:/web/secure/itpplates/restapi - Copy.asp
<%Option Explicit%>
<!--#include file="dbfunctions.asp"-->
<!--#include file="jsonObject.class.asp" -->
<%
Dim NL
NL = Chr(13) + Chr(10)
Dim oJSONResponse ' used to hold the return JSONobject
Dim oJSONRequest ' used to hold the request JSON
' gets rid of "The specified LCID is not available." error in jsonObject.class.asp line 624
' *** perhaps we need to set Response.LCID instead of Session.LCID
Session.LCID = 1033
DebugOn
SetDebugLogTypeToFile
WebDebugLog
Const API_KEY = "ab363c05-4a96-48dc-8764-6d2a5d975158"
Response.ContentType = "application/json"
API_Run
Sub API_Run
Dim LResult
' instantiate the class
Set oJSONResponse = New JSONobject
Set oJSONRequest = New JSONobject
' add default properties
oJSONResponse.Add "ErrorMessage", ""
' (SS,11/6/20)
oJSONResponse.Add "Enabled", False
oJSONResponse.Add "Valid", False
oJSONResponse.Add "Expired", True
'oJSONResponse.Add "ExpiryDate", ""
'oJSONResponse.Add "ExpiryDateStr", ""
'oJSONResponse.Add "NextSequenceNo", 0
'oJSONResponse.Add "RecommendedVersion", ""
'oJSONResponse.Add "EssentialVersion", ""
'oJSONResponse.Add "LicenceMessage", ""
' (SS,18/6/20)
'oJSONResponse.Add "BSAUText", ""
'oJSONResponse.Add "LogoFileName", ""
'oJSONResponse.Add "SupportDetails", ""
On Error Resume Next ' start the error handling
OpenDatabase
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
CloseDatabase
On Error GoTo 0 ' cancel the error handling
' save result to error message
oJSONResponse.Change "ErrorMessage", 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
' check the API key, returns "" if okay, error message otherwise
Function API_Authenticate
Dim LResult, LValue
LResult = ""
'LValue = oJSONRequest.Value("apikey")
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
API_Authenticate = LResult
End Function
' 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
' process the request
Function API_ProcessRequest
Dim LResult, LCommand
LResult = ""
LCommand = oJSONRequest.Value("Command")
API_Log "Command", LCommand
If IsNull(LCommand) Then
LResult = "Command (command) is missing"
ElseIf LCommand = "CheckLicence" Then
API_CheckLicence
Else
LResult = "Command invalid"
End If
API_ProcessRequest = LResult
End Function
' check supplied company name, licence key and computer name against licence record
' determine whether valid, save computer name if not already in record, don't allow a different name
' set the details in response, increment sequence no
Sub API_CheckLicence
Dim LCompanyName, LLicenceKey, LRNPSNo, LComputerName, LSequenceNo
Dim LSQL, LLicenceID, LStoredComputerName, LLicenceMessage, LInternalMessage
Dim LUpdateComputerName, LUpdateRNPSNo, LPrintCount
Dim LCheckSuccessCount, LCheckFailureCount
API_Log "API_CheckLicence", "1"
LCompanyName = oJSONRequest.Value("CompanyName")
LLicenceKey = oJSONRequest.Value("LicenceKey")
LRNPSNo = oJSONRequest.Value("RNPSNo")
LComputerName = oJSONRequest.Value("ComputerName")
LSequenceNo = ParseInt(oJSONRequest.Value("SequenceNo")) ' ParseInt ensures a valid number or 0
LPrintCount = ParseInt(oJSONRequest.Value("PrintCount")) ' ParseInt ensures a valid number or 0
' (SS,19/6/20)
LCheckSuccessCount = ParseInt(oJSONRequest.Value("CheckSuccessCount"))
LCheckFailureCount = ParseInt(oJSONRequest.Value("CheckFailureCount"))
API_Log "API_CheckLicence", "2"
LLicenceMessage = ""
LInternalMessage = ""
LLicenceID = 0
LUpdateComputerName = ""
LUpdateRNPSNo = ""
' find the licence record for company and licence key
LSQL = "SELECT * FROM licences INNER JOIN resellers on resellers.ResellerID = licences.ResellerID" &_
" WHERE CompanyName = '" & CleanSQLStr(LCompanyName) & "' AND LicenceKey = '" & CleanSQLStr(LLicenceKey) & "'"
OpenQuery(LSQL)
If Not EndOfQuery Then
API_Log "API_CheckLicence", "3"
LLicenceID = GetQueryValue("LicenceID")
' if computer name not in licence record then save the supplied one
If LComputerName <> "" Then
LStoredComputerName = NB(GetQueryValue("ComputerName"))
If LStoredComputerName = "" Then
LUpdateComputerName = LComputerName
Else
' check computer name matches
If LComputerName <> LStoredComputerName Then
LLicenceMessage = "Licence is invalid (CN)"
End If
End If
End If
' if RNPSNo not in licence record then save the supplied one
If NB(GetQueryValue("RNPSNo")) = "" Then
LUpdateRNPSNo = LRNPSNo
End If
' if sequence no doesn't match then note it in internal message
Dim LLastSequenceNo
LLastSequenceNo = GetQueryValue("LastSequenceNo")
If LSequenceNo <> LLastSequenceNo Then
LInternalMessage = "SequenceNo didn't match. SequenceNo from client: " & LSequenceNo & ". LastSequenceNo in licence record: " & LLastSequenceNo & "."
End If
LSequenceNo = LSequenceNo + 1 ' increment to give the next no to pass back, also save in LastSequenceNo
' if print count less than before then note it in internal message
Dim LLastPrintCount
LLastPrintCount = GetQueryValue("LastPrintCount")
If LPrintCount < LLastPrintCount Then
LInternalMessage = LInternalMessage & IIf(LInternalMessage <> "", " ", "")
LInternalMessage = LInternalMessage & "PrintCount lower than before. PrintCount from client: " & LPrintCount & ". LastPrintCount in licence record: " & LLastPrintCount & "."
End If
API_Log "API_CheckLicence", "4"
' updates to licence record, i.e. ComputerName, RNPSNo, LastSequenceNo, CheckCount, LastCheckDateTime, LastPrintCount
Dim LExecSQL
LExecSQL = "UPDATE licences SET LastCheckDateTime = NOW(), LastSequenceNo = " & LSequenceNo & ", LastPrintCount = " & LPrintCount &_
", CheckCount = CheckCount + 1, CheckSuccessCount = " & LCheckSuccessCount & ", CheckFailureCount = " & LCheckFailureCount
If LUpdateComputerName <> "" Then LExecSQL = LExecSQL & ", ComputerName = '" & CleanSQLStr(LUpdateComputerName) & "'"
If LUpdateRNPSNo <> "" Then LExecSQL = LExecSQL & ", RNPSNo = '" & CleanSQLStr(LUpdateRNPSNo) & "'"
LExecSQL = LExecSQL & " WHERE LicenceID = " & LLicenceID
ExecuteQuery(LExecSQL)
' if supplied licence details match (i.e. no warning message), fetch the values
If LLicenceMessage = "" Then
Dim LEnabled, LExpired
LEnabled = IntToBool(GetQueryValue("Enabled"))
oJSONResponse.Change "Enabled", LEnabled
oJSONResponse.Change "Valid", True
oJSONResponse.Change "Expired", False
If IsNull(GetQueryValue("ExpiryDate")) Then
oJSONResponse.Add "ExpiryDateStr", ""
LExpired = True
Else
oJSONResponse.Add "ExpiryDateStr", GetQueryValue("ExpiryDate")
LExpired = Date > GetQueryValue("ExpiryDate")
End If
oJSONResponse.Add "NextSequenceNo", LSequenceNo ' already incremented by 1
oJSONResponse.Add "RecommendedVersion", GetQueryValue("RecommendedVersion")
oJSONResponse.Add "EssentialVersion", GetQueryValue("EssentialVersion")
' details from reseller record
oJSONResponse.Add "ResellerName", GetQueryValue("ResellerName")
oJSONResponse.Add "BSAUText", GetQueryValue("BSAUText")
oJSONResponse.Add "LogoFileName", GetQueryValue("LogoFileName")
oJSONResponse.Add "SupportURL", GetQueryValue("SupportURL")
oJSONResponse.Add "ContactDetails", GetQueryValue("ContactDetails")
' error message if not enabled
If Not LEnabled Then
LLicenceMessage = "Licence disabled"
End If
' error message if expired
If LExpired Then
oJSONResponse.Change "Expired", True
LLicenceMessage = "Licence has expired, please renew"
End If
End If
API_Log "API_CheckLicence", "5"
Else
LLicenceMessage = "Licence is invalid (NF)"
End If
CloseQuery
' save the message to send back
oJSONResponse.Change "LicenceMessage", LLicenceMessage
API_LogLicenceCheck LLicenceID, LLicenceMessage, LInternalMessage
API_Log "API_CheckLicence", "10"
API_Log "LicenceMessage: ", "" & LLicenceMessage
API_Log "LicenceID: ", "" & LLicenceID
API_Log "ComputerName: ", "" & LComputerName
End Sub
' TO DO
' RNPS No
' sequence check
' computer name, first time it saves, next time it checks
' tidy code
' more tests
' (SS,10/6/20) log the check to licence_check_log table
Sub API_LogLicenceCheck(ALicenceID, ALicenceMessage, AInternalMessage)
Dim LSQL
' Left used to limit length to actual field length
API_Log "API_LogLicenceCheck: ", "1"
LSQL = "INSERT INTO licence_check_log SET " &_
"LicenceID = " & ALicenceID & ", " &_
"DateTimeChecked = NOW(), " &_
"SessionID = '" & Left(CleanSQLStr(Session.SessionID), 20) & "', " &_
"CompanyName = '" & Left(CleanSQLStr(oJSONRequest.Value("CompanyName")), 100) & "', " &_
"RNPSNo = '" & Left(CleanSQLStr(oJSONRequest.Value("RNPSNo")), 10) & "', " &_
"LicenceKey = '" & Left(CleanSQLStr(oJSONRequest.Value("LicenceKey")), 35) & "', " &_
"PrintCount = '" & CleanSQLStr(oJSONRequest.Value("PrintCount")) & "', " &_
"SequenceNo = '" & CleanSQLStr(oJSONRequest.Value("SequenceNo")) & "', " &_
"LocalIPAddress = '" & Left(CleanSQLStr(oJSONRequest.Value("IPAddress")), 100) & "', " &_
"RemoteIPAddress = '" & Left(CleanSQLStr(Request.ServerVariables("REMOTE_ADDR")), 100) & "', " &_
"MACAddress = '" & Left(CleanSQLStr(oJSONRequest.Value("MACAddress")), 100) & "', " &_
"OSVersion = '" & Left(CleanSQLStr(oJSONRequest.Value("OSVersion")), 100) & "', " &_
"ComputerName = '" & Left(CleanSQLStr(oJSONRequest.Value("ComputerName")), 30) & "', " &_
"WindowsUserName = '" & Left(CleanSQLStr(oJSONRequest.Value("WindowsUserName")), 100) & "', " &_
"DesktopWidth = '" & CleanSQLStr(oJSONRequest.Value("DesktopWidth")) & "', " &_
"DesktopHeight = '" & CleanSQLStr(oJSONRequest.Value("DesktopHeight")) & "', " &_
"FormWidth = '" & CleanSQLStr(oJSONRequest.Value("FormWidth")) & "', " &_
"FormHeight = '" & CleanSQLStr(oJSONRequest.Value("FormHeight")) & "', " &_
"AppVersion = '" & Left(CleanSQLStr(oJSONRequest.Value("AppVersion")), 15) & "', " &_
"LastPrintDateTime = " & API_SQLBlankStrAsNull(CleanSQLStr(oJSONRequest.Value("LastPrintDateTimeStr"))) & ", " &_
"PCDateTime = '" & CleanSQLStr(oJSONRequest.Value("PCDateTimeStr")) & "', " &_
"FolderDateTime = " & API_SQLBlankStrAsNull(CleanSQLStr(oJSONRequest.Value("FolderDateTimeStr"))) & ", " &_
"DriveCSize = '" & CleanSQLStr(oJSONRequest.Value("DriveCSize")) & "', " &_
"CheckSuccessCount = '" & CleanSQLStr(oJSONRequest.Value("CheckSuccessCount")) & "', " &_
"CheckFailureCount = '" & CleanSQLStr(oJSONRequest.Value("CheckFailureCount")) & "', " &_
"ConsecutiveCheckFailureCount = '" & CleanSQLStr(oJSONRequest.Value("ConsecutiveCheckFailureCount")) & "', " &_
"LicenceMessage = '" & Left(CleanSQLStr(ALicenceMessage), 255) & "', " &_
"InternalMessage = '" & Left(CleanSQLStr(AInternalMessage), 255) & "'"
API_Log "API_LogLicenceCheck: ", "2"
ExecuteQuery LSQL
API_Log "API_LogLicenceCheck: ", "3"
End Sub
' (SS,19/6/20) for given date, returns NULL if "", else the string in quotes
Function API_SQLBlankStrAsNull(AStrValue)
Dim LResult
If AStrValue = "" Then
LResult = "NULL"
Else
LResult = "'" & AStrValue & "'"
End If
API_SQLBlankStrAsNull = LResult
End Function
Sub API_Log(AType, ALog)
DebugLog 0, NL & 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
%>