<%
' ============
' apputils.asp
' ============
' Version 1.00 (24/07/20)
' ============
'   HISTORY
' ============
' (SS,24/07/20) first version for ITP Plates
' ============'

' 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,27/7/20)
Sub DoOperation
  ' do nothing if not signed in
  If Not IsAuthenticated Then Exit Sub

  Dim LCmd, LCompanyName
  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
      If GetNewLicenceCountToday(GetResellerID) >= 10 Then
        SetAlertMessage "Error code: MLR. Please contact IT Partnership for support."
      Else
        CreateNewLicence(LCompanyName)
      End If
    End If
  ElseIf LCmd = "renewlicence" Then
    Dim LLicenceID
    LLicenceID = Trim(Request("LicenceID"))
    RenewLicence(LLicenceID)
  End If
End Sub

' (SS,27/7/20)
Sub CreateNewLicence(ACompanyName)
  Dim LSQL, LLicenceKey
  LLicenceKey = GetRandomKey(6, 5)
  LSQL = "INSERT INTO licences SET" &_
    " ResellerID = '" & CleanSQLStr(GetResellerID) & "'" &_
    ", CompanyName = '" & CleanSQLStr(ACompanyName) & "'" &_
    ", LicenceKey = '" & CleanSQLStr(LLicenceKey) & "'" &_
    ", StartDate = CURRENT_DATE()" &_
    ", ExpiryDate = DATE_ADD(CURRENT_DATE(), INTERVAL 1 YEAR)" &_
    ", Enabled = TRUE"
  
  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 LLicenceID, True
  
End Sub

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

Sub RenewLicence(ALicenceID)
  Dim LSQL
  
  ' validate that licence is for logged in reseller and expiry is less than equal to 30 days
  LSQL = "SELECT LicenceID FROM licences WHERE ResellerID = '" & CleanSQLStr(GetResellerID) & "' AND LicenceID = '" & CleanSQLStr(ALicenceID) & "' AND DATEDIFF(ExpiryDate, CURRENT_DATE) <= 30"
  ' exit if not valid
  If GetSQLValueAsString(LSQL) = "" Then
    SetAlertMessage "Licence could not be renewed"
    Exit Sub
  End If
  
  ' increase expiry date by one year
  LSQL = "UPDATE licences SET" &_
    " ExpiryDate = DATE_ADD(ExpiryDate, INTERVAL 1 YEAR)" &_
    " 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 ALicenceID, False
  
End Sub

' (SS,28/7/20) moved code here, called from two places
Sub EmailLicence(ALicenceID, AIsNew)
  ' 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 AIsNew Then
    LSubject = LSubject + "Key"
  Else
    LSubject = LSubject + "Renewal"
  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")  
  
  ' 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 
 
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,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"
  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 & "'" &_
    "GROUP BY LicenceID"
  
  OpenQuery(LSQL)
  
  ShowLicencesHeader
    
  Do While Not EndOfQuery
    ShowLicencesRowStart
    
    ShowLicencesRowField "CompanyName", ""
    ShowLicencesRowField "RNPSNo", "C"
    ShowLicencesRowField "LicenceKey", ""
    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

%>