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
Dim WSAD As WSADATA
If WSAStartup(WS_VERSION_REQD, WSAD) = 0 Then
SocketsInitialize = True
Else
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 INADDR_NONE = &HFFFFFFFF
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"
Else
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
Const INADDR_NONE = &HFFFFFFFF
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
Else
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:
Type ICMP_OPTIONS
Ttl As Integer
Tos As Integer
Flags As Integer
OptionsSize As Integer
OptionsData As Long
End Type
Type ICMP_ECHO_REPLY
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
Type WSADATA
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, _
lpWSADATA As WSADATA) 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 ECHO As ICMP_ECHO_REPLY
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("127.0.0.1", "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"
Else
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.