<%
' XSess.asp
' XSess passes an ASP session from one web server to another securely.

' If you have 2 sites - www.site1.com and www.site2.com - and 
' you have a visitor on www.site1.com with a session in progress, 
' you wish to pass the visitor to www.site2.com/page.asp
' and retain the session variables, use this script...

' Include this script in the launch script, and also place
' this script on the destination site.

' To transfer the user to www.site2.com/page.asp, call the 
' function as follows: XSess(xsesspath, destpath)
' where xsesspath is the path to THIS script on the destination
' destpath is the path to actual target URL on the destination
' eg Call XSess("http://www.site2.com/asp/xsess.asp", "/page.asp")

' Technical
' 1. The XSess function will encrypt all the session variables and 
' redirect to the remote script with this encrypted data.
' 2. The XSess2 function will decrypt the variables, set the  
' session variables, and redirect again to the target URL.
' Session arrays or objects are not supported
' more info: http://www.tele-pro.co.uk/scripts/

'-------------------------------------------------------------------------
' XSess.asp

'you can change this key to any unique string
Dim key1
key1 = "Lhn2trcS3zHmvktdq637cX8t3nXSXfyeip9znYyLubt4q4aqb"

'has data been sent?
'if so update session and redirect  
If Trim(request("xsessdestpath"))<>"" Then XSess2() 

FUNCTION XSess(xsesspath, destpath)
' pass this session to xsesspath, 
' xsesspath is the path to THIS script on the destination
Dim q
q = "xsessdestpath=" & hsh(destpath) & "&"
For Each s In Session.Contents
  If Not IsArray(Session(s)) Then
    q = q & hsh(s) & "=" & hsh(Session(s)) & "&"
  End If
Next
'redirect to xsesspath
Response.Redirect (xsesspath & "?" & q)
END FUNCTION

FUNCTION XSess2() 
Dim dest, a
'decrypt the query and set the session
for each a in Request.Querystring
  If (a<>"xsessdestpath") Then
    Session(dhsh(a)) = dhsh(Request.Querystring(a)) 
  Else
    dest = dhsh(Request.Querystring(a)) 
  End IF
next
'redirect to destination
Response.Redirect dest
END FUNCTION

'Supporting encryption functions:
 
FUNCTION hsh(h)
  hsh = Server.Urlencode(EncryptIt(h, key1))
END FUNCTION

FUNCTION dhsh(h)
  dhsh = DecryptIt(h, key1)
END FUNCTION

Function EncryptIt(it, key)
	Dim keylen, size, encryptstr, keymod, i
	keylen = Len(key)
	size = Len(it)
	encryptstr = ""
	On Error Resume Next
	For i = 1 To size Step 1
		keymod = (i Mod keylen) + 1
		encryptstr = encryptstr & Chr(Asc(Mid(it, i, 1)) + Asc(Mid(key, keymod, 1)))
	Next
	EncryptIt = encryptstr
End Function

Function DecryptIt(it, key)
	Dim keylen, size, decryptstr, keymod, i
	keylen = Len(key)
	size = Len(it)
	decryptstr = ""
    On Error Resume Next
	For i = 1 To size step 1
		keymod = (i MOD keylen) + 1
		decryptstr = decryptstr & Chr(Asc(Mid(it, i, 1)) - Asc(Mid(key, keymod, 1)))
	Next
	DecryptIt = decryptstr
End Function

%>