File: D:/web/secure/itpplates/test - Copy (3).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
'oJSONRequest.debug = True
'oJSONResponse.debug = True
' add default properties
oJSONResponse.Add "status", 400
oJSONResponse.Add "message", "Unknown error"
OpenDatabase ' *** might be a better location for this
On Error Resume Next ' start the error handling
API_Log "Debug:", "1"
LResult = API_ReadRequest ' read request into object
API_Log "Debug:", "2"
If Err.Number <> 0 Then LResult = Err.Description
API_Log "Debug:", "3"
If LResult = "" Then ' if no error then continue
API_Log "Debug:", "4"
LResult = API_Authenticate ' check API key etc
API_Log "Debug:", "5"
If Err.Number <> 0 Then LResult = Err.Description
API_Log "Debug:", "6"
If LResult = "" Then
API_Log "Debug:", "7"
LResult = API_ProcessRequest ' process the request
API_Log "Debug:", "8"
If Err.Number <> 0 Then LResult = Err.Description
API_Log "Debug:", "9"
End If
End If
CloseDatabase ' *** might be a better location for this
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
' (SS,23/4/20) replaced above with following to pass back test
'oJSONResponse.Change "message", "Hello world, just testing, " & Now
' 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
' (SS,10/6/20)
Sub API_CheckLicence
Dim LCompanyName, LLicenceKey, LComputerName
LCompanyName = oJSONRequest.Value("CompanyName")
LLicenceKey = oJSONRequest.Value("LicenceKey")
LComputerName = oJSONRequest.Value("ComputerName")
' API_Log "PCDateTime", oJSONRequest.Value("PCDateTime") & ""
' API_Log "API_CheckLicence: ", "5"
' find licence ID using LicenceKey
Dim LLicenceID
' LLicenceID will be 0 if invalid licence
LLicenceID = API_CheckLicenceKey(LCompanyName, LLicenceKey, LComputerName)
API_LogLicenceCheck(LLicenceID)
End Sub
' to ensure software not installed on PCs with same company name, key, computer name:
' perhaps check MACAddress, last sequence number, not matching
Function API_CheckLicenceKey(ACompanyName, ALicenceKey, AComputerName)
Dim LSQL, LLicenceID, LComputerName, LResult
LSQL = "SELECT LicenceID, ComputerName FROM licences WHERE CompanyName = '" & CleanSQLStr(ACompanyName) & "' AND LicenceKey = '" & CleanSQLStr(ALicenceKey) & "'"
LResult = GetSQL2Values(LSQL, LLicenceID, LComputerName)
If Not LResult Then
LLicenceID = 0
End If
API_Log "API_CheckLicenceKey: ", "1"
API_Log "Result: ", "" & LResult
API_Log "LicenceID: ", "" & LLicenceID
API_Log "ComputerName: ", "" & LComputerName
API_CheckLicenceKey = LLicenceID
End Function
' 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)
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) & "', " &_
"LicenceKey = '" & Left(CleanSQLStr(oJSONRequest.Value("LicenceKey")), 35) & "', " &_
"PrintCount = '" & CleanSQLStr(oJSONRequest.Value("PrintCount")) & "', " &_
"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) & "'"
' "PCDateTime = '" & CleanSQLStr(oJSONRequest.Value("PCDateTime")) & "'"
API_Log "API_LogLicenceCheck: ", "2"
'LogDateTime = NOW(), IPAddress = '" & CleanSQLStr(Request.ServerVariables("REMOTE_ADDR")) & "', SessionID = '" & Session.SessionID & "', Type = '" & AType & "', Log = '" & CleanSQLStr(ALog) & "'"
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
%>