Domino Code Fragment

Code Name*
Check specified server until is responds		Date*
04/29/2024		Source (or email address if you prefer)*
Rlatulippe@romac.com
IP address:.18.191.202.45
Description*
Checks for server response		Type*
LotusScript		Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:
Sub Initialize
    Dim x As Integer
    Dim dbase As NotesDatabase
    Dim directory As NotesDBDirectory
    Dim server As String
    Dim minutes As Integer
    Dim starttime As New NotesDateTime ("")
    Dim endtime As New NotesDateTime ("")
   
    server = Inputbox("Enter Server Name")    
    If server = "" Then End
    On Error 13 Resume Next
    minutes = Inputbox("Maximum time to check " & _
    "server (minutes)","Enter number of minutes","2")
    If Err = 13 Then End  
    If minutes = 0 Then End
    On Error Resume Next    
    Call starttime.SetNow()
    Call endtime.SetNow()
    Call endtime.adjustMinute(Cint(minutes))
   
    Do While endtime.TimeDifference(starttime) > 1
         Call starttime.SetNow()
         Set directory = New NotesDBDirectory(server)        
         Set dbase = _
         directory.GetFirstDatabase(Database)
         
         If Err = 0 Then
              Beep
              Messagebox("Server " & server & " is now responding")
              Exit Do
          Elseif Err = 4060 Then
              Messagebox("You are not authorized to access " & _
              "database " & database & " on server " & server)
              Exit Do
         Else
              Err = 0
         End If
    Loop
    If endtime.TimeDifference(starttime) < 1 Then
         Messagebox("After " & Trim(Str(minutes)) & _
         " minutes, server " & server & " is still not " & _
         "responding")
    End If
   
End Sub