Domino ReadViewEntries agent


Sub Initialize
	On Error Goto ErrorHandler
	Dim session As New NotesSession
	Dim thisDb As NotesDatabase
	Dim thisDoc As NotesDocument
	Dim searchDoc As NotesDocument
	Dim view As NotesView
	Dim entry As NotesViewEntry
	Dim nav As NotesViewNavigator
	Dim nvec As notesviewEntryCollection
	Dim cols As Integer, i As Integer
	Dim l As Long, j As Long
	Dim qs As String, vw As Variant , q As Variant
	Dim start As Variant, count As Variant
	Dim startkey As Variant
	Dim tdbname As Variant
	Dim db As NotesDatabase	

	Print "Content-type: text/xml"
	Print "Pragma: no-cache"
	Print {}
	Set thisDb = session.CurrentDatabase
	Set thisDoc = session.DocumentContext
	qs = thisdoc.Query_String_Decoded(0)
	start = Evaluate( {@Middle("} & qs & {";"start=";"&")}, thisDoc )
	startkey = Evaluate( {@Middle("} & qs & {";"startkey=";"&")}, thisDoc )
	count = Evaluate( {@Middle("} & qs & {";"count=";"&")}, thisDoc )
	vw = Evaluate( {@Middle("} & qs & {";"view=";"&")}, thisDoc )
	tdbname = Evaluate( {@Middle("} & qs & {";"db=";"&")}, thisDoc )

	Set db = session.GetDatabase("", tdbname(0))
	Set view = db.GetView( vw(0) )
	Set nav = view.CreateViewNav
	Set entry = nav.GetFirstDocument
	Set nvec = view.AllEntries
	cols = Ubound( view.Columns )-1
	Dim headers As Variant
	Redim headers(0) 'build array of headers
	Forall c In view.Columns
		Redim Preserve headers(i)
		headers(i) = XMLEncode(c.title)
		i = i + 1
	End Forall
	j = nvec.Count
	If startkey(0) <> "" Then
		Set searchDoc=view.GetDocumentByKey(startkey, False)
		Set entry = nvec.GetEntry(searchDoc)
	Else
		Set entry = nvec.GetNthEntry(start(0))
		l = start(0)
	End If
	Print {}
	l = Cint(entry.GetPosition("."))
	For viewitem = 1 To count(0)
		If entry Is Nothing Then Exit For
		Print {}
		l = l + 1
		i = 0
		Forall v In entry.columnvalues
			Print {}
			Print { } & XMLEncode(Cstr(v)) & { }
			Print { }
			i = i + 1
		End Forall
		Print {}
		Set entry = nvec.GetNextEntry(entry)
	Next
	Print {} 'done
	Exit Sub
ErrorHandler:
	Print "error: " & Error & " on line " & Erl
	Exit Sub
End Sub

Function XMLEncode (inputStr As String) As String
	Dim i As Integer
	Dim outputStr As String
	Dim char As String
	For i = 1 To Len(inputStr)
		char = Mid$(inputStr, i, 1)
		If Asc(char) > 31 And Asc(char) < 127 Then
			Select Case char
			Case "&": outputStr = outputStr & "&amp;"
			Case "<": outputStr = outputStr & "&lt;"
			Case ">": outputStr = outputStr & "&gt;"
			Case "'": outputStr = outputStr & "&apos;"
			Case |"|: outputStr = outputStr & "&quot;"
			Case Else: outputStr = outputStr & char
			End Select
		Else
			outputStr = outputStr & "&#" & Asc(char) & ";"
		End If
	Next
	XMLEncode = outputStr
End Function