<%
' ============
' apputils.asp
' ============
' Version 1.03 (28/05/21)
' ============
'   HISTORY
' ============
' (SS,24/07/20) first version for ITP Plates
' (SS,20/08/20) changed to Sub ShowLicences to not show Cancelled licence, new Cancelled and Notes fields added to licences table.
' (SS,04/03/21) fixed duplicates being created this redirect (Post/Redirect/Get)
'               see as mentioned here:https://en.wikipedia.org/wiki/Post/Redirect/Get
'               And here: https://www.seobility.net/en/wiki/Post/Redirect/Get
'               Another solution is by using window.history.replaceState (see https://stackoverflow.com/questions/6320113/how-to-prevent-form-resubmission-when-page-is-refreshed-f5-ctrlr)
'               Used redirect because it's preferred
' (SS,28/05/21) modified to allow expiry date to be set and also new edit modal
' ============'

' global constants and variables '

' (SS,23/3/05) '
Dim NL
NL = Chr(13) + Chr(10)

' main variables '
Dim FSessionID
Dim strCommand

Dim gsITP_ErrorMessage ' error message passed back to browser using javascript '

' (SS,20/2/14) used to hold message shown on popup
Dim FPopUpMessage

Initialise

' (SS,30/8/04) runs code to be run before all templates
Sub Initialise
  gsITP_ErrorMessage = ""
  FPopUpMessage = "" ' (SS,20/2/14)
  
  OpenDatabase ' close is done in Finalise sub
   
  ' following before if below, to allow sign to show immediately after sign out
  If SignOutRequested Then SignOut

  ' if not already authenticated then process the authenticated if applicable
	If Not IsAuthenticated Then Authenticate
  
  FSessionID = Session.SessionID
    
End Sub

' to allow items to be added at the start of the head tag, call to HTMLHeadStart needs to in the correct place in main template
' DisableCache moved here and call to DisableCache in inc-template-main.asp replaced with HTMLHeadStart
Sub HTMLHeadStart
  DisableCache
End Sub

' to allow items to be added just before the end of the head tag, call to HTMLHeadStart needs to in the correct place in main template
' good place for tracking code
Sub HTMLHeadEnd

End Sub

' called from end of inc-template-main.asp
Sub Finalise 
 
	CloseDatabase
	ShowAlertMessage
  ShowPopUpMessage   
	FinaliseDBFunctions  
End Sub

' new simpler finalise especially for Ajax, which doesn't have analytics, redirection, alerts, and timer
Sub FinaliseAjax
  CloseDatabase
  FinaliseDBFunctions
End Sub

Function IsAuthenticated
  IsAuthenticated = Session("Authenticated")
End Function

Sub Authenticate
  ' if not authenticated then email and password specified then try to authenticate
  If Not Session("Authenticated") Then
    Dim LEmail, LPassword, LResellerID
    LEmail = Trim(Request("Email"))
    LPassword = Trim(Request("Password"))
    If LEmail <> "" And LPassword <> "" Then 
      'Response.Write "Email: " & Request("Email") & BR
      'Response.Write "Password: " & Request("Password") & BR
      ' check if valid, and password is assigned i.e. not null or blank
      LResellerID = GetSQLValueAsString("SELECT ResellerID FROM resellers WHERE EmailAddress = '" & CleanSQLStr(LEmail) & "' AND Password = '" & CleanSQLStr(LPassword) & "' AND COALESCE(Password, '') <> ''")
      If LResellerID <> "" Then
        SetResellerID LResellerID
        Session("Authenticated") = True       
        LogSignIn        
      Else
        SetAlertMessage "Email and/or password is invalid"
      End If      
    End If
  End If  
End Sub

Function SignOutRequested
  SignOutRequested = Request("cmd") = "signout"
End Function

Sub SignOut
  Session("Authenticated") = False
  Session("ResellerID") = ""
End Sub

' (SS,30/7/20)
Sub LogSignIn
  Dim LSQL  
  LSQL = "INSERT INTO signin_log SET" &_
    " ResellerID = '" & CleanSQLStr(GetResellerID) & "'" &_
    ", ResellerName = '" & CleanSQLStr(GetResellerField("ResellerName")) & "'" &_
    ", SignInDateTime = NOW()" &_
    ", IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'" &_
    ", SessionID = '" & Session.SessionID & "'"
  ExecuteQuery(LSQL)  
End Sub

Sub SetResellerID(AResellerID)
  Session("ResellerID") = CLng(AResellerID)
End Sub

Function GetResellerID
  GetResellerID = Session("ResellerID")
End Function

' (SS,27/7/20)
Function GetResellerField(AFieldName)
  GetResellerField = GetSQLValueAsString("SELECT " & AFieldName & " FROM resellers WHERE ResellerID = '" & CleanSQLStr(GetResellerID) & "'")
End Function

' (SS,28/7/20)
Function GetLicenceField(ALicenceID, AFieldName)
  GetLicenceField = GetSQLValueAsString("SELECT " & AFieldName & " FROM licences WHERE LicenceID = '" & CleanSQLStr(ALicenceID) & "'")
End Function

' (SS,10/6/07) *** followings settings to be held in a common database
Function GetMailServer(AServerNo)
	If AServerNo = 1 Then
		GetMailServer = "mail.itpartnership.com"
	ElseIf AServerNo = 2 Then
		GetMailServer = "mail.ontheworldweb.com"
	Else
		GetMailServer = ""
	End If
End Function

' (SS,6/6/07) returns name of current script file, in most cases this will be products.asp
' but could also be worldpay-callback.asp etc
Function GetScriptName
  Dim LScriptName
  LScriptName = LCase(Request.ServerVariables("SCRIPT_NAME"))
  If Left(LScriptName, 1) = "/" Then LScriptName = Mid(LScriptName, 2, Len(LScriptName) - 1)
  GetScriptName = LScriptName
End Function

' (SS,28/11/13) returns true if on home page
Function IsHomePage
  Dim LPageName
  LPageName = LCase(CleanRequestQueryString("page"))
  IsHomePage = LPageName = "home" Or (LPageName = "" And CleanRequestQueryString("cmd") = "" And GetProductCodeQS = "" And CleanRequestQueryString("cat") = "" And CleanRequestQueryString("grp") = "")
End Function

' (SS,23/8/17) new version which now calls SendEmailByCDO instead of SendEmailByDundas, previous SendMail renamed to SendEmailByDundas
Function SendEmail(AEmailAddress, ABCCEmailAddress, ABCCEmailAddress2, AFromEmailAddress, ASubject, ABody, AIsHTML)
  SendEmail = SendEmailByCDO(AEmailAddress, ABCCEmailAddress, ABCCEmailAddress2, AFromEmailAddress, ASubject, ABody, "", AIsHTML, "", "")
End Function

' (SS,10/6/06) send email using CDO, returns False if there was a failure
' (SS,28/9/12) added AEmbeddedImage to allow image to be embedded inside the email
Function SendEmailByCDO(ATo, ABcc, ABcc2, AFrom, ASubject, ABody, AFiles, AIsHTML, AUrl, AEmbeddedImage)
  ' Create CDO message object
  Dim objMessage
  Set objMessage = CreateObject("CDO.Message")

  ' Set configuration fields.
  With objMessage.Configuration.Fields
  	Const SCHEMA_PREFIX = "http://schemas.microsoft.com/cdo/configuration/"

    ' Original sender email address
    .Item(SCHEMA_PREFIX & "sendemailaddress") = AFrom

    ' SMTP settings - without authentication, using standard port 25 on host smtp
    .Item(SCHEMA_PREFIX & "sendusing") = 2 ' cdoSendUsingPort
    .Item(SCHEMA_PREFIX & "smtpserverport") = 25
    .Item(SCHEMA_PREFIX & "smtpserver") = GetMailServer(1)

    ' SMTP Authentication
    .Item(SCHEMA_PREFIX & "smtpauthenticate") = 0 ' cdoAnonymous

		' Timeout
		.Item(SCHEMA_PREFIX & "smtpconnectiontimeout") = 10

    .Update
  End With

  ' Set other message fields.
  With objMessage
    ' From, To, Subject And Body are required.
    .From = AFrom
    .To = ATo
    .Subject = ASubject

		' if AUrl is provided then build the email from given web page
		If AUrl <> "" Then
			.CreateMHTMLBody AUrl
		ElseIf AIsHTML Then
    	' if HTML then set the HTML body
    	.HTMLBody = ABody
      
      ' (SS,28/9/12) embed image if supplied, image must be in the images folder
      If AEmbeddedImage <> "" Then
        ' (SS,28/9/12) embed the image, the HTML must contain something like <img src="cid:myimage.gif">
        ' with help from http://support.jodohost.com/threads/tut-how-to-add-embedded-images-in-cdo-mail.7692/
        Dim objBP
        ' Const CdoReferenceTypeName  = 1
        Set objBP = objMessage.AddRelatedBodyPart(Server.MapPath("/images/" & AEmbeddedImage), AEmbeddedImage, 1)
        objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<" & AEmbeddedImage & ">"
        objBP.Fields.Update
      End If
		Else
    	' else normal plain text
    	.TextBody = ABody
  	End If

    ' Blind copy and attachments are optional.
    If ABcc <> "" Then .BCC = ABcc
    If ABcc2 <> "" Then .BCC = .BCC + ";" + ABcc2
    If AFiles <> "" Then .AddAttachment AFiles

    ' Send the email and check for failure
    On Error Resume Next
    .Send

	  ' if failed then try other mail servers
	  Dim LMailServer, LMailServerNo
	  LMailServerNo = 2
	  Do While Err.Number <> 0
	  	LMailServer = GetMailServer(LMailServerNo)
	  	If LMailServer = "" Then Exit Do
			LMailServerNo = LMailServerNo + 1
			With objMessage.Configuration.Fields
				.Item(SCHEMA_PREFIX & "smtpserver") = LMailServer
				.Update
			End With
			On Error Resume Next ' cancels the previous error message, i.e. Err.Number starts again at zero
			.Send
		Loop

  End With

  ' Returns zero If succesfull. Error code otherwise
  SendEmailByCDO = Err.Number = 0

  ' clean up
	Set objMessage = Nothing
End Function

' (SS,17/11/04) sets javascript alert message call "onload" of body '
' can be called more than once, each new message is separated by newline
' (SS,4/6/09) added check for "", only adds if AMessage <> ""
' (SS,22/7/10) noticed that the alert wasn't appearing when message contained double quote
' escaped using \ to fix this for single and double quotes
Sub SetAlertMessage(AMessage)
	If AMessage <> "" Then
  	If gsITP_ErrorMessage <> "" Then
    	gsITP_ErrorMessage = gsITP_ErrorMessage + "\n" ' i.e. newline in javascript '
  	End If
    Dim LMessage
    LMessage = Replace(AMessage, BR, "\n")  ' (SS,1/6/07) replace <br> with "\n" ' (SS,7/6/11) replaced <br> with BR constant
    LMessage = Replace(LMessage, "'", "\'")     ' (SS,22/7/10) escape single quotes
    LMessage = Replace(LMessage, """", "\""")   ' (SS,22/7/10) escape double quotes
    LMessage = Replace(LMessage, "&nbsp;", " ") ' (SS,19/4/16) replaced non-breaking space (HTML) to normal space
  	gsITP_ErrorMessage = gsITP_ErrorMessage + Replace(LMessage, "<br>", "\n")
	End If  	
End Sub

' (SS,15/4/16) returns True of alert message already contains given text
Function AlertMessageContains(AContains)
  AlertMessageContains = InStr(1, gsITP_ErrorMessage, AContains, vbTextCompare) > 0
End Function

' (SS,19/4/16) add a line to separate message if already a message
Function AddAlertMessageSection
  If gsITP_ErrorMessage <> "" Then
    gsITP_ErrorMessage = gsITP_ErrorMessage + "\n" ' i.e. newline in javascript '  
  End If
End Function

' (SS,28/5/07) moved here from SetAlertMessage, so it can be run from finalise at the end of the page
Sub ShowAlertMessage
	If gsITP_ErrorMessage <> "" Then
%>
<script language="JavaScript" type="text/JavaScript">
<!--
ITP_ErrorMessage = "<%=gsITP_ErrorMessage%>";
//-->
</script>
<%
	End If
End Sub

' (SS,7/6/11)
Sub SetConfirmDialog(AMessage, AFunction)
%>
<script language="JavaScript" type="text/JavaScript">
ITP_ConfirmMessage = "<%=AMessage%>"
ITP_ConfirmFunction = "<%=AFunction%>"
</script>  
<%
End Sub

' (SS,20/2/14)
' (SS,15/4/16) changed to append to existing message rather than overwrite
Sub SetPopUpMessage(AMessage)
  FPopUpMessage = FPopUpMessage & IIf(FPopUpMessage = "", "", BR) & AMessage
End Sub

' (SS,20/2/14)
Sub ShowPopUpMessage
  If FPopUpMessage <> "" Then 
%>
<div id="popupmessage" style="display: none; position: absolute; top: 0px; right: 0px; background-color: #FFF; text-align: center; width: 394px; padding: 25px; border: 2px solid red;">
  <p><%=FPopUpMessage%></p>
</div>
<script language="JavaScript" type="text/JavaScript">
  $("#popupmessage").show();
  
  /* (SS,11/6/14) added following to position below the shopping status */
  l_top = $("#shopping-status").offset().top + $("#shopping-status").height() + 5;
  l_left = $("#shopping-status").offset().left + $("#shopping-status").width() - $("#popupmessage").outerWidth() + 3;  
  $("#popupmessage").css({top: l_top, left: l_left});
  
  $("#popupmessage").fadeOut(4000);
</script>     
<%
  End If
End Sub

' (SS,1/7/11) all redirects go through here, also Finalise runs before the redirect takes place
' (SS,4/3/21) added here
Sub DoRedirect(AURL, AIsPermanent)
		' do the permanent redirection
		Finalise ' make sure we close the database because Response.End will end the script
    If AIsPermanent Then
      Response.Status = "301 Moved Permanently" 
      Response.AddHeader "Location", AURL
      Response.End	   
    Else
      Response.Redirect AURL 
    End If
End Sub

' (SS,27/7/20)
Sub DoOperation
  ' do nothing if not signed in
  If Not IsAuthenticated Then Exit Sub

  Dim LSuccess ' (SS,4/3/21)
  LSuccess = False

  Dim LCmd, LCompanyName, LLicenceID
  LCmd = Request("cmd")
  If LCmd = "createlicence" Then
    LCompanyName = Trim(Request("CompanyName"))
    If LCompanyName <> "" Then
     ' Response.Write ("###Licence requested for: " & LCompanyName & "###" & BR)
     ' Response.Write ("###Licence key is: " & GetRandomKey(6, 5) & "###" & BR)
      ' (SS,30/7/20) added maximum of 10 licences per reseller per day
      ' (SS,4/3/21) increased from 10 to 20 per day (due to Northern Plates unlimited licences)
      If GetNewLicenceCountToday(GetResellerID) >= 20 Then
        SetAlertMessage "Error code: MLR. Please contact IT Partnership for support."
      Else
        ' (SS,28/5/21) now calls CreateOrRenewLicence instead of CreateNewLicence, this handles ExpiryDate
        LSuccess = CreateRenewOrEditLicence("C", "", LCompanyName)        
      End If
    End If
  ElseIf LCmd = "renewlicence" Then
    LLicenceID = Trim(Request("LicenceID"))    
    ' (SS,28/5/21) now calls CreateOrRenewLicence instead of CreateNewLicence, this handles ExpiryDate
    LSuccess = CreateRenewOrEditLicence("R", LLicenceID, "")
    
  ' (SS,28/5/21) new edit licence feature
  ElseIf LCmd = "editlicence" Then
    LLicenceID = Trim(Request("LicenceID"))
    LSuccess = CreateRenewOrEditLicence("E", LLicenceID, "")
  End If
  
   ' (SS,4/3/21) redirect to prevent form resubmission and creation of duplicates
  If LSuccess Then
    ' redirect to this page i.e. index.asp
    DoRedirect Request.ServerVariables("SCRIPT_NAME"), False
  End If
End Sub

' (SS,28/5/21) both renewals and creation go through here to reduce repetitive code
' AType is "C" for "Create", "R" for "Renew" and "E" for "Edit"
Function CreateRenewOrEditLicence(AType, ALicenceID, ACompanyName)
  Dim LSuccess, LExpiryDate
  LSuccess = False 
  
  ' (SS,28/5/21) if expiry date allowed then check that it has been entered and is valid
  ' if not allowed then as before, CreateNewLicence called with LExpiryDate set to ""
  If ValidExpiryDate(LExpiryDate) Then
    If AType = "C" Then
      LSuccess = CreateNewLicence(ACompanyName, LExpiryDate)
    ElseIf AType = "R" Then
      LSuccess = RenewLicence(ALicenceID, LExpiryDate)
    ElseIf AType = "E" Then
      LSuccess = EditLicence(ALicenceID, LExpiryDate)
    End If 
  Else
    SetAlertMessage "Expiry Date is invalid"
  End If  

  CreateRenewOrEditLicence = LSuccess
End Function


' (SS,28/5/21) returns true and the expirty date if expiry date is valid and applicable, true is also return if not applicable with "" as the date
Function ValidExpiryDate(ByRef AExpiryDate)  
  ' (SS,28/5/21) if expiry date allowed then check that it has been entered and is valid
  If AllowExpiryDateEntry Then
    AExpiryDate = Trim(Request("ExpiryDate"))
    ValidExpiryDate = IsDate(AExpiryDate)
  Else
    AExpiryDate = ""
    ValidExpiryDate = True
  End If
End Function

' (SS,27/7/20)
' (SS,28/6/21) added AExpiryDate
Function CreateNewLicence(ACompanyName, AExpiryDate)
  Dim LSQL, LLicenceKey 
  
  LLicenceKey = GetRandomKey(6, 5)  
  
  LSQL = "INSERT INTO licences SET" &_
    " ResellerID = '" & CleanSQLStr(GetResellerID) & "'" &_
    ", CompanyName = '" & CleanSQLStr(ACompanyName) & "'" &_
    ", LicenceKey = '" & CleanSQLStr(LLicenceKey) & "'" &_
    ", StartDate = CURRENT_DATE()" &_
    ", Enabled = TRUE"

  ' (SS,27/5/21) if expiry date specified then use it else as before, a year now
  If AExpiryDate <> "" Then
    LSQL = LSQL & ", ExpiryDate = '" & AExpiryDate & "'"
  Else  
    LSQL = LSQL & ", ExpiryDate = DATE_ADD(CURRENT_DATE(), INTERVAL 1 YEAR)"
  End If
  
  ExecuteQuery(LSQL)  
  
  Dim LLicenceID, LExpiryDate
  LLicenceID = GetSQLLastInsertID
  LExpiryDate = GetSQLValueAsString("SELECT ExpiryDate FROM licences WHERE LicenceID = " & LLicenceID)
  
  ' also add licence transaction record
  AddLicenceTransaction LLicenceID, LExpiryDate
  
  ' email the licence
  EmailLicence "C", LLicenceID, ""
  
  CreateNewLicence = True
  
End Function

' (SS,30/7/20)
Function GetNewLicenceCountToday(AResellerID)
  GetNewLicenceCountToday = GetSQLValue("SELECT COUNT(*) FROM licences WHERE ResellerID = '" & CleanSQLStr(AResellerID) & "' AND StartDate = CURRENT_DATE")
End Function

' (SS,28/5/21) added AExpiryDate
Function RenewLicence(ALicenceID, AExpiryDate)
  Dim LSQL
  
  ' validate that licence is for logged in reseller and expiry is less than equal to 30 days
  ' (SS,28/5/21) removed the less than 30 day check i.e.  AND DATEDIFF(ExpiryDate, CURRENT_DATE) <= 30
  LSQL = "SELECT LicenceID FROM licences WHERE ResellerID = '" & CleanSQLStr(GetResellerID) & "' AND LicenceID = '" & CleanSQLStr(ALicenceID) & "'"
  ' exit if not valid
  If GetSQLValueAsString(LSQL) = "" Then
    SetAlertMessage "Licence could not be renewed"
    RenewLicence = False
    Exit Function
  End If
  
  ' increase expiry date by one year
  LSQL = "UPDATE licences SET"
    
  ' (SS,28/5/21) if expiry date specified then use it else as before, a year now
  If AExpiryDate <> "" Then
    LSQL = LSQL & " ExpiryDate = '" & AExpiryDate & "'"
  Else  
    LSQL = LSQL & " ExpiryDate = DATE_ADD(ExpiryDate, INTERVAL 1 YEAR)" 
  End If
  
  LSQL = LSQL & " WHERE LicenceID = '" & CleanSQLStr(ALicenceID) & "'" 
  
  ExecuteQuery(LSQL)  
  
  Dim LExpiryDate
  LExpiryDate = GetSQLValueAsString("SELECT ExpiryDate FROM licences WHERE LicenceID = " & ALicenceID)
  
  ' also add licence transaction record
  AddLicenceTransaction ALicenceID, LExpiryDate
  
  EmailLicence "R", ALicenceID, ""
  
  RenewLicence = True
  
End Function

' (SS,28/5/21)
Function EditLicence(ALicenceID, AExpiryDate)
  Dim LSQL, LLicenceEnabled, LClearComputerName
  Dim LExistingExpiryDate, LExistingEnabled

  LLicenceEnabled = Request("LicenceEnabled") = "yes"
  LClearComputerName = Request("ClearComputerName") = "yes"
    
  ' validate that licence is for logged in reseller and get the existing expiry date and whether enabled or not
  LSQL = "SELECT ExpiryDate, Enabled FROM licences WHERE ResellerID = '" & CleanSQLStr(GetResellerID) & "' AND LicenceID = '" & CleanSQLStr(ALicenceID) & "'"
  ' exit if not valid
  If Not GetSQL2Values(LSQL, LExistingExpiryDate, LExistingEnabled) Then
    SetAlertMessage "Licence could not be changed"
    EditLicence = False    
    Exit Function
  End If

  LExistingEnabled = LExistingEnabled = 1
  LExistingExpiryDate = ISODate(LExistingExpiryDate)
  
  ' check if change required, exit if no change
  If LExistingEnabled = LLicenceEnabled And (AExpiryDate = "" Or LExistingExpiryDate = AExpiryDate) And LClearComputerName = False Then
    SetAlertMessage "No change made"
    EditLicence = False   
    Exit Function
  End If
  
  LSQL = ""
  
  If LExistingEnabled <> LLicenceEnabled Then
    LSQL = "Enabled = " & LLicenceEnabled
  End If
  
  If AExpiryDate <> "" And LExistingExpiryDate <> AExpiryDate Then
    LSQL = LSQL + IIf(LSQL = "", "", ", ") + "ExpiryDate = '" & AExpiryDate & "'"
  End If 

  If LClearComputerName Then
    LSQL = LSQL + IIf(LSQL = "", "", ", ") + "ComputerName = ''"
  End If

  Dim LChanges
  LChanges = LSQL

  LSQL = "UPDATE licences SET " & LSQL & " WHERE LicenceID = '" & CleanSQLStr(ALicenceID) & "'"
      
  'Response.Write("###LExpiryDate:" & AExpiryDate & "###" & BR)
  'Response.Write("###LExistingExpiryDate:" & LExistingExpiryDate & "###" & BR)
  'Response.Write("###LExistingEnabled:" & LExistingEnabled & "###" & BR)
  'Response.Write("###LLicenceEnabled:" & LLicenceEnabled & "###" & BR)
  'Response.Write("###LClearComputerName:" & LClearComputerName & "###" & BR)
  'Response.Write("###LSQL:" & LSQL & "###" & BR)
  
  ExecuteQuery(LSQL)
    
  AddLicenceEditLog ALicenceID, LChanges
  
  EmailLicence "E", ALicenceID, LChanges
  
  EditLicence = True
End Function    

' (SS,28/7/20) moved code here, called from two places
' (SS,28/5/21) replaced AIsNew with AType, "C" for create, "R" for renewal, "E" for edit
Sub EmailLicence(AType, ALicenceID, AEditDetails)
  ' email the licence
  ' *** to email to itpplates and reseller, perhaps get reseller name and email in query above instead of call to GetResellerName, perhaps routine called GetResellerField
  Dim LSubject, LBody, LCompanyName
  LSubject = "ITP Plates Licence "
  If AType = "C" Then
    LSubject = LSubject + "Key"
  ElseIf AType = "R" Then
    LSubject = LSubject + "Renewal"
  ElseIf AType = "E" Then
    LSubject = LSubject + "Edit"
  End If
  LCompanyName = GetLicenceField(ALicenceID, "CompanyName")
  
	LSubject = LSubject + " - " & GetResellerField("ResellerName") & " / " & LCompanyName
  LBody = "Company: " & LCompanyName & NL & "Licence Key: " & GetLicenceField(ALicenceID, "LicenceKey") & NL & "Expiry Date: " & GetLicenceField(ALicenceID, "ExpiryDate")  

  ' (SS,28/5/21) added following for edit
  If AType = "E" Then
    LBody = LBody & NL & NL & "Edit Details:"
    LBody = LBody & NL & AEditDetails
  End If  
  
  ' Function SendEmail(AEmailAddress, ABCCEmailAddress, ABCCEmailAddress2, AFromEmailAddress, ASubject, ABody, AIsHTML)
  Dim LEmailAddress
  LEmailAddress = GetResellerField("EmailAddress")
  'SendEmail "surinder@itpartnership.com", "", "", "itpplates@itpartnership.com", LSubject, LBody, False    
  'SendEmail "itpplates@itpartnership.com", "", "", "itpplates@itpartnership.com", LSubject, LBody, False
  
  SendEmail LEmailAddress, "itpplates@itpartnership.com", "", "itpplates@itpartnership.com", LSubject, LBody, False 
  ' (SS,4/3/21) following for testing only
  'SendEmail "surinder@itpartnership.com", "", "", "itpplates_test@itpartnership.com", LSubject, LBody, False    
 
End Sub

' (SS,27/7/20)
Sub AddLicenceTransaction(ALicenceID, AExpiryDate)
  Dim LSQL     
  LSQL = "INSERT INTO licence_trans SET" &_
    " ResellerID = '" & CleanSQLStr(GetResellerID) & "'" &_
    ", LicenceID = '" & CleanSQLStr(ALicenceID) & "'" &_
    ", DateTimeIssued = NOW()" &_
    ", ExpiryDate = STR_TO_DATE('" & AExpiryDate & "', '%d/%m/%Y')"    
  ExecuteQuery(LSQL)  
End Sub

' (SS,28/5/21)
Sub AddLicenceEditLog(ALicenceID, AEditDetails)
  Dim LSQL  
  LSQL = "INSERT INTO licence_edit_log SET" &_
    " LicenceID = '" & CleanSQLStr(ALicenceID) & "'" &_
    ", EditDateTime = NOW()" &_   
    ", IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'" &_
    ", SessionID = '" & Session.SessionID & "'" &_
    ", EditDetails = '" & CleanSQLStr(AEditDetails) & "'"
  ExecuteQuery(LSQL)  
End Sub

' (SS,27/7/20)
' created from Delphi routine function TfrmMain.GetRandomKey
Function GetRandomKey(ASections, ASectionLength)
  Dim LResult, i, n
  LResult = ""
  For i = 1 To ASections
    For n = 1 To ASectionLength
      LResult = LResult + Chr(Asc("A") + RandomInteger(0, 25))
    Next
    if i <> ASections Then LResult = LResult + "-" ' if not last section then add hyphen to separate the sections
  Next
  GetRandomKey = LResult  
End Function

Sub ShowLicences
  Dim LSQL
  'LSQL = "SELECT *, DATEDIFF(ExpiryDate, CURRENT_DATE) AS DaysLeft FROM licences WHERE ResellerID = '" & GetResellerID & "' ORDER BY LicenceID"
  ' (SS,20/8/20) added AND NOT Cancelled to WHERE (added new Cancelled and Notes fields to licences table)
  LSQL = "SELECT licences.*, " &_
    "DATEDIFF(ExpiryDate, CURRENT_DATE) AS DaysLeft, " &_
    "DATE(MAX(LastPrintDateTime)) AS LastPrint, " &_
    "DATE(MIN(LastPrintDateTime)) AS FirstPrint, " &_
    "DATEDIFF(CURRENT_DATE(), DATE(MAX(LastPrintDateTime))) AS DaysAgo, " &_
    "ROUND(LastPrintCount / DATEDIFF(CURRENT_DATE(), DATE(MIN(LastPrintDateTime))) * 7, 0) AS WeeklyPrints " &_
    "FROM licences " &_
    "LEFT JOIN licence_check_log ON licence_check_log.LicenceID = licences.LicenceID " &_
    "WHERE ResellerID = '" & GetResellerID & "' AND NOT Cancelled " &_
    "GROUP BY LicenceID"
  
  OpenQuery(LSQL)
  
  ShowLicencesHeader
    
  Do While Not EndOfQuery
    ShowLicencesRowStart
    
    ShowLicencesRowField "CompanyName", ""
    ShowLicencesRowField "RNPSNo", "C"
    ShowLicencesRowField "LicenceKey", ""
    ShowLicencesRowField "Enabled", "C" ' (SS,28/5/21)
    ShowLicencesRowField "Edit", "C" ' (SS,28/5/21)
    ShowLicencesRowField "ExpiryDate", "C"
    ShowLicencesRowField "Renew", "C"
    ShowLicencesRowField "DaysLeft", "C" 
    ShowLicencesRowField "ComputerName", ""
    ShowLicencesRowField "LastPrint", "C"
    ShowLicencesRowField "LastPrintCount", "C"
    ShowLicencesRowField "WeeklyPrints", "C"
    
    ShowLicencesRowEnd
      
    NextQueryRecord
  Loop  
  
  ShowLicencesFooter
  
  CloseQuery
  
End Sub

' (SS,27/5/21) allow expiry dates to be entered for particular resellers, i.e. IT Partnership and Northern Number Plates Limited
Function AllowExpiryDateEntry
  ' if IT Partnership or Northern Number Plates Limited
  AllowExpiryDateEntry = GetResellerID = 1 Or GetResellerID = 7
End Function

' (SS,27/5/21) default is a year
Function GetDefaultExpiryDate
  GetDefaultExpiryDate = ISODate(DateAdd("yyyy", 1, Date))
End Function

' (SS,27/5/21) min is one week
Function GetMinExpiryDate
  GetMinExpiryDate = ISODate(DateAdd("d", 7, Date))
End Function

' (SS,27/5/21) max is a year
Function GetMaxExpiryDate
  GetMaxExpiryDate = GetDefaultExpiryDate
End Function


%>