<SCRIPT LANGUAGE=VBScript RUNAT=Server>
Option Explicit
</SCRIPT>

<!--#include file="config.asp"-->

<SCRIPT LANGUAGE=VBScript RUNAT=Server>
' ============
' Version 2.05 (25/06/19)
' ============
' (SS,14/09/07) New version
' (SS,21/11/07) The Session_OnEnd had stopped working after Windows 2003 SP2. Worked after hotfix.
' Moved some code into Session_AddBackToStock
' (SS,07/07/11) modified for product options and logging
' (SS,28/07/11) added ability to get the database source name from config.asp, also added Option Explicit
' improved database handled, opening and closing handled only in ExecSQL and GetSQLValueAsString
' logging and delete options from stock only done if schema allows
' schema version is logged and also added session count
' (SS,22/04/14) Added LogEnabled condition to AddLog to only enable when LogEnabled is True in config.asp.
' (SS,27/12/14) Added "if select check..." to Sub Session_EmptyBasket to minimise "DELETE" queries in binary log for replication
' (SS,25/04/19) Modified Sub Session_AddBackToStock and added new Sub FetchWebPage. To send alert email to customers where order was cancelled without payment
' i.e. Session ended and they got as far as the checkout stage but hadn't made a payment.
' (SS,25/04/19) Removed GetSchemaVersionFromSettings and IsSchemaVersionAtLeast153
' added new parameter to AddLog for debug level, debug level of 2 or above are always logged
' Also fixed "Application End" not being added to log. Added Application("TotalSessions") which is recorded in "Application End" log.
' (SS,25/06/19) Fixed issue where cancelled email sometimes not sent (i.e. when order already "CANCELLED" due to further activity without successful payment

' (SS,18/4/19) NB. Application("WebsiteURL") is set in apputils.asp (due to Request.ServerVariables not functioning in this global.asa) used to call FetchWebPage in Session_OnEnd for cancelled orders
Sub Application_OnStart
  Application("ConnectionString") = "DSN=" & GetDatabaseSourceName & ";" ' (SS,28/7/11) now gets name from GetDatabaseSourceName function in config.asp
  AddLog 9, "Application Start"
  Application("SessionCount") = 0
  Application("TotalSessions") = 0 ' (SS,25/4/19) 
End Sub

Sub Application_OnEnd
  ' (SS,25/4/19) added Application("TotalSessions"), parameter of 9 ensures this gets written to log
  AddLog 9, "Application End (" & Application("SessionCount") & ")" & " (" & Application("TotalSessions") & ")"
End Sub

Sub Session_OnStart
  ' (SS,28/7/11) increment the session count
  Application.Lock
  Application("SessionCount") = Application("SessionCount") + 1
  Application("TotalSessions") = Application("TotalSessions") + 1 ' (SS,25/4/19) 
  Application.UnLock

  AddLog 1, "Session Start (" & Application("SessionCount") & ")"

  ' (SS,2/8/12) changed timeout from 180 to 120 minutes
  Session.Timeout = 120 ' time out after two hours of non-use
  'Session.Timeout = 5 ' ### set time out to 5 minutes temporarily for testing

  ' Set the server locale to UK, mainly to prevent date problems (day and month being reversed)
  Session.LCID = 2057
  ' make sure basket is empty on session start
  Session_EmptyBasket

  ' clear the session values

  ' following are used for continue shopping and search log
  Session("Search") = ""
  Session("Page") = ""
  Session("Category") = ""
  Session("Subcategory") = ""

  ' following are check out values accepted from user
  Session("Title") = ""
  Session("FirstName") = ""
  Session("Surname") = ""
  Session("Address1") = ""
  Session("Address2") = ""
  Session("Town") = ""
  Session("County") = ""
  Session("Postcode") = ""
  Session("Country") = ""
  Session("Telephone") = ""
  Session("Email") = ""
  Session("EmailConfirm") = ""
  Session("PurchaseOrderNo") = ""
  Session("Message") = ""

  ' (SS,16/7/04) delivery address same as invoice set to true
  Session("DeliveryAddressSameAsInvoice") = True

  ' when order created this holds the order number used
  Session("OrderNoPlaced") = ""

  ' (SS,11/5/04) used to save selected categories in menu
  Session("MenuCategory") = ""
  Session("MenuSubcategory") = ""

  ' (SS,18/5/04) to allow password protection during development stage '
  ' used in conjunction with Application("DevelopmentPassword") '
  Session("Authenticated") = False

  ' (SS,20/5/04) following used to keep track of which special offers to show next '
  Session("SpecialOfferCount") = 0

  ' (SS,3/8/04) account holder settings
  Session("AccountID") = ""  ' this is blank if account ID not entered and authenticated '
  Session("ContractID") = ""

  ' (SS,30/9/04) added referrer feature '
  Session("ReferrerAdded") = False

End Sub

Sub Session_OnEnd
  ' (SS,28/7/11) decrement the session count
  Application.Lock
  Application("SessionCount") = Application("SessionCount") - 1
  Application.UnLock  

  ' add items in order taken from stock back into stock
  ' (SS,21/11/07) OrderNo passed as parameter, more reliable using Session("OrderNoPlaced") in subroutine doesn't always return correct value
  Session_AddBackToStock(Session("OrderNoPlaced"))

  ' empty the basket when session has timed out or ended some other way
  Session_EmptyBasket
  AddLog 1, "Session End (" & Application("SessionCount") & ")"
End Sub

Sub Session_EmptyBasket
  AddLog 1, "EmptyBasket 1" ' (SS,27/12/14) added 1

  ' (SS,27/12/14) added checking count of existing records before deleting to prevent delete queries form being added to binary log for replication 
  ' unnecessarily when there are no records. Noticed the two delete queries below were very common in the log
  ' this routine is also run when session starts, therefore every session results in up to 4 delete queries even nothing added to basket
  If CInt(GetSQLValueAsString("SELECT COUNT(*) FROM shoppingbaskets WHERE SessionID = '" & Session.SessionID & "'")) > 0 Then
    AddLog 1, "EmptyBasket 2" ' (SS,27/12/14)
    
    ' delete the shopping basket
    ' (SS,6/7/11) modified to now also delete options
    AddLog 1, "EmptyBasket 3" ' (SS,27/12/14)
    ExecSQL "DELETE t1, t2 FROM shoppingbaskets t1, shopping_basket_options t2 WHERE t1.ItemID = t2.ItemID AND t1.SessionID = '" & Session.SessionID & "'"
    
    ' (SS,6/7/11) following necessary because above only deletes record from shoppingbaskets if at least one option record exists, it also works in schemas prior to 1.53
    ExecSQL "DELETE FROM shoppingbaskets WHERE SessionID = '" & Session.SessionID & "'"
  End If
End Sub

' (SS,18/4/19) now also sends cancelled order email if enabled and order was in "ORDER PLACED" status
Sub Session_AddBackToStock(AOrderNo)

  AddLog 1, "AddBackToStock 1"

  ' (SS,28/5/07) added following to mark order as cancelled and add items back into stock
	' if order was placed (but not paid for) then mark as cancelled and add items back into stock
  If AOrderNo <> "" Then
    AddLog 3, "AddBackToStock 2"

    ' (SS,7/7/11) if order is in the ORDER PLACED status, then cancel and put products and options back into stock
    ' (SS,25/6/19) modified to get Status, if "ORDER PLACED" then add back to stock, if "CANCELLED" then send cancelled email
    Dim LStatus
    LStatus = GetSQLValueAsString("SELECT Status FROM orders WHERE OrderNo = " & AOrderNo)
    AddLog 3, "AddBackToStock 2.5 (" & LStatus & ")"
    If LStatus = "ORDER PLACED" Then    
      
      AddLog 3, "AddBackToStock 3"
      
      ExecSQL "UPDATE orders SET Status = 'CANCELLED' WHERE OrderNo = " & AOrderNo
    
      Dim LSQL
      
      AddLog 2, "AddBackToStock 4"
      
      ' (SS,7/7/11) put products back in stock, taken from TakeProductsFromStock
      ' replaces previous version which couldn't handle more then one product record with same code or id
      LSQL = "UPDATE products, " &_
        "(SELECT ProductID, SUM(Qty) AS Qty FROM orderdetails" &_
        " WHERE OrderNo = " & AOrderNo &_
        " GROUP BY ProductID" &_
        ") AS t2" &_
        " SET NumInStock = NumInStock + Qty" &_
        " WHERE products.ProductID = t2.ProductID AND NumInStock IS NOT NULL"             
      ExecSQL LSQL
    
      AddLog 2, "AddBackToStock 5"
      
      ' (SS,6/7/11) put options back into stock
      ' SQL taken from TakeProductOptionsFromStock
      LSQL = "UPDATE product_option_values, " &_
        "(SELECT order_detail_options.ProductOptionValueID, SUM(orderdetails.Qty) AS Qty" &_
        " FROM order_detail_options, orderdetails" &_
        " WHERE orderdetails.OrderDetailID = order_detail_options.OrderDetailID" &_
        " AND order_detail_options.OrderNo = " & AOrderNo & " AND order_detail_options.ProductOptionValueID <> 0" &_
        " GROUP BY ProductOptionValueID " &_
        ") AS t2 " &_
        " SET NumInStock = NumInStock + Qty " &_
        " WHERE product_option_values.ProductOptionValueID = t2.ProductOptionValueID AND NumInStock IS NOT NULL"        
      ExecSQL LSQL
      
      LStatus = "CANCELLED" ' (SS,25/6/19) to ensure cancelled email sent below
      
    End If
    
    ' (SS,18/4/19) if sending of cancelled order emails enabled then send it by fetch web page send-cancelled-order-email.asp with query string values for this order
    ' (SS,25/9/19) added LStatus = "CANCELLED" (also possible that order was already cancelled by further customer activity without successful payment)
    If LStatus = "CANCELLED" And Application("CancelledOrderEmailsEnabled") Then
      AddLog 2, "AddBackToStock 6"
      Dim LURL
      LURL = Application("WebsiteURL") & "/send-cancelled-order-email.asp"
      ' added SessionID and IP address to URL
      LURL = LURL & "?orderno=" & AOrderNo & "&sid=" & Session.SessionID & "&ip=" & GetSQLValueAsString("SELECT IPAddress FROM orders WHERE OrderNo = " & AOrderNo)        
      AddLog 3, "AddBackToStock 7 - FetchWebPage: " & LURL
      FetchWebPage LURL
      AddLog 3, "AddBackToStock 8 - Returned from FetchWebPage"
    End If
    
    AddLog 3, "AddBackToStock 9" ' (SS,6/7/11) 
    
	End If
  AddLog 1, "AddBackToStock 10"
End Sub

' (SS,17/4/19) taken from dbfunction.asp (GetWebPage) also doesn't return anything
' Tried ASync set to True because we don't want to wait here but it doesn't work so stayed with ASync set to False
Sub FetchWebPage(AURL)
  Dim objHttp
  Set objHttp = Server.CreateObject("WinHTTP.WinHTTPRequest.5.1")
  objHttp.Open "GET", AURL, False ' Async set to False
  ' ignore certificate errors
  Const WinHttpRequestOption_SslErrorIgnoreFlags = 4  
  objHttp.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300
  objHttp.Send
  Set objHttp = Nothing
End Sub

' (SS,20/11/07) used for debugging
' (SS,6/7/11) modified to log session id and order no
' (SS,22/4/14) Added LogEnabled condition
' (SS,25/4/19) added ADebugLevel parameter, if this is 3 or above then it's always logged
Sub AddLog(ADebugLevel, AMessage)
  If (ADebugLevel <= 2 And LogEnabled) Or ADebugLevel = 3 Then
    ExecSQL "INSERT INTO log_cancelled_sessions SET SessionID = '" & Session.SessionID & "', OrderNo = '" & Session("OrderNoPlaced") & "', Message = '" & AMessage & "'"
  ElseIf ADebugLevel = 9 Then
    ' (SS,5/4/1) discovered than Application End log wasn't being written, 9 is called from application start and end.
    ' Application End event doesn't have session defined so could be the reason it was failing. Application End now appears in log.
    ExecSQL "INSERT INTO log_cancelled_sessions SET Message = '" & AMessage & "'"
  End If
End Sub

' (SS,28/7/11) executes given SQL, also opens and closes the connection
Sub ExecSQL(ASQL)
  Dim LoConn
  Set LoConn = Server.CreateObject("ADODB.Connection")
  LoConn.ConnectionString = Application("ConnectionString")
  LoConn.Open
  LoConn.Execute(ASQL)
  LoConn.Close
  Set LoConn = Nothing
End Sub

' (SS,6/7/11) special version for use in global.asa, opens and closes the connection
Function GetSQLValueAsString(ASQL)
  Const adCmdText = &H0001
  Dim LnRecs, LoRS, LoConn
  
  Set LoConn = Server.CreateObject("ADODB.Connection")
  LoConn.ConnectionString = Application("ConnectionString")
  LoConn.Open  
  
  Set LoRS = LoConn.Execute(ASQL, LnRecs, adCmdText)
  If LoRS.Eof Then
    GetSQLValueAsString = ""
  Else
    GetSQLValueAsString = LoRS.Fields.Item(0) ' first field
  End If
  
  LoRS.Close
  Set LoRS = Nothing
  
  LoConn.Close
  Set LoConn = Nothing    
End Function

</SCRIPT>