PING
Having trouble with your network? If you use TCP/IP and Microsoft 32-bit environment you can use this code to check your network connections directly from Notes, instead of from the console or the MS DOS prompt. 
'Agent Initalize section:
Sub Initialize
	Dim strData As String
	Dim strAddress As String
	Dim  myPing As New MyPing
	Dim strMessage As String
	
	strAddress = Inputbox("Enter IP address for PING", "HALPing Tester", "127.0.0.1")
	If strAddress = "" Then Exit Sub
	
	strData = Inputbox("Enter message text", "HAL PING Tester", "This is my message")
	If strData = "" Then Exit Sub
	
	If Not myPing.PrepareSocket() Then
		Msgbox "Windows Sockets for 32 bit Windows is not responding properly."
	End If
	
	myPing.Ping strAddress, strData
	
	strMessage = "Requested Address: " & strAddress & Chr(10)  &_
	"Sent Data: " & strData & Chr(10) &_
	Chr(10) &_
	"Returned Values:" & Chr(10) & Chr(10) &_
	"Status: " & myPing.Status & Chr(10) &_
	"Pinged Address:" & myPing.Address & Chr(10) &_
	"Trip Time: " & myPing.TripTime & " ms" & Chr(10) &_
	"Data size: " & myPing.DataSize & " bytes" & Chr(10) &_
	"Data returned: " & myPing.Data
	
	Msgbox strMessage, 0, "HALPing Tester"
	
End Sub

'HALPing: 

Option Public
Option Explicit

%REM
Copyright ?2000-2002 HAL Informatika d.o.o. Zagreb, Croatia
Author: Andrej Tihomirovic
%ENDREM
'Constants from IPExport.h
'IP_STATUS codes returned from IP APIs
Private Const IP_SUCCESS  = 0
Private Const IP_BUF_TOO_SMALL

    Requires Free Membership to View

    Login

    Register today to access targeted resources from our editorial writers and independent industry experts focused on Lotus Domino, Notes, Workplace and other related technologies.

    By submitting your registration information to SearchDomino.com you agree to receive email communications from TechTarget and TechTarget partners. We encourage you to read our Privacy Policy which contains important disclosures about how we collect and use your registration and other information. If you reside outside of the United States, by submitting this registration information you consent to having your personal data transferred to and processed in the United States. Your use of SearchDomino.com is governed by our Terms of Use. You may contact us at webmaster@TechTarget.com.

  = 11001
Private Const IP_DEST_NET_UNREACHABLE = 11002
Private Const IP_DEST_HOST_UNREACHABLE  = 11003
Private Const IP_DEST_PROT_UNREACHABLE = 11004
Private Const IP_DEST_PORT_UNREACHABLE  = 11005
Private Const IP_NO_RESOURCES = 11006
Private Const IP_BAD_OPTION = 11007
Private Const IP_HW_ERROR  = 11008
Private Const IP_PACKET_TOO_BIG  = 11009
Private Const IP_REQ_TIMED_OUT = 11010
Private Const IP_BAD_REQ  = 11011
Private Const IP_BAD_ROUTE  = 11012
Private Const IP_TTL_EXPIRED_TRANSIT = 11013
Private Const IP_TTL_EXPIRED_REASSEM  = 11014
Private Const IP_PARAM_PROBLEM  = 11015
Private Const IP_SOURCE_QUENCH  = 11016
Private Const IP_OPTION_TOO_BIG = 11017
Private Const IP_BAD_DESTINATION  = 11018
'The next group are status codes passed up on status indications to transport layer protocols.
Private Const IP_ADDR_DELETED  =  11019
Private Const IP_SPEC_MTU_CHANGE  = 11020
Private Const IP_MTU_CHANGE  =  11021
Private Const IP_UNLOAD  = 11022
Private Const IP_ADDR_ADDED  = 11023
Private Const IP_MEDIA_CONNECT = 11024
Private Const IP_MEDIA_DISCONNECT =  11025
Private Const IP_BIND_ADAPTER = 11026
Private Const IP_UNBIND_ADAPTER = 11027
Private Const IP_DEVICE_DOES_NOT_EXIST = 11028
Private Const IP_DUPLICATE_ADDRESS = 11029
Private Const IP_INTERFACE_METRIC_CHANGE = 11030
Private Const IP_RECONFIG_SECFLTR = 11031
Private Const IP_NEGOTIATING_IPSEC = 11032
Private Const IP_INTERFACE_WOL_CAPABILITY_CHANGE = 11033
Private Const IP_DUPLICATE_IPADD = 11034
Private Const IP_GENERAL_FAILURE  = 11050
Private Const MAX_IP_STATUS = 11050
Private Const IP_PENDING  = 11255

'Constant from winsock2.h
Private Const INADDR_NONE  = &HFFFFFFFF
Private Const WSADESCRIPTION_LEN  = 128  '(String * 1 = 2 byte)
Private Const WSASYS_STATUS_LEN  = 64 '(String * 1 = 2 byte)


Private Type ICMP_OPTIONS
	'Ttl             As byte
	'Tos             As byte
	'Flags           As byte
	'OptionsSize     As byte
	Replacement As Long 'long is 4 bytes (String * 1 = 2 byte)
	OptionsData     As Long
End Type


Public 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

Private Type WSADATA
	wVersion As Integer
	wHighVersion As Integer
	szDescription As String * WSADESCRIPTION_LEN 
	szSystemStatus As String * WSASYS_STATUS_LEN
	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 WSAStartup Lib "wsock32" (Byval wVersionRequired As Long, lpWSADATA As WSADATA) As Long

Declare Private Function WSACleanup Lib "wsock32" () As Long

Declare Private Function inet_addr Lib "wsock32" (Byval s As String) As Long

%REM How to select  W_VERSION_REQUESTED:
This negotiation allows both a WS2_32.DLL and a Windows Sockets application to support a range of Windows Sockets versions. 
An application can use WS2_32.DLL if there is any overlap in the version ranges. The following chart gives examples of how 
WSAStartup works in conjunction with different application and WS2_32.DLL versions:

App versions 	DLL Versions 	wVersionRequested 	wVersion 	wHighVersion 	End Result  
1.1			 	1.1 				1.1 						1.1 			1.1 				use 1.1 
1.0 1.1 			1.0 				1.1 						1.0 			1.0 				use 1.0  
1.0 				1.0 1.1 			1.0 						1.0 			1.1 				use 1.0 
1.1 				1.0 1.1			 1.1						1.1 			1.1 				use 1.1 
1.1				1.0 				1.1 						1.0 			1.0 				Application fails 
1.0 				1.1 				1.0 						--- 				--- 					WSAVERNOT SUPPORTED 
1.0 1.1 			1.0 1.1 			1.1 						1.1 			1.1 				use 1.1 
1.1 2.0 			1.1 				2.0 						1.1 			1.1 				use 1.1 
2.0 				2.0 				2.0 						2.0 			2.0 				use 2.0 
1.1 = &H0101
1.0 = &H0100
2.0 = &H0200
%END REM
Private Const W_VERSION_REQUESTED  = &H1101


'The time in milliseconds to wait for replies.  Change if you have problems
Private Const PING_TIMEOUT  = 500

'My constants
Private Const WSA_SUCCESS = 0


Public Class MyPing
	Private lStatus As Long
	Private ECHO As ICMP_ECHO_REPLY
	
	
	Public Property Get Status As String
		Status = ConvertStatusToString(lStatus)
	End Property
	
	Public Property Get Address As String
		Dim lAdr As Long
		Dim lTmp4 As Long
		Dim lTmp3 As Long
		Dim lTmp2 As Long
		Dim lTmp1 As Long
		
		lAdr = ECHO.Address
		
		lTmp4 = lAdr Mod 256
		
		lTmp3 = lAdr 256
		lTmp3 = lTmp3 Mod 256
		
		lTmp2 = lAdr  256
		lTmp2 = lTmp2  256
		lTmp2 = ltmp2 Mod 256
		
		lTmp1 = lAdr256 
		lTmp1 = lTmp1256
		lTmp1 = lTmp1256
		
		Address = lTmp4 & "." & lTmp3 & "." & lTmp2 & "." & lTmp1
	End Property
	
	Public Property Get TripTime As Long 'in ms
		TripTime = ECHO.RoundTripTime
	End Property
	
	Public Property Get DataSize As String ' in byte
		DataSize = ECHO.DataSize
	End Property
	
	Public Property Get Data As String
		Dim nPos As Integer
		
		Data =""
		If Left$(ECHO.Data, 1) <> Chr$(0) Then
			nPos = Instr(ECHO.Data, Chr$(0))
			Data  = Left$(ECHO.Data, nPos - 1)
		End If
	End Property
	
	
	Private Function ConvertStatusToString(lStatus As Long) As String
		Dim strStatus As String
		
		Select Case lStatus
		Case IP_SUCCESS:               
			strStatus = "IP Success"
		Case INADDR_NONE:              
			strStatus = "Function: inet_addr: Bad IP"
		Case IP_BUF_TOO_SMALL:         
			strStatus = "IP Buffer Too Small"
		Case IP_DEST_NET_UNREACHABLE:  
			strStatus = "IP Network Destination Unreachable"
		Case IP_DEST_HOST_UNREACHABLE: 
			strStatus = "IP Host Destination Unreachable"
		Case IP_DEST_PROT_UNREACHABLE: 
			strStatus = "IP Protocol Destination Unreachable"
		Case IP_DEST_PORT_UNREACHABLE: 
			strStatus = "IP Port Destination Unreachable"
		Case IP_NO_RESOURCES:          
			strStatus = "IP No Resources"
		Case IP_BAD_OPTION:            
			strStatus = "IP Bad Option"
		Case IP_HW_ERROR:              
			strStatus = "IP HW Error"
		Case IP_PACKET_TOO_BIG:        
			strStatus = "IP Packet Too Big"
		Case IP_REQ_TIMED_OUT:         
			strStatus = "IP Requested Time Out"
		Case IP_BAD_REQ:               
			strStatus = "IP Bad Request"
		Case IP_BAD_ROUTE:             
			strStatus = "IP Bad Route"
		Case IP_TTL_EXPIRED_TRANSIT:   
			strStatus = "IP TTL Expired Transit"
		Case IP_TTL_EXPIRED_REASSEM:   
			strStatus = "IP TTL Expired Reassem"
		Case IP_PARAM_PROBLEM:         
			strStatus = "IP Parameter Problem"
		Case IP_SOURCE_QUENCH:         
			strStatus = "IP Source Quench"
		Case IP_OPTION_TOO_BIG:        
			strStatus = "IP Option Too Big"
		Case IP_BAD_DESTINATION:       
			strStatus = "IP Bad Destination"
		Case IP_ADDR_DELETED:          
			strStatus = "IP Address Deleted"
		Case IP_SPEC_MTU_CHANGE:       
			strStatus = "IP SPEC MTU Change"
		Case IP_MTU_CHANGE:            
			strStatus = "IP MTU Change"
		Case IP_UNLOAD:                
			strStatus = "IP Unload"
		Case IP_ADDR_ADDED:            
			strStatus = "IP Address Added"
		Case IP_GENERAL_FAILURE:       
			strStatus = "IP General Failure"
		Case IP_MEDIA_CONNECT:
			strStatus = "IP Media Connected"
		Case IP_MEDIA_DISCONNECT:
			strStatus = "IP Media Disconnected"
		Case IP_BIND_ADAPTER:
			strStatus = "IP Bind Adapter"
		Case IP_UNBIND_ADAPTER:
			strStatus = "IP Unbind Adapter"
		Case  IP_DEVICE_DOES_NOT_EXIST:
			strStatus = "IP Device doesn't Exist"
		Case IP_DUPLICATE_ADDRESS :
			strStatus = "IP Duplicate Address"
		Case  IP_INTERFACE_METRIC_CHANGE:
			strStatus = "IP Interface Metric Change"
		Case IP_RECONFIG_SECFLTR:
			strStatus = "IP Reconfig Secfltr"
		Case IP_NEGOTIATING_IPSEC:
			strStatus = "IP Nogotiating IPSec"
		Case IP_INTERFACE_WOL_CAPABILITY_CHANGE:
			strStatus = "IP Interface WOL Compatibility Change"
		Case IP_DUPLICATE_IPADD:
			strStatus = "IP Duplicate IP Address"
		Case IP_PENDING:               
			strStatus = "IP Pending"
		Case PING_TIMEOUT:             
			strStatus = "Ping TIMEOUT"
		Case Else:                     
			strStatus = "Unknown"
		End Select
		
		ConvertStatusToString =  strStatus
	End Function
	
	Public Sub delete
		If WSACleanup() <> IP_SUCCESS Then
			Msgbox "Error occurred in cleanup.", 16, "HALPing class"
		End If			
	End Sub
	
	Public Sub Ping(strAddress As String, strData As String) 
		
		Dim hPort As Long
		Dim dwAddress As Long
		
		dwAddress = inet_addr(strAddress)
		
		If dwAddress <> INADDR_NONE Then
			hPort = IcmpCreateFile()
			If hPort Then
				Call IcmpSendEcho(hPort, dwAddress, strData, Len(strData), 0, ECHO, Len(ECHO), PING_TIMEOUT)
				lStatus = ECHO.status
				Call IcmpCloseHandle(hPort)
			End If
		Else
			lStatus = INADDR_NONE
		End If		
	End Sub	
	
	
	Public Function PrepareSocket() As Variant
		Dim tmpWSAD As WSADATA
		
		PrepareSocket = False
		If WSAStartup(W_VERSION_REQUESTED, tmpWSAD) = WSA_SUCCESS Then
			PrepareSocket = True
		End If
	End Function	
	
End Class

This was first published in May 2002

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.

Back to top