PBMiner

$PBExportHeader$n_ping.sru
$PBExportComments$Userobject to perform network Ping
forward
global type n_ping from nonvisualobject
end type
type icmp_echo_reply from structure within n_ping
end type
type wsadata from structure within n_ping
end type
type in_addr from structure within n_ping
end type
type addrinfo from structure within n_ping
end type
type sockaddr_in from structure within n_ping
end type
type ip_option_information from structure within n_ping
end type
end forward

type icmp_echo_reply from structure
   unsignedlong      address
   unsignedlong      status
   unsignedlong      roundtriptime
   unsignedinteger      datasize
   byte     reserved[]
   character      data[]
   ip_option_information      options
end type

type wsadata from structure
   unsignedinteger      wversion
   unsignedinteger      whighversion
   character      szdescription[257]
   character      szsystemstatus[129]
   unsignedinteger      imaxsockets
   unsignedinteger      imaxudpdg
   unsignedlong      lpvendorinfo
end type

type in_addr from structure
   unsignedlong      s_addr
end type

type addrinfo from structure
   long     ai_flags
   long     ai_family
   long     ai_socktype
   long     ai_protocol
   longptr     ai_addrlen
   longptr     ai_canonname
   longptr     ai_addr
   longptr     ai_next
end type

type sockaddr_in from structure
   unsignedinteger      sin_family
   unsignedinteger      sin_port
   in_addr     sin_addr
   byte     sin_zero[8]
end type

type ip_option_information from structure
   byte     ttl
   byte     tos
   byte     flags
   byte     optionssize
   longptr     optionsdata
end type

global type n_ping from nonvisualobject autoinstantiate
end type

type prototypes
Function boolean QueryPerformanceFrequency ( &
   Ref longlong lpFrequency &
   ) Library "kernel32.dll"

Function boolean QueryPerformanceCounter ( &
   Ref longlong lpPerformanceCount &
   ) Library "kernel32.dll"

Function ulong GetLastError( &
   ) Library "kernel32.dll"

Function ulong FormatMessage( &
   ulong dwFlags, &
   longptr lpSource, &
   ulong dwMessageId, &
   ulong dwLanguageId, &
   Ref string lpBuffer, &
   ulong nSize, &
   ulong Arguments &
   ) Library "kernel32.dll" Alias For "FormatMessageW"

Function boolean GetComputerName ( &
   Ref string buffer, &
   Ref long buflen &
   ) Library "kernel32.dll" Alias For "GetComputerNameW"

Function long gethostname ( &
   Ref string name, &
   long namelen &
   ) Library "ws2_32.dll" Alias For "gethostname;Ansi"

Function long getaddrinfo ( &
   string pNodeName, &
   ulong pServiceName, &
   Ref addrinfo pHints, &
   Ref longptr ppResult &
   ) Library "ws2_32.dll" Alias For "getaddrinfo;Ansi"

Subroutine freeaddrinfo ( &
   longptr ai &
   ) Library "ws2_32.dll"

Subroutine CopyMemory ( &
   Ref structure Destination, &
   longptr Source, &
   long Length &
   ) Library  "kernel32.dll" Alias For "RtlMoveMemory"

Function long WSAAddressToString ( &
   sockaddr_in lpsaAddress, &
   ulong dwAddressLength, &
   longptr lpProtocolInfo, &
   Ref string lpszAddressString, &
   Ref ulong lpdwAddressStringLength &
   ) Library "ws2_32.dll"  Alias For "WSAAddressToStringW"

Function long WNetGetUser ( &
   string lpname, &
   Ref string lpusername, &
   Ref long buflen &
   ) Library "mpr.dll" Alias For "WNetGetUserW"

Function long WSAStartup ( &
   uint wVersionRequested, &
   Ref WSADATA lpWSAData &
   ) Library "ws2_32.dll" Alias For "WSAStartup;Ansi"

Function long WSACleanup ( &
   ) Library "ws2_32.dll"

Function ulong inet_addr ( &
   string cp &
   ) Library "ws2_32.dll" Alias for "inet_addr;Ansi"

Function integer WSAGetLastError ( &
   ) Library "ws2_32.dll"  

Function longptr IcmpCreateFile ( &
   ) Library "icmp.dll"

Function long IcmpSendEcho ( &
   longptr IcmpHandle, &
   ulong DestinationAddress, &
   string RequestData, &
   uint RequestSize, &
   longptr RequestOptions, &
   Ref icmp_echo_reply ReplyBuffer, &
   ulong ReplySize, &
   ulong Timeout &
   ) Library "icmp.dll"

Function long IcmpCloseHandle ( &
   longptr IcmpHandle &
   ) Library "icmp.dll"

end prototypes

type variables
LongLong ill_frequency
LongLong ill_begin
ULong iul_timeout = 200

end variables

forward prototypes
public subroutine of_performance_beg ()
public function double of_performance_end ()
public function boolean of_ping (string as_ipaddress)
public function string of_wsagetlasterror ()
public function boolean of_ping (string as_ipaddress, string as_echomsg)
public function string of_formatmessage (unsignedlong aul_error)
public function string of_wnetgetuser ()
public function string of_getlasterror ()
public function string of_getcomputername ()
public function string of_getipaddress (string as_hostname)
public function string of_gethostname ()
end prototypes

public subroutine of_performance_beg ();// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_Performance_Beg
//
// PURPOSE:    This function saves the current value of the
//             operating system's performance counter.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

QueryPerformanceCounter(ill_begin)

end subroutine

public function double of_performance_end ();// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_Performance_End
//
// PURPOSE:    This function gets the current value of the
//             operating system's performance counter and
//             calculates the elapsed time since of_Begin_Timer
//             was called.
//
// RETURN:     Elapsed time in seconds
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

LongLong lll_end
Double ldbl_elapsed

QueryPerformanceCounter(lll_end)

If ill_frequency > 0 Then
   ldbl_elapsed = (lll_end - ill_begin) / ill_frequency
End If

Return ldbl_elapsed

end function

public function boolean of_ping (string as_ipaddress);// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_Ping
//
// PURPOSE:    This function provides a default echo string
//             to the main of_Ping function.
//
// ARGUMENTS:  as_ipaddress   - IP address of the server
//
// RETURN:     True = Success, False = Failed
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_echomsg

ls_echomsg = "abcdefghijklmnopqrstuvwxyz"

Return of_Ping(as_ipaddress, ls_echomsg)

end function

public function string of_wsagetlasterror ();// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_WSAGetLastError
//
// PURPOSE:    This function returns the message text for

//             the most recent Winsock error.
//
// RETURN:     Counter value
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

ULong lul_error
String ls_errmsg

lul_error = WSAGetLastError()

If lul_error = 0 Then
   ls_errmsg = "An unknown error has occurred!"
Else
   ls_errmsg = of_FormatMessage(lul_error)
End If

Return ls_errmsg

end function

public function boolean of_ping (string as_ipaddress, string as_echomsg);// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_Ping
//
// PURPOSE:    This function performs a 'ping' against the
//             server at the specified IP address.
//
// ARGUMENTS:  as_ipaddress   - IP address of the server
//             as_echomsg     - The text to send to server
//
// RETURN:     True = Success, False = Failed
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

ICMP_ECHO_REPLY lstr_reply
Long ll_rc
LongPtr ll_handle
String ls_errmsg, ls_reply
UInt lui_RequestSize
ULong lul_address, lul_ReplySize
Environment le_env

GetEnvironment(le_env)

lul_address = inet_addr(as_ipaddress)
If lul_address > 0 Then
   // create ping handle
   ll_handle = IcmpCreateFile()

   // determine sizes
   lstr_reply.Data[Len(as_echomsg)] = ""
   lui_RequestSize = Len(as_echomsg) * 2
   If le_env.ProcessBitness = 32 Then
      lstr_reply.Reserved[14] = 0
      lul_ReplySize = 28 + lui_RequestSize
   Else
      lstr_reply.Reserved[26] = 0
      lul_ReplySize = 40 + lui_RequestSize
   End If

   // send the ping
   ll_rc = IcmpSendEcho(ll_handle, lul_address, &
                  as_echomsg, lui_RequestSize, 0, &
                  lstr_reply, lul_ReplySize, iul_timeout)

   // close ping handle
   IcmpCloseHandle(ll_handle)

   If ll_rc = 0 Then
      // Meaning of Status can be found here:
      // https://docs.microsoft.com/en-us/windows/win32/api/ipexport/ns-ipexport-icmp_echo_reply
      ls_errmsg = "IcmpSendEcho Error #" + String(lstr_reply.Status)
      MessageBox( "Send Echo Error in of_Ping", &
                  ls_errmsg, StopSign!)
   Else
      If lstr_reply.Status = 0 Then
         ls_reply = String(lstr_reply.Data)
         If ls_reply = as_echomsg Then
            Return True
         Else
            ls_errmsg  = "The returned string is different:~r~n~r~n"
            ls_errmsg += "Sent: " + as_echomsg + "~r~n"
            ls_errmsg += "Recv: " + ls_reply
            MessageBox( "Echo Error in of_Ping", &
                        ls_errmsg, StopSign!)
         End If
      Else
         ls_errmsg = of_FormatMessage(lstr_reply.Status)
         MessageBox( "Echo Status Error in of_Ping", &
                     ls_errmsg, StopSign!)
      End If
   End If
Else
   ls_errmsg = "The given IP Address is invalid!"
   MessageBox( "Winsock Error in of_Ping", &
               ls_errmsg, StopSign!)
End If

Return False

end function

public function string of_formatmessage (unsignedlong aul_error);// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_FormatMessage
//
// PURPOSE:    This function returns the message text for
//             the given system error code.
//
// ARGUMENTS:  aul_error   - Error code
//
// RETURN:     Message text
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

Constant ULong FORMAT_MESSAGE_FROM_SYSTEM = 4096
Constant ULong LANG_NEUTRAL = 0
Constant Long MAX_PATH = 260
String ls_buffer, ls_errmsg

ls_buffer = Space(MAX_PATH)

FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, &
      aul_error, LANG_NEUTRAL, ls_buffer, MAX_PATH, 0)

ls_errmsg = "Error# " + String(aul_error) + "~r~n~r~n" + ls_buffer

Return ls_errmsg

end function

public function string of_wnetgetuser ();// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_WNetGetUser
//
// PURPOSE:    This function retrieves the userid used to establish
//             the current network connection.
//
// RETURN:     The userid or empty string if error occurred.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_userid, ls_errmsg
Long ll_result, ll_buflen

ll_buflen = 32
ls_userid = Space(ll_buflen)

ll_result = WNetGetUser("", ls_userid, ll_buflen)
If ll_result <> 0 Then
   ls_errmsg = of_FormatMessage(ll_result)
   MessageBox( "Network Error in of_WNetGetUser", &
               ls_errmsg, StopSign!)
End If

Return ls_userid

end function

public function string of_getlasterror ();// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_GetLastError
//
// PURPOSE:    This function returns the message text for
//             the most recent system error.
//
// RETURN:     Counter value
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

ULong lul_error
String ls_errmsg

lul_error = GetLastError()

If lul_error = 0 Then
   ls_errmsg = "An unknown error has occurred!"
Else
   ls_errmsg = of_FormatMessage(lul_error)
End If

Return ls_errmsg

end function

public function string of_getcomputername ();// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_GetComputerName
//
// PURPOSE:    This function retrieves the NetBIOS name of the local computer.
//
// RETURN:     The userid or empty string if error occurred.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_compname, ls_errmsg
Long ll_buflen
Boolean lb_result

ll_buflen = 32
ls_compname = Space(ll_buflen)

lb_result = GetComputerName(ls_compname, ll_buflen)
If lb_result = False Then
   ls_errmsg = of_GetLastError()
   MessageBox( "Network Error in of_GetComputerName", &
               ls_errmsg, StopSign!)
End If

Return ls_compname

end function

public function string of_getipaddress (string as_hostname);// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_GetIPAddress
//
// PURPOSE:    This function finds the IP address for the
//             specified host name.
//
// ARGUMENTS:  as_hostname - host name of a server
//
// RETURN:     IP Address
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

Constant UInt AF_INET      = 2
Constant Long SOCK_STREAM  = 1
Constant Long IPPROTO_TCP  = 6
Constant Long INET_ADDRSTRLEN = 22
sockaddr_in IPaddr4
addrinfo hints, ptr
Long iResult, iNext
String IPAddress, ls_errmsg
ULong StructSize, AddressLen
LongPtr result
Environment le_env

GetEnvironment(le_env)

// initialize the hints structure
hints.ai_family   = AF_INET
hints.ai_socktype = SOCK_STREAM
hints.ai_protocol = IPPROTO_TCP

// convert host address to addrinfo structure
PopulateError(0, "getaddrinfo")
iResult = getaddrinfo(as_hostname, 0, hints, result)
If iResult > 0 Then
   ls_errmsg = of_WSAGetLastError()
   MessageBox( "Winsock Error in of_GetIPAddress", &
               ls_errmsg, StopSign!)
   Return ""
End If

ptr.ai_next = result
StructSize = 32
If le_env.ProcessBitness = 64 Then
   StructSize = 48
End If
CopyMemory(ptr, ptr.ai_next, StructSize)

// convert IP Address to readable string
StructSize = 16
CopyMemory(IPaddr4, ptr.ai_addr, StructSize)
AddressLen = INET_ADDRSTRLEN
IPAddress = Space(AddressLen)
WSAAddressToString(IPaddr4, &
      StructSize, 0, IPAddress, AddressLen)

// free allocated memory
freeaddrinfo(result)

Return IPAddress

end function

public function string of_gethostname ();// -----------------------------------------------------------------------------
// FUNCTION:   n_ping.of_GetHostName
//
// PURPOSE:    This function retrieves the standard host name for the
//             local computer.
//
// RETURN:     IP Address
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/23/2004  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_hostname, ls_errmsg
Long ll_rc, ll_namelen

ll_namelen = 256
ls_hostname = Space(ll_namelen)

ll_rc = gethostname(ls_hostname, ll_namelen)
If ll_rc <> 0 Then
   ls_errmsg = of_WSAGetLastError()
   MessageBox( "Winsock Error in of_GetHostName", &
               ls_errmsg, StopSign!)
End If

Return ls_hostname

end function

on n_ping.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_ping.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on

event constructor;wsadata lstr_wsadata
Long ll_rc
String ls_errmsg

// determine the performance counter frequency
QueryPerformanceFrequency(ill_frequency)

// initialize Winsock
ll_rc = WSAStartup(257, lstr_wsadata)
If ll_rc <> 0 Then
   ls_errmsg = of_GetLastError()
   MessageBox( "WSAStartup Error in constructor", &
               ls_errmsg, StopSign!)
End If

end event

event destructor;// cleanup Winsock
WSACleanup()

end event