<%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")) & "', " &_       
    "DateTimePutBackCheck = '" & Left(CleanSQLStr(oJSONRequest.Value("DateTimePutBackCheck")), 20) & "', " &_  
    "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

%>