Reg Exp
Web Design
Notes Client
Ping In LotusScript
Have you ever wanted to ping another host in LotusScript? Us neither until a recent project where it was needed. So we created (with the help of some code we found on the internet) a custom class that hides all the inner workings and allows you to easily ping another machine in LotusScript.

You are going to need to use the IP address to ping - a host name won't work. But, fortunately, our already published tip Converting Host Name To IP Address can do that conversion for you.

I won't go into all the inner workings of the code because it makes use of sockets and things that would end up making this into a multi-page article. So I'll just get right to the code. Create a new script library. Name your script library "Ping Class", and create a few private functions that will be needed:

Private Function SocketsInitialize() As Integer
   Const WS_VERSION_REQD = &H101
   If WSAStartup(WS_VERSION_REQD, WSAD) = 0 Then
      SocketsInitialize = True
      SocketsInitialize = False
   End If
End Function

Notice the keyword Private. That means that this function can be used only inside the script library and nowhere else.

Private Function GetStatusCode(status As Long) As String
   Const IP_SUCCESS = 0
   Const IP_BUF_TOO_SMALL = (11000 + 1)
   Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
   Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
   Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
   Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
   Const IP_NO_RESOURCES = (11000 + 6)
   Const IP_BAD_OPTION = (11000 + 7)
   Const IP_HW_ERROR = (11000 + 8)
   Const IP_PACKET_TOO_BIG = (11000 + 9)
   Const IP_REQ_TIMED_OUT = (11000 + 10)
   Const IP_BAD_REQ = (11000 + 11)
   Const IP_BAD_ROUTE = (11000 + 12)
   Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
   Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
   Const IP_PARAM_PROBLEM = (11000 + 15)
   Const IP_SOURCE_QUENCH = (11000 + 16)
   Const IP_OPTION_TOO_BIG = (11000 + 17)
   Const IP_BAD_DESTINATION = (11000 + 18)
   Const IP_ADDR_DELETED = (11000 + 19)
   Const IP_SPEC_MTU_CHANGE = (11000 + 20)
   Const IP_MTU_CHANGE = (11000 + 21)
   Const IP_UNLOAD = (11000 + 22)
   Const IP_ADDR_ADDED = (11000 + 23)
   Const IP_GENERAL_FAILURE = (11000 + 50)
   Const IP_PENDING = (11000 + 255)
   Const PING_TIMEOUT = 500
   Dim msg As String
   Select Case status
   Case IP_SUCCESS: msg = ""
   Case INADDR_NONE: msg = "inet_addr: bad IP format"
   Case IP_BUF_TOO_SMALL: msg = "ip buf too_small"
   Case IP_DEST_NET_UNREACHABLE: msg = "ip dest net unreachable"
   Case IP_DEST_HOST_UNREACHABLE: msg = "ip dest host unreachable"
   Case IP_DEST_PROT_UNREACHABLE: msg = "ip dest prot unreachable"
   Case IP_DEST_PORT_UNREACHABLE: msg = "ip dest port unreachable"
   Case IP_NO_RESOURCES: msg = "ip no resources"
   Case IP_BAD_OPTION: msg = "ip bad option"
   Case IP_HW_ERROR: msg = "ip hw_error"
   Case IP_PACKET_TOO_BIG: msg = "ip packet too_big"
   Case IP_REQ_TIMED_OUT: msg = "ip req timed out"
   Case IP_BAD_REQ: msg = "ip bad req"
   Case IP_BAD_ROUTE: msg = "ip bad route"
   Case IP_TTL_EXPIRED_TRANSIT: msg = "ip ttl expired transit"
   Case IP_TTL_EXPIRED_REASSEM: msg = "ip ttl expired reassem"
   Case IP_PARAM_PROBLEM: msg = "ip param_problem"
   Case IP_SOURCE_QUENCH: msg = "ip source quench"
   Case IP_OPTION_TOO_BIG: msg = "ip option too_big"
   Case IP_BAD_DESTINATION: msg = "ip bad destination"
   Case IP_ADDR_DELETED: msg = "ip addr deleted"
   Case IP_SPEC_MTU_CHANGE: msg = "ip spec mtu change"
   Case IP_MTU_CHANGE: msg = "ip mtu_change"
   Case IP_UNLOAD: msg = "ip unload"
   Case IP_ADDR_ADDED: msg = "ip addr added"
   Case IP_GENERAL_FAILURE: msg = "ip general failure"
   Case IP_PENDING: msg = "ip pending"
   Case PING_TIMEOUT: msg = "ping timeout"
   Case Else: msg = "unknown msg returned"
   End Select
   If msg = "" Then
      GetStatusCode = "0"
      GetStatusCode = Cstr(status) & " [ " & msg & " ]"
   End If
End Function

We need one more private function inside the script library:

Private Function DoPing(sAddress As String, sDataToSend As String, ECHO As ICMP_ECHO_REPLY) As Long
   Const PING_TIMEOUT = 500
   Dim hPort As Long
   Dim dwAddress As Long
   dwAddress = inet_addr(sAddress)
   If dwAddress <> INADDR_NONE Then
      hPort = IcmpCreateFile()
      If hPort Then
         Call IcmpSendEcho(hPort, dwAddress, sDataToSend, Len(sDataToSend), 0, ECHO, _
         Len(ECHO), PING_TIMEOUT)
         DoPing = ECHO.status
         Call IcmpCloseHandle(hPort)
      End If
      DoPing = INADDR_NONE
   End If
End Function

Finally, there is some code to define the class and call these functions. All that code goes into the (Declarations) area of our script library:

   Ttl As Integer
   Tos As Integer
   Flags As Integer
   OptionsSize As Integer
   OptionsData As Long
End Type

   Address As Long
   status As Long
   RoundTripTime As Long
   DataSize As Long
   DataPointer As Long
   Options As ICMP_OPTIONS
   Data As String * 250
End Type

   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To 256) As Integer
   szSystemStatus(0 To 128) As Integer
   wMaxSockets As Long
   wMaxUDPDG As Long
   dwVendorInfo As Long
End Type

Declare Private Function IcmpCreateFile Lib "icmp.dll" () As Long
Declare Private Function IcmpCloseHandle Lib "icmp.dll" (Byval IcmpHandle As Long) As Long
Declare Private Function IcmpSendEcho Lib "icmp.dll" (Byval IcmpHandle As Long, _
Byval DestinationAddress As Long, Byval RequestData As String, Byval RequestSize As Long, _
Byval RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, Byval ReplySize As Long, _
Byval Timeout As Long) As Long
Declare Private Function WSAGetLastError Lib "wsock32" () As Long
Declare Private Function WSAStartup Lib "wsock32" (Byval wVersionRequired As Long, _
Declare Private Function WSACleanup Lib "wsock32" () As Long
Declare Private Function gethostname Lib "wsock32" (Byval szHost As String, Byval _
dwHostLen As Long) As Long
Declare Private Function gethostbyname Lib "wsock32" (Byval szHost As String) As Long
Declare Private Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, _
xSource As Any, Byval nIntegers As Long)
Declare Private Function inet_addr Lib "wsock32" (Byval s As String) As Long

Class PingClass
   Public address As String
   Public msg As String
   Public status As String
   Public returnAddress As String
   Public time As String
   Public size As String
   Public data As String
   Public dataPtr As String
   Sub New(addr As String, inpMsg As String)
      Me.address = addr
      Me.msg = inpMsg
   End Sub
   Sub Ping
      Dim pos As Long
      Dim success As Long
      If SocketsInitialize() Then
         success = DoPing(Me.address, Me.msg, ECHO)
         Me.status = GetStatusCode(success)
         Me.returnAddress = ECHO.Address
         Me.time = ECHO.RoundTripTime & " ms"
         Me.size = ECHO.DataSize & " Integers"
         If Left$(ECHO.Data, 1) <> Chr$(0) Then
            pos = Instr(ECHO.Data, Chr$(0))
            Me.data = Left$(ECHO.Data, pos-1)
         End If
         Me.dataPtr = ECHO.DataPointer
         If WSACleanup() <> 0 Then
            Me.status = "Windows Sockets error occurred in Cleanup."
         End If
      Else ' Sockets did not initialize
         Me.status = "Windows Sockets for 32 bit Windows environments is not successfully responding."
      End If
   End Sub
End Class

OK. You can save & Close the script library. To test things out and make sure everything works, create a new agent. Make sure to use your new script library and put this code into the Initialize section:

Sub Initialize
   Dim pingVar As New PingClass("", "Echo This")
   Dim prompt As String
   Call pingVar.Ping
   If pingVar.Status = "0" Then
      prompt = "Status=" & pingVar.status & Chr$(10) & "Address=" & pingVar.returnAddress & Chr$(10)
      prompt = prompt & "Round Trip Time=" & pingVar.time & Chr$(10) & "Data Packet Size="
      prompt = prompt & pingVar.size & Chr$(10) & "Data Returned=" & pingVar.data & Chr$(10)
      prompt = prompt & "Data Pointer=" & pingVar.dataPtr
      Msgbox prompt, 64, "Success"
      Msgbox "Status=" & pingVar.status, 48, "Error"
   End If
End Sub

This code is pinging yourself, which is not all that exciting. But it's just to make sure everything works. Once everything works, you can see from the agent code how this can be used in a production environment to make sure a machine is responding, or responding as quickly as desired.