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

%>