Ping from forth (Swiftforth)

---

\
\ ping sites from swiftforth by Alban 7/10/2007
\
REQUIRES winsock
LIBRARY ICMP.DLL OPENDLLS
0 IMPORT: IcmpCreateFile
8 IMPORT: IcmpSendEcho
1 IMPORT: IcmpCloseHandle

CLASS ICMP_OPTIONS
CVARIABLE TTL
CVARIABLE TOS
CVARIABLE Flags
CVARIABLE Size
VARIABLE Data

: init
32 TTL C!
0 TOS C!
0 Flags C!
0 Size C!
0 Data ! ;

END-CLASS



CLASS ICMP_ECHO_REPLY
VARIABLE Address
VARIABLE Status
VARIABLE RTTime
HVARIABLE DataSize
HVARIABLE Reserved
VARIABLE DataPtr
ICMP_OPTIONS BUILDS OPTS
64 BUFFER: Data
: init
32 DataSize H!
Data DataPtr ! ;
END-CLASS

CLASS PINGER
VARIABLE hICMP
VARIABLE ipAddress
VARIABLE lastStatus
VARIABLE timeout
ICMP_OPTIONS BUILDS OPTS
ICMP_ECHO_REPLY BUILDS ER
256 BUFFER: Request-data
: init-socks
$101 PAD :: WSAStartup drop ;
: init-send-buffer
z" 0123456789 ABCDEFGHIJKLMNOPQRSTUVWXYZ 9876543210"
zcount Request-data zplace ;

: >address ( z" -- )
ZCOUNT PAD ZPLACE
PAD :: inet_addr DUP 1+ ?EXIT
DROP
PAD :: gethostbyname DUP IF 3 CELLS + @ @ @ THEN
DUP 0= IF -1 ABORT" PINGER invalid host error" THEN
ipAddress ! ;

: create-file :: IcmpCreateFile hICMP ! ;

: init init-socks create-file init-send-buffer
OPTS init ER init
5000 timeout ! ;

: close hICMP @ :: IcmpCloseHandle ;

: send-ping hICMP @ ipAddress @ Request-Data 32
OPTS TTL ER Address 62 timeout @ :: IcmpSendEcho lastStatus ! ;

: rtt er RTTime c@ ;

: results rtt ." ms " . ;

: ping PAD 64 ERASE ( ping named site )
BL WORD HERE COUNT PAD SWAP CMOVE
PAD >address
send-ping drop
results ;
END-CLASS


PINGER BUILDS ICMP
ICMP init

\ usage examples
\ icmp ping www.apple.com
\ icmp ping www.bbc.co.uk
\ z" 10.10.10.1" icmp >address
\ icmp send-ping icmp rtt .