<!-- #include file="shopsessionsubs.asp" -->
<!-- #include file="shopsessionconfig.asp" -->
<%
'***************************************************************
' maintains state for VP-ASP using  cookies or session variables
' Cookies are not currently supported
' VP-ASP 6.50 
' June 12, 2004   Support Coookieless VP-ASP
' March 2, 2006   Address 2 now saved into cookie
' Nov 14, 2006    HK Redo sessions in database
' Dec  3, 2006   Separate database and performance enhancements  
'                make null value to increase performance 
'***************************************************************
const CookieKey="VPASP"

' **************************************************************
' save a value in session variable
' if using file sessions also save in database
'***************************************************************
Sub SetSess (field, value)
dim newvalue
If xsavesession="Yes" then
  newvalue=value
  If value="" then newvalue=cookienullvalue   ' distinquish nothing from empty
  if xsavesessdualmode="Yes" then 
     Session(field)=newvalue
  end if   
  If lcase(field)="currenturl" then
     newvalue=value & "?websess=" & getwebsess
     Responsecookies field,newvalue
  else   
    Responsecookies field,newvalue
  end if  
  exit sub
end if  
' normal sessions
Session(field)=value 
end sub
'
' **************************************************************
' Used to save an array in a session varaible. 
' Normal sessions don't have a problem by file sessions need to 
' know it is an array
'***************************************************************

Sub SetSessA (field, value)
dim a(3)
If xsavesession="Yes" Then
   if xsavesessdualmode="Yes" then 
     Session(field)=value
   end if   
   ResponsecookiesArray field,value
   exit sub
end if  
' normal sessions
Session(field)=value
end sub
'
'***********************************************************************
' get value from session varaible
' if value is empty and we are using file sessions
' try to get value from database
' If could be empty because no real value, lost sessions do to
' web farm or timeout
'***********************************************************************
Function GetSess (field)
dim value
' try database    
if xsavesession="Yes" then
   if xsavesessdualmode="Yes" then 
      value=Session(field)
      if value<>"" then 
          If value=cookienullvalue then value="" 
          Getsess=value
          exit function
      end if
   end if   
   value=Requestcookies(field)
   If value=cookienullvalue then
      value=""
   else
     if value=""   then
       if xsavesessdualmode="Yes" then 
         Session(field)=cookienullvalue    ' next time we will have it in real session variable
      end if   
     end if      
   end if     
'  debugwrite "value=" & value & " for " & field
  Getsess=value
  exit function
end if    
' normal sessions
value=Session(field)
Getsess=value
End Function
'************************************************************************
' get an array from session varaible
' Normal sessions are not an issue
' File sessions need to know it is an array
' first try real sessions, if they are empty, try file sessions
'***********************************************************************
Function GetSessA (field)
dim dataarea, temparray(100), tempcount, rc
dim value, i, key, cartcount
If xsavesession="Yes" then
    if xsavesessdualmode="Yes" then 
      value=Session(field)
      if isarray(value) then 
        GetsessA=value
        exit function
      end if
    end if 
  key = field
  if ucase(key)="CARTARRAY" then
    RequestcookieCart field, value, rc
    GetSessA=value
    exit function
  end if  
  dataarea=Requestcookies(field)
  If dataarea="" then
        GetSessA=""
        exit function
  end if        
  ParseRecord dataarea, TempArray, tempcount, "|"
  GetSessA=Temparray
  exit function
end if
' normal sessions
value=Session(field)
GetsessA=value
End Function

Sub SetSessionTimeout
If getconfig("xSessionTimeout")<>"" then
       Session.timeout=getconfig("xsessiontimeout")
 end if
If xsavesession="Yes" then
  Response.Cookies(cookiekey).expires = date+1
end if  
end sub
'

Sub SaveCustomerDetailsCookie
Dim cookfield
cookfield=""
	Buildcookie cookfield,"Firstname", strFirstname 
	BuildCookie cookfield,"Lastname", strLastname  
	BuildCookie cookfield,"Address", strAddress  
	'VP-ASP 6.08 - address 2 now saved into cookie
	BuildCookie cookfield,"Address2", strAddress2
	BuildCookie cookfield,"City", strCity 
	BuildCookie cookfield,"State", strState 
	BuildCookie cookfield,"PostCode", strPostCode 
	BuildCookie cookfield,"Country", strCountry 
	BuildCookie cookfield,"Company", strCompany 
	BuildCookie cookfield,"Website", strWebsite 
	BuildCookie cookfield,"Phone", strPhone 
	BuildCookie cookfield,"Email", strEmail
	'VP-ASP 6.08 - losing customerid on shopcustomer.asp error fix - added IF statement below
	if strCustomerID = "" OR isnull(strCustomerID) then
		BuildCookie cookfield,"CustomerID", getsess("customerid")
	else
        BuildCookie cookfield,"CustomerID", strCustomerID
	end if

        '12/1/2006 - bug fix
		dim tmpstrdiscount
		if isnull(strdiscount) then
			tmpstrdiscount=""
		else
			tmpstrdiscount=replace(strdiscount, ",", ".")
		end if
		BuildCookie cookfield,"Custdiscount", tmpstrdiscount
		'end fix
		'VP-ASP 6.08 - losing customerid on shopcustomer.asp error fix - commented out line below.
'		BuildCookie cookfield,"Customerid", strcustomerid
        BuildCookie cookfield,"Customertype", strcustomertype
		
		
		'VP-ASP 6.09 - add other fields to cookie
		if getconfig("xcustomerotherfields") > "" then
			if instr(getconfig("xcustomerotherfields"), ",") > 0 then
				dim custfield, tempcustfields
				tempcustfields = split(getconfig("xcustomerotherfields"), ",")

				for each custfield in tempcustfields
					'VP-ASP 6.50 - precautionary security fix
					 BuildCookie cookfield,"c_" & custfield, cleanchars(request(custfield))
				next
			else
				 'VP-ASP 6.50 - precautionary security fix
				 BuildCookie cookfield,"c_" & getconfig("xcustomerotherfields"), cleanchars(request(getconfig("xcustomerotherfields")))
			end if
		end if
		
		
        Response.Cookies ("CartLogin")=cookfield
        response.cookies("CartLogin").expires=date()+365
      '  debugwrite cookfield
end sub
Sub BuildCookie (dataarea, fieldname,fieldvalue)
If dataarea<>"" then
   dataarea=dataarea & ","
end if
If fieldvalue="" then
      dataarea=dataarea & fieldname & "=" & "???"
else
	'VP-ASP 6.09 - If there is a comma in the customers details, replace with pipe before saving in cookie
	if fieldvalue > "" then
		dataarea=dataarea & fieldname & "=" & replace(fieldvalue,",","|")
	else
      dataarea=dataarea & fieldname & "=" & fieldvalue
end if      
end if      
end sub

Sub RestoreCustomerDetailsCookie
dim restored, i
dim cookfield, pairs(30),paircount,fields(4), fieldcount
'        restored=getsess("Restored")
'        if restored<>"" then exit sub  
        cookfield=request.cookies("CartLogin")
	if cookfield="" then exit sub
	parserecord cookfield, pairs, paircount,","
	for i =0 to paircount-1
	    parserecord pairs(i), fields, fieldcount,"="
	    if fields(1)="???" then
	      fields(1)=""
	    end if  
	
		'VP-ASP 6.09 - If using comma instead of decimal, replace it before restoring
		if getconfig("xconverteuropeannumbers") = "Yes" then
			if fields(0) = "Custdiscount" then
				fields(1) = replace(fields(1), ".", ",")
			end if
		end if
		
		'VP-ASP 6.09 - If there is a pipe in the customers details, replace with comma before restoring
		if fields(1) > "" then
			fields(1) = replace(fields(1), "|",",")
		end if
	    Setsess fields(0),fields(1)
	next
        Setsess "Restored","Yes"
        Setsess "Login","Yes"
end sub
Function ShopLcname
dim abc,name, i
abc=array("l","a","n","g","k","e","y")
for i = 0 to ubound(abc)
  name=name & abc(i)
next
shoplcname=name
end function  

Sub SessSaveCart (field, value, cookiekey, cartdays)
dim expires
dim cartcount, arrcount, dataarea, j, countkeyname
dim keyname
dim i
dim cartattributes
cartattributes=cMaxCartAttributes
expires=date+cartdays
cartcount=getsess("CartCount")
if cartcount="" or cartcount=0 then exit sub
'debugwrite "cartcount=" & cartcount
for i = 1 to cartcount
     dataarea=""
     for j = 1 to cartattributes
          dataArea= dataarea & value(j, i) & ";"
     next
     keyname= field & cstr(i)
   '  debugwrite keyname & " " & dataarea & " " & cookiekey
     Response.cookies(Cookiekey) (keyname)=dataarea
     Response.cookies(Cookiekey).expires=expires
next
countkeyname="CartCount"     
Response.cookies(Cookiekey) (countkeyname)=cartcount
Response.cookies(Cookiekey).expires=expires
end sub
'
Sub SessRestoreCart (field, value, cartcount, cookiekey, rc)
dim  arrcount, dataarea, Temparray(20), tempcount
dim arrcart
dim i, j, keyname, countkeyname
dim cartattributes
cartattributes=cMaxCartAttributes
rc=0
ReDim arrcart(cartAttributes,getconfig("xmaxCartItems"))
value=arrcart
countkeyname="CartCount"
cartcount=Request.cookies(Cookiekey) (countkeyname)     
If cartcount="" or Cartcount=0 then
    rc=4
    exit sub
end if 
ReDim arrcart(cartAttributes,getconfig("xmaxCartItems"))
value=arrcart
for i = 1 to cartcount
     keyname= field & cstr(i)
     dataarea=Request.cookies(Cookiekey) (keyname)
     ParseRecord dataarea, TempArray, tempcount, ";"
     for j = 1 to cartAttributes
         value(j,i)= temparray(j-1)
     next
next     
end sub
sub ShopProductcheck
If getconfig(shoplcname)="" then   shoplicenseerror 
If getconfig(shoplcname)="No" then  shoplicenseerror 
end sub

'*************************************************************
' add websess  if using cookies
'*************************************************************
sub responseredirect (url)
If xsavesession<>"Yes" then 
   response.redirect url
   exit sub
end if
dim pos, newurl, delim, posdelim
delim="?"
newurl=url
pos=instr(url,"websess")
posdelim=instr(url,"?")
if posdelim>0 then
   delim="&"
end if   
if pos=0 then
   newurl=newurl & delim & "websess=" & getwebsess
end if
response.redirect newurl    
end sub

'*************************************************************
' add websess to url if using cookies
'*************************************************************
Function AddWebSess (url)
If xsavesession<>"Yes" then 
   addwebsess=url
   exit function
end if
dim pos, newurl, delim, posdelim
delim="?"
newurl=url
pos=instr(url,"websess")
posdelim=instr(url,"?")
if posdelim>0 then
   delim="&"
end if   
if pos=0 then
   newurl=newurl & delim & "websess=" & getwebsess
end if
addwebsess=newurl
end function

Sub AddWebSessForm 
If xsavesession<>"Yes" then exit sub
CreateHiddenElements
end sub

'*************************************************************
' add websess to url if using cookies
' create &websess=xxxxxxxx
'*************************************************************
Function AddWebSessLink
If xsavesession<>"Yes" then 
   addwebsesslink=""
else   
   addwebsesslink = "&websess=" & getwebsess
end if   
end function

'*************************************************************
' add websess to url if using cookies
' addsession 
'*************************************************************
sub AddSession
dim field
field="?"
If xsavesession<>"Yes" then exit Sub
response.write field & "websess=" & getwebsess
end sub


Sub AddWebSessFormGW (fieldname)
'*************************************************************** 
'* Purpose:                
'*         Grabs the data associated with the UserID and creates 
'*         hidden form elements. 
'* Input:   The assigned user id 
'* Return:   Writes out the form element 
'*         using the Response object. 
'****************************************************************** 
If xsavesession<>"Yes" then  exit sub
dim websess
websess=Getwebsess
Response.Write "<INPUT TYPE=""hidden"" NAME=" & Chr(34) & fieldname & Chr(34) & " VALUE=" & Chr(34) & websess & Chr(34) & ">" & vbcrlf 
End sub

'*************************************************************
' add websess to url if using cookies
' create ?websess=xxxxxxxx. Replaced addwession
'*************************************************************
Function AddWebSessLinkFirst
If xsavesession<>"Yes" then 
   addwebsesslinkfirst=""
else   
   addwebsesslinkfirst = "?websess=" & getwebsess
end if   
end function

%>