'Get Server File List: 

Option Public
Option Explicit

%REM
This is an agent that will prompt you for a server name,
and (given the server name) it will connect to that server,
try to get a list of all the databases on the server, and
write that list (along with lots of juicy information about
each database) to a comma-delimited file.

NOTE: You MUST have rights to run remote console commands
on the server you want to get a list of files from. Also,
I have only tested this on Domino 8 (not sure about how
backwards-compatible this technique is).

Version 1.0
Julian Robichaux
http://www.nsftools.com
14 Aug 2008
%END REM




'** Notes API calls to get a list of servers
Declare Function NSGetServerList Lib "nnotes" _
(Byval dwPortName As Long, nRetServerTextList As Integer) As Integer
Declare Function ListGetText Lib "nnotes" _
(Byval dwList As Long, Byval nPrefixDataType As Integer, _
Byval nEntryNumber As Integer, dwRetTextPointer As Long, _
nRetTextLength As Integer) As Integer
Declare Function OSTranslate Lib "nnotes" _
(Byval nTranslateMode As Integer, Byval dwIn As Long, _
Byval nLength As Integer, Byval lpszOut As String, _
Byval nOutLength As Integer) As Integer
Declare Function OSLockObject Lib "nnotes" (Byval nHandle As Integer) As Long
Declare Function OSUnlockObject Lib "nnotes" (Byval nHandle As Integer) As Integer
Declare Function OSMemFree Lib "nnotes" (Byval nHandle As Integer) As Integer

Const OS_TRANSLATE_LMBCS_TO_NATIVE = 1
Const MAX_SERVER_NAME = 256


Class DbInfoHolder
	Public PropertyList List As String
	Private xh As XmlHelper
	Private tempNode As NotesDOMNode
	Private tempNode2 As NotesDOMNode
	
	
	Public Sub New ()
		Set xh = New XmlHelper()
	End Sub
	
	
	Public Sub GetDbInfo (node As NotesDOMNode)
		Erase PropertyList
		
		On Error Resume Next
		PropertyList("Title") = xh.getNodeText(xh.findFirstChildNode(node, "title"))
		PropertyList("FileName") = xh.getNodeText(xh.findFirstChildNode(node, "name"))
		PropertyList("FilePath") = xh.getNodeText(xh.findFirstChildNode(node, "path"))
		PropertyList("Template") = xh.getNodeText(xh.findFirstChildNode(node, "template"))
		PropertyList("ParentTemplate") = xh.getNodeText(xh.findFirstChildNode(node, "inheritedtemplate"))
		PropertyList("Title") = xh.getNodeText(xh.findFirstChildNode(node, "title"))
		PropertyList("CreationDate") = getDateString(xh.getNodeText(xh.findFirstChildNode(node, "created")))
		PropertyList("LastFixup") = getDateString(xh.getNodeText(xh.findFirstChildNode(node, "lastfixup")))
		
		PropertyList("NotesVersion") = xh.getAttributeText(node, "notesversion")
		PropertyList("ODSVersion") = xh.getAttributeText(node, "odsversion")
		PropertyList("Logged") = xh.getAttributeText(node, "logged")
		PropertyList("Backup") = xh.getAttributeText(node, "backup")
		PropertyList("NotesVersion") = xh.getAttributeText(node, "notesversion")
		PropertyList("Link") = xh.getAttributeText(node, "link")
		PropertyList("DBOptions") = xh.getAttributeText(node, "dboptions")
		
		Set tempNode = xh.findFirstChildNode(node, "replica")
		PropertyList("ReplicaID") = xh.getAttributeText(tempNode, "id")
		PropertyList("ReplicaFlags") = xh.getAttributeText(tempNode, "flags")
		PropertyList("ReplicaCount") = xh.getAttributeText(tempNode, "count")  '** how many of this replica on the server
		Set tempNode2 = xh.findFirstChildNode(tempNode, "cutoff")
		PropertyList("DelStubCutoff") = xh.getAttributeText(tempNode2, "interval")  '** Remove docs not modified in last # days
		PropertyList("DelStubLastDate") = getDateString(xh.getNodeText(tempNode2))  '** Replica includes deletion stubs for docs deleted since
		
		Set tempNode = xh.findFirstChildNode(node, "size")
		PropertyList("CurrentSize") = xh.getAttributeText(tempNode, "current")
		PropertyList("MaxSize") = xh.getAttributeText(tempNode, "max")
		PropertyList("SizeUsed") = xh.getAttributeText(tempNode, "usage")
		
		Set tempNode = xh.findFirstChildNode(node, "quota")
		PropertyList("QuotaLimit") = xh.getAttributeText(tempNode, "limit")
		PropertyList("QuotaWarning") = xh.getAttributeText(tempNode, "warning")
		
		Set tempNode = xh.findFirstChildNode(node, "unread")
		PropertyList("UnreadMarks") = xh.getAttributeText(tempNode, "marks")
		PropertyList("UnreadMarksReplication") = xh.getAttributeText(tempNode, "replicate")
	End Sub
	
	
	Public Function getDateString (ts As String) As String
		'** xmlDateString will be a format similar to this:  20080814T151541,26-04
		On Error Goto processError
		Dim timestring As String
		Dim offset As String
		
		timestring = Left(ts, 4) + "/" + Mid(ts, 5, 2) + "/" + Mid(ts, 7, 2) + " " + _
		Mid(ts, 10, 2) + ":" + Mid(ts, 12, 2) + ":" + Mid(ts, 14, 2) + " GMT"
		offset = Right(ts, 3)
		If (Left(offset, 1) <> "-") Then
			offset = Right(offset, 2)
		End If
		
		Dim dt As New NotesDateTime(timestring)
		Call dt.AdjustHour( (-1) * Cint(offset) )
		getDateString = Format(dt.GMTTime, "yyyy-mm-dd hh:nn:ss GMT")
		Exit Function
		
processError:
		Exit Function
	End Function
	
	
	Public Function GetCsvHeader () As String
		If Not Iselement(PropertyList("Title")) Then
			Call GetDbInfo(Nothing)
		End If
		
		Dim header As String
		Dim sep As String
		Forall stuff In PropertyList
			header = header & sep & |"| & Listtag(stuff) & |"|
			sep = ","
		End Forall
		
		GetCsvHeader = header
	End Function
	
	
	Public Function toString () As String
		Dim info As String
		Dim sep As String
		Forall stuff In PropertyList
			info = info & sep & |"| & Replace(stuff, |"|, |""|) & |"|
			sep = ","
		End Forall
		
		toString = info
	End Function
	
End Class


Class XmlHelper
	Function getNodeText (node As NotesDOMNode) As String
		'** get the text of the given node
		Dim child As NotesDOMNode
		Dim childText As String
		
		If (node Is Nothing) Then
			Exit Function
		Elseif (node.IsNull) Then
			Exit Function
		End If
		
		Set child = node.FirstChild
		Do Until (child.IsNull)
			If (child.NodeType = DOMNODETYPE_TEXT_NODE) Then
				childText = childText + child.NodeValue
			Elseif (child.NodeType = DOMNODETYPE_CDATASECTION_NODE) Then
				childText = childText + child.NodeValue
			End If
			Set child = child.NextSibling
		Loop
		
		getNodeText = childText
	End Function
	
	
	Function getAttributeText (node As NotesDOMNode, attrName As String) As String
		'** get the text of a given attribute
		Dim attrList As NotesDOMNamedNodeMap
		Dim attr As NotesDOMNode
		Dim attrValue As String
		Dim i As Integer
		
		If (node Is Nothing) Then
			Exit Function
		Elseif (node.IsNull) Then
			Exit Function
		End If
		
		Set attrList = node.Attributes
		
		For i = 1 To attrList.NumberOfEntries
			Set attr = attrList.GetItem(i)
			If (attr.NodeName = attrName) Then
				attrValue = attr.NodeValue
			End If
		Next
		
		getAttributeText = attrValue
	End Function
	
	
	Function findFirstChildNode (node As NotesDOMNode, childName As String) As NotesDOMNode
		'** get the first child node with the given name
		Set findFirstChildNode = findChildNode(node, childName, 1)
	End Function
	
	
	Function findChildNode (node As NotesDOMNode, childName As String, count As Integer) As NotesDOMNode
		'** get the child node with the given name at the given position
		Dim child As NotesDOMNode
		Dim i As Integer
		
		If (node Is Nothing) Then
			Exit Function
		Elseif (node.IsNull) Then
			Exit Function
		End If
		
		Set child = node.FirstChild
		Do Until (child.IsNull)
			If (child.NodeName = childName) Then
				i = i + 1
				If (i >= count) Then
					Exit Do
				End If
			End If
			Set child = child.NextSibling
		Loop
		
		Set findChildNode = child
	End Function
	
End Class



Function GetServerList() As Variant
	'** via http://www-10.lotus.com/ldd/46dom.nsf/0/ED924E775FB3B81785256C3A002DF1E3
	Dim lpszServer As String
	Dim szArray As Variant
	Dim hList As Integer
	Dim nStatus As Integer
	Dim nCount As Integer
	Dim nLength As Integer
	Dim dwList As Long
	Dim dwHold As Long
	Dim sName As NotesName
	
	' get a list of known servers on all ports
	nStatus%=NSGetServerList(0, hList%)
	
	' be sure our API call returned a handle to our list buffer
	If nStatus%=0 And hList% <> 0 Then
		' initialize our results array
		Redim szArray(0)
		
		' lock down our memory handle
		dwList&=OSLockObject(hList%)
		
		Do While nStatus%=0
			' get a server in the list
			nStatus%=ListGetText(dwList&, 0, nCount%, dwHold&, nLength%)
			
			If nStatus%=0 And nLength%>0 Then
				' intialize the string to pass to the API
				lpszServer$=Space$(nLength%)
				
				' translate the results to the native charset
				Call OSTranslate(OS_TRANSLATE_LMBCS_TO_NATIVE, dwHold&, nLength%, lpszServer$, MAX_SERVER_NAME)
				
				'populate an array with the results
				Redim Preserve szArray(nCount)
				Set sName = New NotesName(lpszServer$)
				szArray(nCount)=sName.Abbreviated
			End If
			
			nCount=nCount+1
			
		Loop
		
		' free our lock on the list
		Call OSUnlockObject(hList%)
		
		' free the handle allocated by NSGetServerList
		Call OSMemFree(hList%)
		
	End If
	
	' return results to caller
	GetServerList=szArray
	
End Function 


Sub Initialize
	'** NOTE: You MUST have rights to run remote console commands
	'** on the server you want to get a list of files from.
	On Error Goto processError
	
	'** choose a server
	Dim workspace As New NotesUIWorkspace
	Dim response As Variant
	Dim serverName As NotesName
	Dim serverList As Variant
	
	serverList = GetServerList
	If Isempty(serverList) Then
		response = workspace.Prompt (PROMPT_OKCANCELEDIT, _
		"Server List Not Available", _
		"Server list not found. Please enter a server name below:")
	Else
		response = workspace.Prompt (PROMPT_OKCANCELEDITCOMBO, _
		"Select a Server", _
		"Select a server to get a list of databases from (choose from the list or enter your own).", _
		serverList(0), serverList)
	End If
	
	If Isempty (response) Then
		Messagebox "You clicked cancel. Exiting..."
		Exit Sub
	Else
		Set serverName = New NotesName(response)
	End If
	
	'** choose a file
	response = workspace.SaveFileDialog(False,"Output File Name", _
	"Comma-Delimited Files|*.csv", _
	"", "C:\Database List For " & serverName.Common & ".csv")
	
	If Isempty (response) Then
		Messagebox "You clicked cancel. Exiting..."
		Exit Sub
	End If
	
	'** set up the file we're outputting to
	Dim fileName As String
	Dim fileNum As Integer
	fileName = response(0)
	fileNum = Freefile
	Open fileName For Output As fileNum
	Print #fileNum, "Database List For " & serverName.Abbreviated
	Print #fileNum, ""
	
	Dim dbInfo As New DbInfoHolder
	Print #fileNum, dbInfo.GetCsvHeader
	
	'** run a remote console command to the server to get the list of files
	Dim session As New NotesSession
	Dim commandString As String
	Dim returnString As String
	
	'** call the console command on the selected server, using the "-xml" switch
	'** to return the output as XML
	commandString = "show dir -xml"
	returnString = session.SendConsoleCommand(serverName.Abbreviated, commandString)
	
	'** if we got some output, try to process it as XML
	Dim xHelper As New XmlHelper()
	Dim inputStream As NotesStream
	Dim outputStream As NotesStream
	Dim domParser As NotesDOMParser
	Dim docNode As NotesDOMDocumentNode
	Dim fileNode As NotesDOMNode
	Dim dbNode As NotesDOMNode
	
	'** load it up into a DOM parser
	Set inputStream = session.CreateStream
	Call inputStream.WriteText(returnString)
	inputStream.Position = 0
	Set outputStream = session.CreateStream
	Set domParser=session.CreateDOMParser(inputStream, outputStream)
	domParser.Process
	
	'** all of the tasks should be contained within a single <files>
	'** node, as separate <filedata></filedata> entries.
	Set docNode = domParser.Document
	
	'** find the <files> node
	Set fileNode = xHelper.findFirstChildNode(docNode, "files")
	
	'** if we didn't find anything, write the raw data to the file and exit
	If (fileNode.IsNull) Then
		Print #fileNum, "Sorry, I didn't find a <files> node. Here's what I found:"
		Print #fileNum, returnString
		Close #fileNum
		Print "Data not found. Please see " & fileName & " for details"
		Exit Sub
	End If
	
	'** get data from each of the <filedata> nodes
	Set dbNode = fileNode.FirstChild
	Do Until (dbNode.IsNull)
		If (dbNode.NodeType = DOMNODETYPE_ELEMENT_NODE) And _
		(dbNode.NodeName = "filedata") Then
			Call dbInfo.GetDbInfo(dbNode)
			Print #fileNum, dbInfo.toString()
		End If
		
		Set dbNode = dbNode.NextSibling
	Loop
	
	Close #fileNum
	Print "Finished! Server database list exported to " & fileName
	Exit Sub
	
	
processError:
	Dim msg As String
	msg = "Error " & Err & " on line " & Erl & ": " & Error
	
	If (fileNum > 0) Then
		Print #fileNum, msg
	End If
	
	Print msg
	Resume Next
End Sub