<%
const xusefilesession="No"    ' Replace session with database sessions           ' 
const cookieDelimiter="!+"
dim cookieRS, cookiesql
dim cookiemsg
dim websessvalue             ' used in gateway returns
dim cookiedbc
'*****************************************************
' VP-ASP 6.50   Used to replace Microsoft Session variables
' June 30, 2004 database version
' Sept 4, 2006 fix line 438 sitsessions to sitesessions
'  Dec 8, 2004 fix cart array restore temparray(22)
'*****************************************************
Function GenerateRandomID()
'****************************************************
'*   Purpose:                                       *
'*             Generates a random id for unique	    *
'*			   identification                       *
'*   Return:                                        *
'*             A string that is the combination     *
'*             of a random number and the           *
'*             number of seconds from 12/31/92      *
'****************************************************
	Dim intRandomNumber	'Random number
	Dim intSeconds		'Number of seconds from 12/31/92
	Dim NewID			'This is the generated ID
	Randomize
	intRandomNumber = Int((100000 * Rnd) + 1)
	intSeconds = DateDiff("s", "12/31/92", Now)
	NewID = CStr(intRandomNumber) & CStr(intSeconds)
	GenerateRandomID = NewID
End Function
Function Assignwebsess()
'****************************************************
'*   Purpose:                                       *
'*             Assigns an id for use by the rest of *
'*             the functions.                       *
'*   Return:                                        *
'*             A random ID for use with the rest of *
'*             the application.                     *
'****************************************************
     Dim websess		'Unique ID
	 Dim FileSO			'File System Object
	 Dim CookiePath		'Path to directory containing reference files
	 Dim CookieFile		'File of unique id and name/value pairs
     websess = GenerateRandomID
     cookiemsg=""
     CookieFileWriteLine("UserID*=*" & websess)
     CookieFileWriteLine("DateAssigned*=*" & Now)
     CookieFileADD  websess
     Assignwebsess = websess
 End Function

'********************************************************
' add message to cookie string
'********************************************************
Sub CookieFilewriteline (msg)
If cookiemsg<>"" then 
  cookiemsg=cookiemsg & cookiedelimiter
end if
cookiemsg=cookiemsg &  msg
end sub

'**************************************************************
' cookiemsg has string to be stored
'*************************************************************
Sub cookiefileclose (sessionkey)
dim cookiesql, sessiondate, sessiontime, sessionvalue, sessionnow
'VP-ASP 6.09 - added formatdatetime 
sessiontime=formatdatetime(time(), vbshorttime)
sessionvalue=replace(cookiemsg,"'","''")
sessiondate=datenormalize(date())
sessionnow=now()
cookieopendatabase cookiedbc
cookiesql="Update sitesessions set "
cookiesql=cookiesql & "sessiondate='" & sessiondate & "',"
cookiesql=cookiesql & "sessiontime=" & "'" & sessiontime & "',"
cookiesql=cookiesql & "sessionvalue=" &  "'" & sessionvalue & "',"
cookiesql=cookiesql & "sessionnow=" &  "'" & sessionnow & "'"
cookiesql=cookiesql & " where sessionkey='" & sessionkey & "'"
'debugwrite cookiesql
cookiedbc.execute(cookiesql)
shopclosedatabase cookiedbc
end sub

'*****************************************************************
' createv a new entry in sitesessions table
'*****************************************************************
Sub cookiefileAdd (sessionkey)
dim cookiesql, sessiondate, sessiontime, sessionvalue, sessionnow
'VP-ASP 6.09 - added formatdatetime  
sessiontime=formatdatetime(time(), vbshorttime)
sessionvalue=replace(cookiemsg,"'","''")
sessiondate=datenormalize(date())
sessionnow=now()
cookieopendatabase cookiedbc
'cookiesql="delete from sitesessions where sessionkey='" & sessionkey & "'"
'cookiedbc.execute(cookiesql)
cookiesql="insert into sitesessions(sessiondate, sessiontime, sessionkey, sessionvalue, sessionnow) values("
cookiesql=cookiesql & "'" & sessiondate & "',"
cookiesql=cookiesql &  "'" & sessiontime & "',"
cookiesql=cookiesql &  "'" & sessionkey & "',"
cookiesql=cookiesql &  "'" & sessionvalue & "',"
cookiesql=cookiesql &  "'" & sessionnow & "'"
cookiesql=cookiesql & ")"
'debugwrite cookiesql
cookiedbc.execute(cookiesql)
shopclosedatabase cookiedbc
end sub

sub ResponseCookies(ValueName, ValueData)
'****************************************************
'*  Adds a name/value pair to the users  file.     *
'****************************************************
	Dim FileSO			'File System Object
	dim websess
	Dim CookieRS, cookiesql, sessionvalue
	Dim LineCount		'Number of rows of text
	Dim NewCount		'Row count for new file
	Dim DelimiterStart	'Location of the delimiting string: *=*
	Dim DataArray()		'Array to contain file contents
	dim cartdata
	dim lvaluename
	websess=Getwebsess
	lvaluename=lcase(valuename)
	cookieopendatabase cookiedbc
	cookiesql="Select * from sitesessions where sessionkey='" & websess & "'"
	set cookiers=cookiedbc.execute(cookiesql)
	if not cookiers.eof then
	   sessionvalue=cookiers("sessionvalue")
	   Cookiecreatearray  dataarray, linecount, sessionvalue 
	else
	  debugwrite "Record not found " & websess
	end if
	closerecordset cookiers
	shopclosedatabase cookiedbc
	cookiemsg=""
	For NewCount = 0 to LineCount - 1
	     DelimiterStart = Instr(DataArray(NewCount), "*=*")
	     If lValueName <> Left(DataArray(NewCount), DelimiterStart - 1) Then
			CookieFileWriteLine(DataArray(NewCount))
	     End If
	Next
	CartData = lValueName & "*=*" & ValueData
	CookieFileWriteLine(CartData)
	CookieFileClose  websess
End sub 

Function Requestcookies( ObjectName)
'****************************************************
'*   Purpose:                                       *
'*            Retrieves the value of an object	    *
'*   Input:                                         *
'*             UserID, name of object		    *
'*   Return:                                        *
'*             The value of the object passed in    *
'****************************************************
	Dim FileSO			'File System Object
	Dim CookieSQL		'Path to directory containing reference files
	Dim CookieRS		'File of unique id and name/value pairs
	Dim CookieFileText	'Text of the file
	Dim CurrentData		'Current line of data
	Dim	DataLength		'Length of CurrentData
	Dim DelimiterStart	'Location of the delimiting string: *=*
	Dim CurrentName		'Name of current object
	Dim ObjectValue		'Value of current object
	dim websess, sessionvalue, dataArray, Linecount, i, found
	websess=Getwebsess
	dim lobjectname
	lobjectname=lcase(objectname)
	objectvalue=""
        cookieopendatabase cookiedbc
        cookiesql="Select * from sitesessions where sessionkey='" & websess & "'"
	set cookiers=cookiedbc.execute(cookiesql)
	if not cookiers.eof then
	   sessionvalue=cookiers("sessionvalue")
	   Cookiecreatearray  dataarray, linecount, sessionvalue 
	else
	  debugwrite "Recorcd not found " & websess
	end if
	closerecordset cookiers
	shopclosedatabase cookiedbc
	cookiemsg=""
	found=false
        for i = 0 to linecount-1
         CurrentData = dataArray(i)
         DataLength = Len(CurrentData)
         DelimiterStart = Instr(CurrentData, "*=*")
         'Response.Write DelimiterStart
         CurrentName = Left(CurrentData, DelimiterStart - 1)
         If lObjectName = CurrentName Then
              ObjectValue = Right(CurrentData, DataLength - (DelimiterStart + 2))
              found=true
              Exit for
         End If
       next
       If found=True then
         Requestcookies = ObjectValue
       else
         Requestcookies = ""
       end if     
End Function

Sub CookieSessionList
'****************************************************
'*   Purpose:                                       *
'*             Retrieves all of the data associated *
'*			   with the UserID	    *
'*   Input:                                         *
'*             UserID				    *
'*   Return:                                        *
'*             All of the contents of the file	    *
'****************************************************
     Dim CurrentData	'Current line's contents
     dim websess
     websess=getwebsess
     dim sessionvalue, dataarray, i
     cookieopendatabase cookiedbc
     dim currentname, objectvalue 
     cookiesql="Select * from sitesessions where sessionkey='" & websess  & "'"
     set cookiers=cookiedbc.execute(cookiesql)
     if not cookiers.eof then
	   sessionvalue=cookiers("sessionvalue")
	   Cookiecreatearray  dataarray, linecount, sessionvalue 
      else
	  debugwrite "Cookie Sessionlist Record not found " & sessionvalue
      end if
      closerecordset cookiers
      shopclosedatabase cookiedbc
      for i = 0 to linecount-1
         CurrentData = dataArray(i)
         DataLength = Len(CurrentData)
         DelimiterStart = Instr(CurrentData, "*=*")
         CurrentName = Left(CurrentData, DelimiterStart - 1)
         ObjectValue = Right(CurrentData, DataLength - (DelimiterStart + 2))
         response.write currentname & "=" & objectvalue & "<br />"
      next
End sub

Function DeleteData(ObjectName)
'****************************************************
'*   Purpose:                                       *
'*             Deletes an object from the data file *
'*   Input:                                         *
'*             UserID, and ObjectName	            *
'*   Return:                                        *
'*             All of the contents of the file	    *
'****************************************************
	Dim FileSO
	dim websess					'File System Object
	Dim CookiePath				'Path to directory containing reference files
	Dim CookieFile				'File of unique id and name/value pairs
	Dim CookieFileText			'Text of the file
	Dim LineCount				'Number of rows of text
	Dim DelimiterStart			'Location of the delimiting string: *=*
	Dim NewCount				'Row count for new file
	Dim OriginalObjectExists	'Flag to determine if object was in file
	Dim DataArray()				'Array to contain file contents
	dim sessionvalue
	websess=getwebsess
	cookieopendatabase cookiedbc
        cookiesql="Select * from sitesession where sessionkey=" & websess
	set cookiers=cookiedbc.execute(sql)
	if not cookiers.eof then
	   sessionvalue=cookiers("sessionvalue")
	   Cookiecreatearray  dataarray, linecount, sessionvalue 
	else
	  debugwrite "Recorc not found " & websess
	end if
	closerecordset cookiers
	shopclosedatabase cookiedbc
	cookiemsg=""
        For NewCount = 0 to LineCount - 1
         DelimiterStart = Instr(DataArray(NewCount), "*=*")
         If ObjectName <> Left(DataArray(NewCount), DelimiterStart - 1) Then
			CookieFileWriteLine(DataArray(NewCount))
         Else
			OriginalObjectExists = "Yes"
	  End If
    Next
    CookieFileClose  websess
 end Function

Function CreateHiddenElements 
'*************************************************************** 
'* 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. 
'****************************************************************** 
dim websess
websess=Getwebsess
Response.Write "<INPUT TYPE=""hidden"" NAME=" & Chr(34) & "websess" & Chr(34) & " VALUE=" & Chr(34) & websess & Chr(34) & ">" & vbcrlf 
End Function          

'*************************************************************** 
'* Purpose:                
'*  Takes cart array and turns into astring delimited by |
'*  writes string to cookie file
'****************************************************************** 
Sub ResponseCookiesCart (field, value)
dim expires
dim cartcount, arrcount, dataarea, j, countkeyname
dim keyname, deliveryvalue
dim i
dim cartattributes
cartattributes=cMaxCartAttributes
cartcount=getsess("CartCount")
if cartcount="" then exit sub
if cartcount=0 then exit sub
for i = 1 to cartcount
     dataarea=""
     for j = 1 to cartattributes
         If j=cDelivery then 
            CookieSavedelivery value(j, i), deliveryvalue
            dataArea= dataarea & deliveryvalue & "|"
         else      
            dataArea= dataarea & value(j, i) & "|"
         end if   
     next
 
     keyname= field & cstr(i)
    ' debugwrite keyname & " " & dataarea & " " & cookiekey
     Responsecookies keyname,dataarea
next
countkeyname="CartCount"     
Responsecookies countkeyname,cartcount
end sub

'*************************************************************** 
'* Purpose:                
'*  Takes string version of cart array and turns into an array
'****************************************************************** 
Sub RequestCookieCart (field, value, rc)
dim  arrcount, dataarea, Temparray(22), tempcount
dim arrcart, cartcount, deliveryvalue
dim i, j, keyname, countkeyname
dim cartattributes
cartattributes=cMaxCartAttributes
rc=0
ReDim arrcart(cartAttributes,getconfig("xmaxCartItems"))
value=arrcart
countkeyname="CartCount"
cartcount=Requestcookies(countkeyname)     
If cartcount="" or Cartcount=0 then
    rc=4
    value=arrcart
    exit sub
end if 
'ReDim arrcart(cartAttributes,getconfig("xmaxCartItems"))
'value=arrcart
for i = 1 to cartcount
     keyname= field & cstr(i)
     dataarea=Requestcookies(keyname)
 '    debugwrite "dataarea=" & dataarea
     ParseRecord dataarea, TempArray, tempcount, "|"
     for j = 1 to cartAttributes-1
         If j=cDelivery then 
            CookieRestoredelivery temparray(j-1), deliveryvalue
            value(j,i) = deliveryvalue
         else   
           value(j,i)= temparray(j-1)
         end if  
     next
next     
end sub

'*************************************************************** 
'* Purpose: find the current websess.
'* Hopefully it exists on form, querystring or session variable               
'*  Takes string version of cart array and turns into an array
'****************************************************************** 
Function Getwebsess
dim userid
userid=session("websess")
if userid="" then
   userid=request("websess")
   if userid="" then
      userid=websessvalue                    ' last resort gateway put something here
      if userid="" then 
        userid=assignwebsess
      end if 
   end if
end if
session("websess")=userid       
getwebsess=userid
end function
'
'*************************************************************** 
'* Purpose:                
'*  Takes and array, turns into a string and saves string as a cookie
'****************************************************************** 
Sub ResponsecookiesArray (field, value)
dim dataarea, key, keycount,i, newvalue
key = field
if ucase(key)="CARTARRAY"  then
    ResponsecookiesCart field, value
    exit sub
end if
keycount=ubound(value)
dataarea=""
for i = 0 to keycount
   dataarea=dataarea & value(i) & "|"
next
Responsecookies field,dataarea
end sub

Function GetCookiepath
end function

'
Function DeleteCookieData
'****************************************************
'*                                                  *
'*   Purpose:                                       *
'*             Deletes entire file	*
'*                                                  *
'****************************************************
        If xusefilesession<>"Yes" then exit function
	Dim FileSO
	dim websess					'File System Object
	Dim CookiePath				'Path to directory containing reference files
	Dim CookieFile				'File of unique id and name/value pairs
	Dim CookieFileText			'Text of the file
	Dim LineCount				'Number of rows of text
	Dim DelimiterStart			'Location of the delimiting string: *=*
	Dim NewCount				'Row count for new file
	Dim OriginalObjectExists	'Flag to determine if object was in file
	Dim DataArray()				'Array to contain file contents
	websess=getwebsess
	cookiesql="delete from sitesessions where sessionkey=" & websess
        cookieopendatabase cookiedbc
        cookiedbc.execute(cookiesql)
        shopclosedatabase cookiedbc 	
End Function


Sub CookieRestoreDelivery (istring, deliveryarray)
deliveryarray=""
If getconfig("xdeliveryAddress")<>"Yes" then exit sub
If istring=""  then exit sub
istring=replace(istring,"!",deliverydelimiter)
ConvertDeliveryToArray DeliveryArray, istring
end sub

Sub CookieSaveDelivery (deliveryarray, returnvalue)
returnvalue=""
If getconfig("xdeliveryAddress")<>"Yes" then exit sub
If not isarray(deliveryarray) then exit sub
ConvertDeliveryToString DeliveryArray, returnvalue
returnvalue=replace(returnvalue,deliverydelimiter,"!")
end sub

'***************************************************************************
' parse long string into an array
'*************************************************************************
Sub Cookiecreatearray  (words, wordcount, record)
Dim pos 
Dim recordl
Dim temprec
Dim maxwords
Dim i
Dim maxentries
dim finished
dim length
dim fieldvalue, delimstart

maxwords=Cookiefindoccurances(record, cookiedelimiter)
maxwords=maxwords+10
redim words(maxwords)
temprec = record
finished=false
pos = 1
wordcount = 0
' make sure word array is null
maxentries = UBound(words)
For i = 0 To maxentries - 1
   words(i) = ""
Next
recordl = Len(temprec)
Do
   delimstart=instr(pos,temprec,cookiedelimiter)
   If delimstart>0 then 
     length=delimstart-pos
     fieldvalue=mid(temprec,pos, length)
     words(wordcount) = fieldvalue
     pos = delimstart+2
     wordcount = wordcount + 1
   else  
     If Pos<recordl then 
        length=recordl-pos+1
        fieldvalue=mid(temprec,pos, length)
        words(wordcount) = fieldvalue
          wordcount = wordcount + 1
     end if
     finished=true   
   end if   
   If wordcount > maxentries Then Exit Sub
Loop Until finished=true
End Sub


Sub CookieOpenDataBase (connection)
dim databasetype
databasetype=ucase(xdatabasetype)
If databasetype="" or databasetype="DRIVE" then
  CookieProcessAccessOpen connection
  exit sub
end if
if databasetype="ODBC" then
   cookieProcessODBC connection
    exit sub
end if
if databasetype="SQLSERVER" then
   cookieProcessSQLServer connection
   exit sub
end if 
if databasetype="MYSQL" then
   cookieProcessMYSQLServer connection
   exit sub
end if 
if databasetype="MYSQL351" then
   cookieProcessMYSQLServer connection
   exit sub
end if 
end sub
'******************************************************
' Open Access Database
Sub cookieProcessAccessOpen(connection)
dim dblocation
dim strconn
dim database
database=xdatabase & ".mdb"          ' database name
dblocation=xdblocation
If dblocation<>"" then
     database = dblocation & "\" & database
end if
if ucase(xdatabasetype)="DRIVE" Then 
  If xAccessOle<>"Yes" then 
    strconn = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & database
  else
   strconn = "provider=Microsoft.ACE.OLEDB.12.0;persist security info=false;data source=" & database
  end if    
else
 If xAccessole<>"Yes" then   
  strconn = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & Server.MapPath(database)
 else
   strconn = "provider=Microsoft.ACE.OLEDB.12.0;persist security info=false;data source="  & Server.MapPath(database)
 end if  
end if  
Set connection = Server.CreateObject("ADODB.Connection")
'on error resume next
If xsqlpwd="" then 
  connection.open strConn
else
    connection.open strConn,xsqluser,xsqlpwd
end if    
End Sub

'******************************************************************************
Sub cookieProcessODBC (connection)
dim strconn
Set connection = Server.CreateObject("ADODB.Connection")
strconn=xdatabase
connection.open strConn
end sub
'******************************************************
' Open SQL Server
Sub CookieProcessSqlServer(connection)
Set connection = Server.CreateObject("ADODB.Connection")
Dim varServerIP, varUserName, varPassword, varDataBaseName
dim strconn
varServerIP = xSQLServer
varUserName = xSQLUser
varPassword = xSQLPwd
varDataBaseName = xdatabase
If xSQLOLEDB="Yes" then 
  strconn="Provider=sqloledb;" & "Source=" & varServerIP & ";" & "database=" & varDataBaseName & ";" & "UID=" & varUserName & ";" &  "Password=" & varPassword & ";" 
else  
  strconn= "DRIVER={SQL Server}; Server=" & varServerIP & "; Database=" & varDataBaseName & "; UID=" & varUserName & "; PWD=" & varPassword'
end if  
Connection.Open strconn
end sub
'
'******************************************************
' Open MYSQL 
Sub cookieProcessMYSqlServer(connection)
Set connection = Server.CreateObject("ADODB.Connection")
Dim varServerIP, varUserName, varPassword, varDataBaseName
varServerIP = xSQLServer
varUserName = xSQLUser
varPassword = xSQLPwd
varDataBaseName = xdatabase
dim mysqlconn
on error resume next
'debugwrite "DRIVER={MySQL}; Server=" & varServerIP & "; Database=" & varDataBaseName & "; UID=" & varUserName & "; PWD=" & varPassword'
if ucase(xdatabasetype)="MYSQL351" then
     mysqlconn="DRIVER={MYSQL ODBC 3.51 Driver};"
else
     mysqlconn="DRIVER={MySQL}; "
end if
mysqlconn=mysqlconn &  " Server=" & varServerIP & "; Database=" & varDataBaseName & "; UID=" & varUserName & "; PWD=" & varPassword        
Connection.Open mysqlconn
end sub

'*************************************************************************
' how man session variables do we have
'*************************************************************************
function Cookiefindoccurances(inputstring, findstring)
'Returns the number of occurances of findstring that exist in the input string
dim i, pos, findcounter
pos=0
findcounter=0
i=1
do while i < len(inputstring) 
  pos=instr(i, inputstring,findstring)
  if pos>0 then 
   findcounter=findcounter+1
   i=pos+len(findstring)
  else
   'no more occurances found, end loop
   i=len(inputstring)+1
  end if
loop
cookiefindoccurances=findcounter+1

end function
%>