$APPTYPE CONSOLE    
$TYPECHECK ON
$INCLUDE "RapidQ.INC"
$INCLUDE "RSocket.INC"

DECLARE SUB ICMP
DECLARE SUB CheckSum(plen AS LONG)

DIM Sock as RSocket
DIM RemoteName As STRING, ip$ As STRING, C As STRING, EchoString As STRING
Dim S as LONG, ret As LONG, sum As LONG
DIM DestAddr(0& to 3&) As LONG, ReplyAddr(0& to 4&) As LONG
DIM i As LONG, j As LONG
DIM Ident As WORD
DIM P(0& to 575&) AS BYTE    

'With the socket set as follows, the system creates the IP header
Sock.Protocol = IPPROTO_ICMP  'choose any protocol here and craft your packet 
Sock.Type = SOCK_RAW

'non-blocking modes may be used for multi-socket programs

NextTry:
ip$=""
MEMSET(VARPTR(P(0&)),0&,576&)   'clear packet buffer
INPUT "Remote Host Name = "; RemoteName
IF RemoteName <> "" THEN
  ip$ = Sock.AddrByName(RemoteName)
  PRINT "Bingo, the Remote IP address is ";ip$; " or null if not found."
  PRINT
END IF

Ident=Ident+2
IF ip$ = "" THEN
  INPUT "HOST (a.b.c.d) to Ping = "; ip$
END IF
IF ip$ = "" THEN Goto Done
DestAddr(0&)=2&
DestAddr(1&)=inet_addr(ip$)     'set up structure with dest address
IF DestAddr(1&)=&HFFFFFFFF THEN PRINT "Invalid address": Goto NextTry 
DestAddr(2&)=0&: DestAddr(3&)=0&

S = Sock.S  'create socket
PRINT "Socket S = ";S; " from RSocket"
IF S <=0& THEN PRINT "Failed to create socket": Goto Done

EchoString = "RawSock ICMP"
Call ICMP
PRINT "ICMP Packet Payload:"
C = ""
For i = 1& to j
C = C + RIGHT$(HEX$(P(i-1&)),2&)+" "
IF i MOD 20& = 0& THEN PRINT C: C = ""
NEXT i: PRINT C

PRINT "Sending Packet at ";str$(timer)
ret = sendto(S, VARPTR(P(0&)), j, 0&, VARPTR(DestAddr(0&)), 16&)
PRINT "ret = "+STR$(ret)+" bytes sent wrapped in IP header"
IF ret < 0& THEN Goto SockCLose

sleep 3     'any kind of timer mechanism could be used!!

ReplyAddr(1&)=0&: ReplyAddr(4&)=16&
ret = sock.nonblock(S)

'Now we use the send buffer for recieve buffer.  Could be different, of course.
'Watch out.  The following will retrieve icmp messages to other programs!
ret = recvfrom(S, VARPTR(P(0&)), 100&, 0&, VARPTR(ReplyAddr(0&)), VARPTR(ReplyAddr(4&)))

IF ret <=0& THEN PRINT "Sorry, no reply": Goto SockClose
PRINT "ret = "+STR$(ret)+" bytes read including IP header and data"

'ReplyAddr(1) is the long IP address value of the reply source and may be
'the same or different from your original destination -- DestAddr(1)

'A hex dump of the reply packet.  Get out RFCs 791 (IP header - 20 bytes)
'and 792 (Echo reply or error) to parse this.  That's the whole idea of
'the raw socket method, right?  You want to see the bytes.

PRINT "Packet Reply (1st line is IP Header):"
C = ""
FOR i = 1& to ret
C = C + RIGHT$(HEX$(P(i-1&)),2&)+" "
IF i MOD 20& = 0& THEN PRINT C: C = ""
NEXT i: PRINT C
Goto SockClose

'''''
'This creates an echo request packet.  Other icmp type & codes could be used.
SUB ICMP
P(0&) = 8&         'icmp type; P(1) is the code and is left at zero.
P(4&) = Ident     'icmp identifier (can be anything or zero)
P(6&) = Ident + 1& 'icmp sequence number (can be anything or zero)
MEMCPY(VARPTR(P(8&)),VARPTR(EchoString),LEN(EchoString)) 'icmp data
j = 8& + LEN(EchoString)  'j is packet data length excluding IP header bytes
Call CheckSum(j)         'calculates the checksum as sum for j bytes
MEMCPY(VARPTR(P(2&)),VARPTR(sum),2&)  'stores checksum in data buffer
END SUB

'''''
SUB CheckSum(plen AS LONG)
'Translation of c routine by Mike Muuss based on a WORD buffer into
'RapidQ basic where the present data buffer is dimensioned as BYTE.
'The even index array elements are the least significant bytes of the words. 
'This is THE checksum routine used throughout the AF_NET internet.
'This may not be pretty or fast, but it works (bad checksum = drop packet).
sum = 0&: i = 0&
NextPWord:
sum = sum + P(i) + 256& * P(i+1): i = i + 2&
IF i < plen THEN Goto NextPWord
ret = sum AND &HFFFF0000
IF ret <> 0& THEN sum = (sum AND &HFFFF) + (ret SHR 16&)
ret = sum AND &HFFFF0000
IF ret <> 0& THEN sum = (sum AND &HFFFF) + (ret SHR 16&)
sum = sum XOR &HFFFF
END SUB

SockClose:
Sock.Close(S)
PRINT "Closed at ";str$(timer)
Goto NextTry
Done:
end