'WebSession: 

Option Public
Option Declare
Option Compare Nocase

' WebSession
' 2007-12-13 TKO Created from codestore.net example with many improvements.
' 2008-01-31 TKO Switched when an item is decoded to after spliting by equal sign instead of before.

' Used for global access. Initialized in the Initialize sub.
Dim web As Variant

' Used to define the data for the all, query string, cookie and form data lists.
Type webNameValue
	name As String
	value As String
End Type

Class WebSession 
	Public session As Notessession
	Private db As NotesDatabase
	Private curAgent As NotesAgent
	Private doc As NotesDocument
	'Only a user if "Run as web user"!
	Private webUser As NotesName
	Private dbPath As String
	' Added by TKO
	' List of all querystring items, cookies and form items
	Public items List As webNameValue
	' List of Query String items.
	Public QueryStringItems List As webNameValue
	' List of Cookie items.
	Public cookieItems List As webNameValue
	' List of form items.
	Public formItems List As webNameValue
	
	Sub New
		Set Me.session = New NotesSession
		Set Me.db = Me.session.CurrentDatabase
		Set Me.curAgent = Me.session.CurrentAgent
		Set Me.doc = Me.session.DocumentContext
		Set Me.webUser = New NotesName(Me.session.EffectiveUserName)
		Me.dbPath = "/" & Replace(Me.db.FilePath, "\", "/")
		' Added by TKO
		Call loadQueryString
		Call loadCookies
		Call loadFormItems
	End Sub
	
	Public Property Get Database As NotesDatabase
		Set Database = Me.db
	End Property
	
	Public Property Get Agent As NotesAgent
		Set Agent = Me.curAgent
	End Property
	
	Public Property Get Document As NotesDocument
		Set Document = Me.doc
	End Property
	
	Public Property Get User As NotesName
		Set User = Me.webUser
	End Property
	
	Public Property Get Path As String
		Path = Me.dbPath
	End Property
	
	Public Function getItemValue(sName As String) As String
		' Is the item in the list?
		If Not Iselement(Me.items(sName)) Then
			' No. Return blank.
			getItemValue = ""
			Exit Function
		End If
		
		' Return item value.
		getItemValue = Me.items(sName).value
	End Function
	
	' Return a Query String value.
	Public Function getQueryStringValue(sName As String) As String
		' Is the item in the list?
		If Not Iselement(Me.QueryStringItems(sName)) Then
			' No. Return blank.
			getQueryStringValue = ""
			Exit Function
		End If
		
		' Return item value.
		getQueryStringValue = Me.QueryStringItems(sName).value
	End Function
	
	' Used for compatibility with old programs.
	Public Function getQueryString(sName As String) As String
		getQueryString = Me.getQueryStringValue(sName) 
	End Function
	
	' Return a Cookie value.
	Public Function getCookieValue(sName As String) As String
		' Is the item in the list?
		If Not Iselement(Me.cookieItems(sName)) Then
			' No. Return blank.
			getCookieValue = ""
			Exit Function
		End If
		
		' Return item value.
		getCookieValue = Me.cookieItems(sName).value
	End Function
	
	' Return a posted form field's value.
	Public Function getFormValue(sName As String) As String
		' Is the item in the list?
		If Not Iselement(Me.formItems(sName)) Then
			' No. Return blank.
			getFormValue = ""
			Exit Function
		End If
		
		' Return item value.
		getFormValue = Me.formItems(sName).value
	End Function
	
	Public Function JSONEncode(s As String) As String
		JSONEncode = Replace(Replace(Replace(Replace(s, "\", "\\"),"""", "\"""), Chr(13), "\r"), Chr(10), "\n")
	End Function
	
	Public Function XMLEncode(s As String) As String
		XMLEncode = Replace(Replace(Replace(s, "&", "&amp;"), ">", "&gt;"), "<", "&lt;")
	End Function
	
	Public Function URLEncode(s As String) As String
		Dim retValue As Variant
		
		' The back slash "\" character is an escape character in Formula language. Escape "\" characters. 
		s = Replace(s, "\", "\\")
		retValue = Evaluate(|@URLEncode("Domino";"| & s & |")|)
		URLEncode = retValue(0)
	End Function
	
	Public Function URLDecode(s As String) As String
		Dim retValue As Variant
		
		' The back slash "\" character is an escape character in Formula language. Escape "\" characters. The @URLDecode
		' function does not convert "+" characters to space so do it here.
		s = Replace(Replace(s, "+", " "),"\", "\\")
		retValue = Evaluate(|@URLDecode("Domino";"| & s & |")|)
		URLDecode = retValue(0)
	End Function
	
	' Take the Query_String value and load it in the QueryStringItems list.
	Private Sub loadQueryString
		Dim items As Variant
		Dim item As Variant
		Dim sName As String
		Dim sValue As String
		Dim retValue As Variant
		
		' Resume next in case there is no value.
		On Error Resume Next
		' Each item is a URL encoded name=value pair separated by the "&" character.
		items = Split(Me.doc.Query_String(0), "&")
		Forall x In items
			' Separate the name and value.
			item = Split(x, "=")
			' Values are URL Encoded. "+" is a space, but @URLDecode doesn't decode "+".
			item(0) = Me.URLDecode(Cstr(item(0)))
			item(1) = Me.URLDecode(Cstr(item(1)))
			
			' Initialize name and value temporary variables.
			sName = ""
			sValue = ""
			
			' Get the name of the name/value pair.
			sName = Trim(item(0))
			If Left(sName, 4) = "amp;" Then
				sName = Trim(Mid(sName, 5))
			End If
			
			If sName <> "" Then
				' Get the value of the name/value pair. If there is no value resume next will continue.
				sValue = item(1)
				
				' Add the items to the list of all items.
				If  Iselement(Me.items(sName)) Then
					Me.items(sName).value = Me.items(sName).value + ";"  + sValue
				Else
					Me.items(sName).name = sName
					Me.items(sName).value = sValue
				End If
				
				' Add the items to the cookie list.
				If  Iselement(Me.QueryStringItems(sName)) Then
					Me.QueryStringItems(sName).value = Me.QueryStringItems(sName).value + ";"  + sValue
				Else
					Me.QueryStringItems(sName).name = sName
					Me.QueryStringItems(sName).value = sValue
				End If
			End If
		End Forall
	End Sub
	
	' Take the HTTP_Cookie value and load it in cookieItems list.
	Private Sub loadCookies
		Dim items As Variant
		Dim item As Variant
		Dim sName As String
		Dim sValue As String
		Dim retValue As Variant
		
		' Resume next in case there is no value.
		On Error Resume Next
		' Each item is a URL encoded name=value pair separated by the ";" character.
		items = Split(Me.doc.HTTP_Cookie(0), ";")
		Forall x In items
			' Separate the name and value.
			item = Split(x, "=")
			' Decode the name/value pair. Make sure that we preserve plus "+" characters.
			item(0) = Me.URLDecode(Replace(item(0), "+", "%2B"))		
			item(1) = Me.URLDecode(Replace(item(1), "+", "%2B"))		
			
			' Initialize name and value temporary variables.
			sName = ""
			sValue = ""
			
			' Get the name of the name/value pair.
			sName = Trim(item(0))
			
			If sName <> "" Then
				' Get the value of the name/value pair. If there is no value resume next will continue.
				sValue = item(1)
				
				' Add the items to the list of all items.
				If  Iselement(Me.items(sName)) Then
					Me.items(sName).value = Me.items(sName).value + ";"  + sValue
				Else
					Me.items(sName).name = sName
					Me.items(sName).value = sValue
				End If
				
				' Add the items to the query string list.
				If  Iselement(Me.cookieItems(sName)) Then
					Me.cookieItems(sName).value = Me.cookieItems(sName).value + ";"  + sValue
				Else
					Me.cookieItems(sName).name = sName
					Me.cookieItems(sName).value = sValue
				End If
			End If
		End Forall
	End Sub
	
	' Take the REQUEST_CONTENT value and load it in formItems list.
	Private Sub loadFormItems
		Dim items As Variant
		Dim item As Variant
		Dim sName As String
		Dim sValue As String
		
		' Resume next in case there is no value.
		On Error Resume Next
		' Each item is a URL encoded name=value pair separated by the "&" character.
		items = Split(Me.doc.REQUEST_CONTENT(0), "&")
		Forall x In items
			' Separate the name and value.
			item = Split(x, "=")
			' Values are URL Encoded. "+" is a space, but @URLDecode doesn't decode "+".
			item(0) = Me.URLDecode(Cstr(item(0)))
			item(1) = Me.URLDecode(Cstr(item(1)))
			
			' Initialize name and value temporary variables.
			sName = ""
			sValue = ""
			
			' Get the name of the name/value pair.
			sName = Trim(item(0))
			
			If sName <> "" Then
				' Get the value of the name/value pair. If there is no value resume next will continue.
				sValue = item(1)
				
				' Add the items to the list of all items.
				If  Iselement(Me.items(sName)) Then
					Me.items(sName).value = Me.items(sName).value + ";"  + sValue
				Else
					Me.items(sName).name = sName
					Me.items(sName).value = sValue
				End If
				
				' Add the items to the form items list.
				If  Iselement(Me.formItems(sName)) Then
					Me.formItems(sName).value = Me.formItems(sName).value + ";"  + sValue
				Else
					Me.formItems(sName).name = sName
					Me.formItems(sName).value = sValue
				End If
			End If
		End Forall
		
	End Sub
	
End Class

Sub Initialize
	Set web = New WebSession()
End Sub