File: D:/web/secure/itpplates/test - Copy (4).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", False
oJSONResponse.Add "ExpiryDate", ""
oJSONResponse.Add "ExpiryDateStr", ""
oJSONResponse.Add "NextSequenceNo", 0
oJSONResponse.Add "RecommendedVersion", ""
oJSONResponse.Add "EssentialVersion", ""
oJSONResponse.Add "LicenceMessage", ""
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
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
API_Log "API_CheckLicence", "2"
LLicenceMessage = ""
LInternalMessage = ""
LLicenceID = 0
LUpdateComputerName = ""
LUpdateRNPSNo = ""
' find the licence record for company and licence key
LSQL = "SELECT * FROM licences 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
' 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"
' *** to do
' note date time being off by x hours
' ? record system date format
' updates to licence record, i.e. ComputerName, RNPSNo, LastSequenceNo, CheckCount, LastCheckDateTime, LastPrintCount
Dim LExecSQL
LExecSQL = "UPDATE licences SET LastCheckDateTime = NOW(), CheckCount = CheckCount + 1, LastSequenceNo = " & LSequenceNo & ", LastPrintCount = " & LPrintCount
If LUpdateComputerName <> "" Then LExecSQL = LExecSQL & ", ComputerName = '" & CleanSQLStr(LUpdateComputerName) & "'"
If LUpdateRNPSNo <> "" Then LExecSQL = LExecSQL & ", RNPSNo = '" & CleanSQLStr(LUpdateRNPSNo) & "'"
ExecuteQuery(LExecSQL)
' if supplied licence details match (i.e. no warning message), fetch the values
If LLicenceMessage = "" Then
Dim LEnabled
LEnabled = IntToBool(GetQueryValue("Enabled"))
oJSONResponse.Change "Enabled", LEnabled
oJSONResponse.Change "Valid", True
oJSONResponse.Change "Expired", False
oJSONResponse.Change "ExpiryDate", GetQueryValue("ExpiryDate")
oJSONResponse.Change "ExpiryDateStr", GetQueryValue("ExpiryDate")
oJSONResponse.Change "NextSequenceNo", LSequenceNo + 1
oJSONResponse.Change "RecommendedVersion", GetQueryValue("RecommendedVersion")
oJSONResponse.Change "EssentialVersion", GetQueryValue("EssentialVersion")
' error message if not enabled
If Not LEnabled Then
LLicenceMessage = "Licence disabled"
End If
' error message if expired
If Date > GetQueryValue("ExpiryDate") 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")) & "', " &_
"AppVersion = '" & Left(CleanSQLStr(oJSONRequest.Value("AppVersion")), 15) & "', " &_
"LicenceMessage = '" & Left(CleanSQLStr(ALicenceMessage), 255) & "', " &_
"InternalMessage = '" & Left(CleanSQLStr(AInternalMessage), 255) & "'"
' "PCDateTime = '" & CleanSQLStr(oJSONRequest.Value("PCDateTime")) & "'"
API_Log "API_LogLicenceCheck: ", "2"
ExecuteQuery LSQL
API_Log "API_LogLicenceCheck: ", "3"
End Sub
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
%>