<%
const cookieDelimiter="!+"     ' data delimiter 
const cookielesstrace="No"
const cookielessdbtrace="No"  ' performance tracing
const xsavesessdualmode="Yes"  ' Use real sesion variables with site sessions
const xsavesessionfile="No"   ' use real physical file
const cookienullvalue="**NULL**" '
const xsavesessionfilefolder="c:\webs\vpasptest650\sessions"   ' use real physical file
'
dim cookieRS, cookiesql
dim cookiemsg
dim websessvalue             ' used in gateway returns
dim cookiedbc
'*****************************************************
' VP-ASP 6.50  Used to replace Microsoft Session variables
' Dec 3, 2006
' The session variabes are saved in a database table called site sessions
' The key is a random number called websess
' The key can be passed on a querystring, hidden field. It is not found then
' look in session variable websess
' next look in cookie websess
' last look in a physical file ipaddress_mmddyyyy.txt
'*****************************************************
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
     cookieFiledbtrace  "$session_assignwebsess"
     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

'*****************************************************************
' create a new entry in sitesessions table
' The string has been created already
'*****************************************************************
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 & ")"
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
	'on error resume next
	websess=Getwebsess
	lvaluename=lcase(valuename)
	cookieFiledbtrace  "$session_write"
	cookieopendatabase cookiedbc
	cookiesql="Select * from sitesessions where sessionkey='" & websess & "'"
	'debugwrite sql
	set cookiers=cookiedbc.execute(cookiesql)
	if not cookiers.eof then
	   sessionvalue=cookiers("sessionvalue")
	   Cookiecreatearray  dataarray, linecount, sessionvalue 
	else
	  shopclosedatabase cookiedbc
	  websess=getwebsessForce
	  shopinit
	  shoperror "session has been lost. Please continue"
	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=""
	cookieFiledbtrace  "$session_read"
	'debugwrite "session request" & objectname
	'on error resume next
        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
	  shopclosedatabase cookiedbc
	  websess=getwebsessForce
	  shopinit
	  shoperror "session has been lost. Please continue"
	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))
              'debugwrite "found=" & objectvalue & " length=" & len(objectvalue)
              found=true
              Exit for
         End If
       next
       If found=True then
         Requestcookies = ObjectValue
       else
         'debugwrite "Notfound " & objectname
         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 "Record 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
cookieFiledbtrace  "$session_writecart"
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
cookieFiledbtrace  "$session_readcart"
ReDim arrcart(cartAttributes,getconfig("xmaxCartItems"))
value=arrcart
countkeyname="CartCount"
cartcount=Requestcookies(countkeyname)
'debugwrite "cartcount=" & server.htmlencode(cartcount)     
rc=4
value=arrcart
if cartcount="" then exit sub
if cartcount=0 then exit sub
'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:                
'*  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 DeleteCookieData
'****************************************************
'*                                                  *
'*   Purpose:                                       *
'*             Deletes entire file	*
'*                                                  *
'****************************************************
        If xsavesession<>"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
If xsavesessiondatabase="" then
  database=xdatabase & ".mdb"          ' database name
else
  database=xsavesessiondatabase & ".mdb"
end if    
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
'*****************************************************************************
' the web session is known. We save it so we can find it agaian
' save as session variable and real cookie
'*****************************************************************************
sub SaveSessionVariable (userid)
dim filename, cookiename
' save it in session variable
session("websess")=userid
cookiename="websess_" & xshopid        ' so two different sites do not intefere
' save as real cookie
if xsavesessioncookie="Yes" then 
 response.cookies(cookiename)=userid
 response.cookies(cookiename).expires=date()+clng(xsavesessexpirydays)
end if 
' save in physical file
if xsavesessionfile="Yes" then
   cookielessGenerateFilename  filename
   CookielessWritefile userid, filename
end if   

end sub

'******************************************************************************
' filename= datetime_mmddyy_hhmmss.txt
'*****************************************************************************
Sub cookielessGenerateFilename (filename)
dim prefix, mm,yy,dd, today, hh, nn, ss, tempname
dim ipaddress
ipaddress=request.servervariables("REMOTE_HOST")
today=now()
prefix="websess_" & xshopid
mm=datepart("m",today)
dd=datepart("d",today)
yy=Datepart("yyyy",today)
hh=Datepart("h",today)
If len(mm)=1 then mm= "0" & mm
if len(dd)=1 then dd= "0" & dd
if len(hh)=1 then hh = "0" & hh
tempname=prefix & "_" & mm & dd & yy & "_" & Ipaddress
tempname=tempname & ".txt"
tempname=xsavesessionfilefolder & "\" & tempname
'debugwrite tempname
filename=tempname
end sub

Sub CookielessWriteFile ( userid, filename)
dim fso, myfile, rc
Set fso = CreateObject("Scripting.FileSystemObject")
'on error resume next
Set Myfile = fso.OpenTextFile(filename, 2, True)
'debugwrite filename
if err.number> 0 then
    ' debugwrite filename
     'debugwrite  "<b>" &  getlang("LangExportOpen")  & "<br>" & err.description & "</b>"
     rc=4
else
     MyFile.writeline userid
     rc =0
end if
myfile.close
set myfile=nothing
set fso=nothing
end sub

Sub CookielessreadFile ( userid, filename)
dim fso, myfile, rc
'debugwrite "filename=" & filename
Set fso = CreateObject("Scripting.FileSystemObject")
'on error resume next
Set Myfile = fso.OpenTextFile(filename, 1, false)
if err.number> 0 then
     response.write "<b>" &  "unable to open file" & filename  & "<br>" & err.description & "</b>"
     rc=4
else
     userid=myfile.readline
     'debugwrite "read " & userid
     rc =0
end if
myfile.close
set myfile=nothing
set fso=nothing
end sub
'*************************************************************************
' try to find websess by reading a file
'************************************************************************
Function Requestcookiefile 
dim userid, filename
cookielessGenerateFilename filename
CookielessreadFile  userid, filename
if cookielesstrace="Yes" then 
  debugwrite "readcookfile returned " &  userid & " from " & filename
end if  
requestcookiefile=userid
end function


'*************************************************************** 
'* 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
' This has been totally rewriiten to find websess.
' It could be in:
' session variables if cookies are enabled and no web farm swtich
' It could be on querystring if passed
' it could be on a hidden field
' It could be a real cookie
' If file cookies are used, it could be in a physical file 
' If we cannot find it, then we create a new web session using assignwebsess
'****************************************************************** 
Function Getwebsess
dim userid, cookiename
' Try session variable
userid=session("websess")            ' is it  areal session variable
if userid<>"" then
  getwebsess=userid
   exit function
end if   
' Try querystring or hidden field

'VP-ASP 6.50 - precautionary security fix
userid=cleanchars(request("websess"))

if userid<>"" then
   getwebsess=userid
   exit function
end if   
' Try real cookie
cookiename="websess_" & xshopid        ' so two different sites do not intefere
userid=request.cookies(cookiename)
if userid<>"" then
  ' debugwrite "read cookie " & cookiename & " value=" & userid
   CookielessReloadSession userid    ' if whole session is load reload all variables
   getwebsess=userid
   session("websess")=userid
   exit function
end if   
' Try cookie in a file
If xsavesessionfile="Yes" then      ' must be configired to try physical file 
  userid=requestcookiefile          ' try and find it  
  if userid<>"" then                ' did we get it
   CookielessReloadSession userid    ' if whole session is load reload all variables
   session("websess")=userid
   getwebsess=userid                ' return value
   exit function
  end if  
end if   
' someone stored it away such as gateway
userid=websessvalue                    ' last resort gateway put something here
if userid<>"" then
   getwebsess=userid
   session("websess")=userid
   exit function
end if   
userid=assignwebsess           ' need to assign a new web sess
if cookielesstrace="Yes" then
   debugwrite "New websess created " &  userid
end if   
SaveSessionVariable userid     ' save it away as cookie or file
getwebsess=userid
exit function
end function
'************************************************************************
'lost database, need to assign a new websess
'************************************************************************
Function GetWebSessForce
dim userid
userid=assignwebsess           ' need to assign a new web sess
if cookielesstrace="Yes" then
   debugwrite "New websess created " &  userid
end if   
SaveSessionVariable userid     ' save it away as cookie or fil
getwebsessforce=userid
end function
'******************************************************************************
' trace number of times an event occurs
'****************************************************************************
Sub cookieFiledbtrace  (keyword)
dim tempcount
tempcount=session(keyword)
if tempcount="" then tempcount=0
tempcount=tempcount+1
session(keyword)=tempcount
end sub
'******************************************************************************
' this is an optimization
' if using dual mode and the websess had to be found via cookie or file
' we probabaly have lost everything.  So reload all session variables from
' database
'******************************************************************************
Sub CookielessReloadSession (websess)
	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 CurrentValue		'Value of current object
	dim sessionvalue, dataArray, Linecount, i, found
	dim lobjectname
	If xsavesessdualmode<>"Yes" then exit sub
	cookieFiledbtrace  "$session_reloadsessionvariables"
        cookieopendatabase cookiedbc
        cookiesql="Select * from sitesessions where sessionkey='" & websess & "'"
        'debugwrite cookiesql
	set cookiers=cookiedbc.execute(cookiesql)
	if not cookiers.eof then
	   sessionvalue=cookiers("sessionvalue")
	   Cookiecreatearray  dataarray, linecount, sessionvalue 
	else
	  closerecordset cookiers
	  shopclosedatabase cookiedbc
	  exit sub
	end if
	closerecordset cookiers
	shopclosedatabase cookiedbc
' first two values are internal useri9d and date. no need to restore	
        for i = 2 to linecount-1
         CurrentData = dataArray(i)
         DataLength = Len(CurrentData)
         DelimiterStart = Instr(CurrentData, "*=*")
         CurrentName = Left(CurrentData, DelimiterStart - 1)
         Currentvalue= Right(CurrentData, DataLength - (DelimiterStart + 2))
  '       debugwrite currentname & "=" & currentvalue
         Session(currentname)=currentvalue
       next
       'debugwrite "reloaded session varaibles"
end sub       
%>