Small server statistic

This little agent gets the server list from your workstation, and then it tries to contact all servers returning

This little agent gets the server list from your workstation, and then it tries to contact all servers returning
1. Servername
2. Server availability
3. Response time from client to server
4. Response time from server to client
5. Server build number

'agntExampleShowServerLatency: 

Option Public
Option Declare 
Private Const W_API_MODULE = "nnotes"
Private Const ERR_MAIN = "agnExampleShowServerLis"

' Notes API declares and constants
Const OS_TRANSLATE_LMBCS_TO_NATIVE = 1
Const MAX_SERVER_NAME = 256

Declare Function funcwNSGetServerList Lib W_API_MODULE Alias "NSGetServerList" _
(Byval v_lngpPortName As Long,_
intretServerTextList As Integer) As Integer

Declare Function funcwListGetText Lib W_API_MODULE Alias "ListGetText"_
(Byval v_lngpList As Long,_
Byval v_intfPrefixDataType As Integer,_
Byval v_intEntryNumber As Integer,_
lngRetTextPointer As Long,_
intRetTextLength As Integer) As Integer

Declare Function funcwOSTranslate Lib W_API_MODULE Alias "OSTranslate" _
(Byval v_intTranslateMode As Integer,_
Byval v_lngIn As Long,_
Byval v_intInLength As Integer,_
Byval v_strOut As String,_
Byval v_intOutLength As Integer) As Integer

Declare Function funcwOSLockObject Lib W_API_MODULE Alias "OSLockObject" _
(Byval v_lngHandle As Long) As Long

Declare Function funcwOSUnlockObject Lib W_API_MODULE Alias "OSUnlockObject" _
(Byval v_lngHandle As Long) As Integer

Declare Function funcwOSMemFree Lib W_API_MODULE Alias "OSMemFree" _
(Byval v_lngHandle As Long) As Integer

Declare Function funcwNSPingServer Lib W_API_MODULE Alias "NSPingServer" _
(Byval v_strpServerName As String,_
lngpdwIndex As Long,_
intphList As Integer) As Integer

Declare Function funcwNSFGetServerLatency Lib W_API_MODULE Alias "NSFGetServerLatency" _
(Byval v_strServerName As String,_
Byval v_lngTimeOut As Long,_
lngRetClientToServerMS As Long,_
lngRetServerToClientMS As Long,_
intServerVersion As Integer) As Integer
Sub Initialize
%REM
Purpose

JUN 2002 (Geirr Winnem, gwi@winnem.com)
%END REM
'***************************************************************************************
	On Error Goto HandleError	
'***************************************************************************************	
' Declarations
	Const ERR_CALLER = "Initialize"	' Name of caller script
	Const ERR_MSGTYPE = 0			' Print Statement
	Const ERR_RESUME = 0				' End execution
	
' Variables
	Dim strMsgBox As String				' Used to display final message
	Dim strDB As String					' Complete path
	
	Dim intStatus As Integer				' Return value from C API Calls
	Const NOERROR = 0
	Dim varServerList As Variant
	Dim intLoop As Integer
' END Declarations
'***************************************************************************************
	' Checking for supported plattform
	If (Not funcCheckPlatForm() = True) Then End
	
	
	varServerList=funcGetServerList()
	strMsgBox = "Server List:" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
	
	Dim lngpdwIndex As Long
	
	For intLoop = 0 To Ubound( varServerList)
		
		intStatus = funcwNSPingServer(_
		varServerList(intLoop),_
		lngpdwIndex,_
		0)
		
		Dim lngRetClientToServerMS As Long
		Dim lngRetServerToClientMS As Long
		Dim intServerVersion As Integer
		
		If intStatus = NOERROR Then
			
			intStatus = funcwNSFGetServerLatency(_
			varServerList(intLoop),_
			30000,_
			lngRetClientToServerMS,_
			lngRetServerToClientMS,_
			intServerVersion)
			
			Messagebox "Server: " & varServerList(intLoop) _
			& Chr$(10) & "Availability: " & Cstr(lngpdwIndex) & "%" _
			& Chr$(10) & "Outbound: " & Cstr(lngRetClientToServerMS) & " ms" _
			& Chr$(10) & "Inbound: " & Cstr(lngRetServerToClientMS) & " ms" _
			& Chr$(10) & "Version: " & Cstr(intServerVersion) _
			, 64, "Server Statistics"
		Else
			Messagebox "Server  " & varServerList(intLoop) & " not responding", 64, "Server error"
		End If
	Next
	Exit Sub
'***************************************************************************************
HandleError:
	Call subErrorHandler(ERR_MAIN, ERR_CALLER, ERR_MSGTYPE, ERR_RESUME)
End Sub
Sub subErrorHandler(_
Byval v_strMain As String,_
Byval v_strCaller As String,_
Byval v_intMsgType As Integer,_
Byval v_intContinue As Integer)
%REM
Parameters
		v_strMain
				Name of main library form etc, where v_strCaller is located
		v_strCaller
				Name of design element that raises error
		v_intMsgType
				Defines which MsgType to use
		v_intContinue
				0 to end
				1 to Resume Next

Return Value
		None

Purpose
		Centralizing error handling.

FEB 2002 (Geirr Winnem)
%END REM
'***************************************************************************************
' Declarations
	Dim strMessage As String
' END Declarations
'***************************************************************************************
	Select Case v_intMsgType
	Case 0
		' Plain Print Statement
		Print "Error in " & v_strMain & " - Caller " & v_strCaller & " Error " & Err() & " In Line " & Erl() & " Desc: " & Error()
		
	Case 1
		' MsgBox Type 1
		strMessage =  v_strMain + Chr$(13) + "Error in design element " + v_strCaller + _
		Chr$(13) + "Line " + Cstr(Erl()) + Chr$(13) + "Error Number " + Cstr(Err) + Chr$(13) + "Description " + Error()
		Messagebox strMessage,0+16,"Error Handler !!"
	Case Else
		Messagebox "Unknown option for v_intMsgType",0+16,"Error in parsed value to error handler"
		End
	End Select
	
	Select Case v_intContinue
	Case 0
		End
		
	Case 1
		Error 1000
		Resume Next
		
	Case Else
		Messagebox "Unknown option for v_intContinue",0+16,"Error in parsed value to error handler"
		End
	End Select
End Sub
Function funcCheckPlatForm() As Integer
%REM
Parameters
	None

Return Value
	Integer, true or false if platform is supported

Purpose
	Self explaining ?

Dependencies
	None

MAY2002 (Geirr Winnem)
%END REM
'***************************************************************************************
' Declarations
	
	' Constants for messagebox
	Const MBOK = 0
	Const MBICONINFORMATION = 64
	Const MBDEFBUTTON1 = 0
	Const MBSYSTEMMODAL = 4096
	Const INFO_MSGBOXOPTIONS = MBOK + MBICONINFORMATION + MBDEFBUTTON1 + MBSYSTEMMODAL
	Const INFO_MSGBOXTITLE = "Application Information"
	
' Notes objects
	Dim n_sess As New NotesSession
' END Declarations
'***************************************************************************************
	If n_sess.PlatForm <> "Windows/32" Then
		Messagebox "Unsupported Platform type" & Chr$(13) & "Only supported on window plattforms",_
		INFO_MSGBOXOPTIONS,_
		INFO_MSGBOXTITLE
		funcCheckPlatForm = False
	Else
		funcCheckPlatForm = True
	End If
End Function
Function funcGetServerList() As Variant
%REM
Parameters
		None
Return Value
		List Containing server names

Purpose
		Retrieving server list

JUN 2002 (Geirr Winnem)
%END REM
'***************************************************************************************
' Declarations
	Dim intStatus As Integer
	Dim strServer As String
	Dim strArray() As String
	Dim inthList As Integer
	Dim intCount As Integer
	Dim  intLength As Integer
	Dim lngList As Long
	Dim lngHold As Long
	Redim strArray(0)
' END Declarations
'***************************************************************************************
	intStatus = funcwNSGetServerList(0, inthList)
	
	If intStatus = 0 And inthList <> 0 Then
		
		lngList = funcwOSLockObject(inthList)
		
		Do While intStatus=0 			
			intStatus=funcwListGetText(_
			lngList,_
			0,_
			intCount,_
			lngHold,_
			intLength)			
			
			If intStatus=0 And intLength>0 Then			
				strServer=Space$(intLength)						
				Call funcwOSTranslate(_
				OS_TRANSLATE_LMBCS_TO_NATIVE,_
				lngHold,_
				intLength,_
				strServer,_
				MAX_SERVER_NAME)			
				
				Redim Preserve strArray(intCount)
				strArray(intCount)=strServer
			End If 
			intCount = intCount + 1		
		Loop		
		Call funcwOSUnlockObject(inthList)	
		Call funcwOSMemFree(inthList)	
	End If
	funcGetServerList=strArray
End Function 
This was first published in June 2002

Dig deeper on Lotus Notes Domino Administration Tools

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchWinIT

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchVirtualDataCentre.co.UK

Close