Option Public
Option Explicit

%REM
This is an agent that demonstrates how to get server or workstation
stats using Notes API calls. You will normally only get a handful of
stats if you run this on a workstation, so you should try it on a
server to get some meaningful results.

The undocumented API function Cmovmem is also used in this example 
(aliased as CopyBufferToString) in order to copy the contents of the
stat buffer that is returned over to a LotusScript string. While
undocumented functions are sometimes a little dangerous to use, this
one is pretty safe.

Julian Robichaux -- http://www.nsftools.com
%END REM


'** Notes statistic functions
Declare Function StatQuery Lib "nnotes" (Byval headerString As String, _
Byval namePrefix As String, Byval valuePrefix As String, Byval lineSuffix As String, _
rethStats As Long, retStatsLength As Long) As Integer

'** if you want to get all statistics for a given facility, use 0& as the statName;
'** otherwise, you can indicate a specific statistic (like Time.Current)
Declare Function StatQueryTime Lib "nnotes" (Byval facility As String, _
Byval statName As Any, Byval headerString As String, Byval namePrefix As String, _
Byval valuePrefix As String, Byval lineSuffix As String, rethStats As Long, _
retStatsLength As Long) As Integer

Const STATPKG_OS = "OS"
Const STATPKG_STATS = "Stats"
Const STATPKG_OSMEM = "Mem"
Const STATPKG_OSSEM = "Sem"
Const STATPKG_OSSPIN = "Spin"
Const STATPKG_OSFILE = "Disk"
Const STATPKG_SERVER = "Server"
Const STATPKG_REPLICA = "Replica"
Const STATPKG_MAIL = "Mail"
Const STATPKG_MAILBYDEST = "MailByDest"
Const STATPKG_COMM = "Comm"
Const STATPKG_NSF = "Database"
Const STATPKG_NIF = "Database"
Const STATPKG_TESTNSF = "Testnsf"
Const STATPKG_OSIO = "IO"
Const STATPKG_NET = "NET"
Const STATPKG_OBJSTORE = "Object"
Const STATPKG_AGENT = "Agent"
Const STATPKG_WEB = "Web"
Const STATPKG_CAL = "Calendar"
Const STATPKG_SMTP = "SMTP"
Const STATPKG_LDAP = "LDAP"
Const STATPKG_NNTP = "NNTP"
Const STATPKG_ICM = "ICM"
Const STATPKG_MONITOR = "Monitor"
Const STATPKG_POP3 = "POP3"

'** Notes memory functions
Declare Function OSLockObject Lib "nnotes.dll" (Byval objectHandle As Long) As Long
Declare Function OSUnlockObject Lib "nnotes.dll" (Byval objectHandle As Long) As Integer
Declare Function OSMemFree Lib "nnotes" (Byval handle As Long) As Integer

'** Undocumented Notes API function to copy a memory buffer to a String
Declare Sub CopyBufferToString Lib "nnotes.dll" Alias "Cmovmem"  _
(Byval lpSrc As Long, Byval lpDest As String, Byval lSize As Long)

'** if you want to copy to a non-String data type, use this parameter set
Declare Sub CopyBuffer Lib "nnotes.dll" Alias "Cmovmem"  _
(Byval lpSrc As Long, lpDest As Any, Byval lSize As Long)




Sub Initialize
	'** send stats to a text file -- must be run on a server to get any real data
	Dim newLine As String
	Dim fileNum As Integer
	Dim fileName As String
	Dim nError As Integer
	Dim statBuffer As Long
	Dim statBufferLen As Long
	Dim statArray(0 To 25) As String
	
	statArray(0) = STATPKG_OS
	statArray(1) = STATPKG_STATS
	statArray(2) = STATPKG_OSMEM
	statArray(3) = STATPKG_OSSEM
	statArray(4) = STATPKG_OSSPIN
	statArray(5) = STATPKG_OSFILE
	statArray(6) = STATPKG_SERVER
	statArray(7) = STATPKG_REPLICA
	statArray(8) = STATPKG_MAIL
	statArray(9) = STATPKG_MAILBYDEST
	statArray(10) = STATPKG_COMM
	statArray(11) = STATPKG_NSF
	statArray(12) = STATPKG_NIF
	statArray(13) = STATPKG_TESTNSF
	statArray(14) = STATPKG_OSIO
	statArray(15) = STATPKG_NET
	statArray(16) = STATPKG_OBJSTORE
	statArray(17) = STATPKG_AGENT
	statArray(18) = STATPKG_WEB
	statArray(19) = STATPKG_CAL
	statArray(20) = STATPKG_SMTP
	statArray(21) = STATPKG_LDAP
	statArray(22) = STATPKG_NNTP
	statArray(23) = STATPKG_ICM
	statArray(24) = STATPKG_MONITOR
	statArray(25) = STATPKG_POP3
	
	newLine = Chr(13) & Chr(10)
	
	'** open our text file
	fileNum = Freefile()
	fileName = "C:\TestStats.txt"
	Open fileName For Output As fileNum
	
	'** send a single stat to the text file using StatQueryTime
	nError = StatQueryTime (STATPKG_STATS, "Time.Start", "Start Time:" & newline, _
	"  ", Chr(9), newLine, statBuffer, statBufferLen)
	Print #fileNum, "GETTING SINGLE STAT USING StatQueryTime"
	If (nError = 0) Then
		Print #fileNum, GetBufferAsString(statBuffer, Cint(statBufferLen), 0, True)
	Else
		Print #fileNum, "API Error " & nError & " calling StatQueryTime"
	End If
	
	'** send all the individual stats to the text file using StatQueryTime
	Print #fileNum, "GETTING ALL STATS USING StatQueryTime"
	Forall stat In statArray
		nError = StatQueryTime (stat, 0&, "Statistics for " & stat & ":" & newLine, _
		"  ", Chr(9), newLine, statBuffer, statBufferLen)
		If (nError = 0) Then
			Print #fileNum, GetBufferAsString(statBuffer, Cint(statBufferLen), 0, True)
		Else
			Print #fileNum, "API Error " & nError & " calling StatQueryTime"
		End If
	End Forall
	
	'** send all the stats to the text file using StatQuery
	nError = StatQuery ("From Stat Query:" & newLine, "  ", Chr(9), newLine, _
	statBuffer, statBufferLen)
	Print #fileNum, "GETTING ALL STATS USING StatQuery (" & statBufferLen & " bytes)"
	If (nError = 0) Then
		'** this could end up being larger than 32,767 (the largest valid Notes
		'** Integer value), so we may need to grab the buffer in multiple passes
		Dim chunkSize As Integer
		Dim offset As Long
		Dim freeMem As Integer
		While statBufferLen > 0
			If (statBufferLen > 32767) Then
				chunkSize = 32767
				freeMem = False
			Else
				chunkSize = statBufferLen
				freeMem = True
			End If
			Print #fileNum, GetBufferAsString(statBuffer, chunkSize, offset, freeMem);
			offset = offset + chunkSize
			statBufferLen = statBufferLen - chunkSize
		Wend
	Else
		Print #fileNum, "API Error " & nError & " calling StatQuery"
	End If
	
	'** don't forget to close the file we're writing to when we're done
	Close fileNum
	Print "Finished writing to " & fileName
	
End Sub

Function GetBufferAsString (buffer As Long, bufferLen As Integer, _
offset As Long, freeMem As Integer) As String
	'** Copies information from a memory buffer into a String
	'** using the undocumented Cmovmem API function (alised as
	'** CopyBufferToString)
	'**
	'** "buffer" is the address of the buffer
	'** "bufferLen" is the number of bytes you'll be copying
	'** "offset" is the offset to start copying from (or zero,
	'** to start from the beginning of the buffer)
	'** "freeMem" is a boolean value indicating if the buffer
	'** should be freed using OSMemFree after the copy operation
	'** is complete (only do this if you won't use the buffer again)
	'**
	'** Julian Robichaux -- http://www.nsftools.com
	
	Dim pointer As Long
	Dim bufferText As String
	
	bufferText = Space(bufferLen)
	pointer = OSLockObject(buffer)
	Call CopyBufferToString(pointer + offset, bufferText, Clng(bufferLen))
	Call OSUnlockObject(buffer)
	
	'** CAUTION: if you call OSMemFree and then try to lock or access
	'** the buffer again, you WILL cause a Panic condition and crash Notes
	If freeMem Then
		Call OSMemFree(buffer)
	End If
	
	GetBufferAsString = bufferText
End Function