Socket API implements ping

After reading a few articles to implement PING, ICMP.DLL of the system called, is simple, but since you learn the Socket API, why not realize it ...

PING is nothing more than sending an ICMP package to the remote host. If the response does not receive a response within a given time, if the response is received, the received ICMP package is analyzed, and the TTL, type, and use. Very simple ... take it very good ~~~~~

First define a few records:

Unit ytribords;

Interface

Uses windows;

Const ICMP_ECHO = 8; ICMP_ECHOREPLY = 0; ICMP_MIN = 8; packet_size = 32; max_packet_size = 512; MAX_IP_HDR_SIZE = 60;

TYPE S32 = INTEGER; U32 = DWORD; u8 = byte; u16 = word; pu16 = ^ U16;

////// ipp packet header // pipheader = ^ yipheader; yipheader = record u8verlen: u8; // 4bits Ver, 4bits len, len * 4 = true length u8tos: u8; // type of service, 3bits priority (now Already neglected), 4bits TOS, only 1 bit is 1 U16Totallen: U16; // The length of the entire IP datagram, in bytes. U16ID: U16; / / Identify each datagram of the host sent U16Offset: U16; // 3bits flag, 13bitS block offset U8TTL: U8; // The survival time field sets the maximum number of routers that the datagram can pass. U8PROTOL: U8; // Protocol type, 6 indicates that the transport layer is a TCP protocol. U16CHECKSUM: U16; // First inspection and U32SRCADDR: U32; // source IP address, not 'xxx.xxx.xxx.xxx' situation U32DestAddr: U32; // destination IP address, the same end;

//////////Picmpheader = ^ yicmpheader; yicmpheader = Record U8Type: U8; U8Code: U8; U16CHKSUM: U16; U16ID: U16; U16SEQ: U16; END;

As long as a form, a listbox, an edit, a button ~~~~~~~~~

Unit unit1;

Interface

Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, Yystems, Winsock2;

type TForm1 = class (TForm) ListBox1: TListBox; Edit1: TEdit; Button1: TButton; procedure FormCreate (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure Button1Click (Sender: TObject); private { PRIVATE DECLArations}} End; Var Form1: TFORM1; GICMPCOUNT: U32;

IMPLEMENTATION

{$ R * .dfm}

Procedure Fillicmpdata (PHDR: PICMPHEADER; LEN: U32); VAR PDAT: PCHAR; Begin PHDR ^ .u8Type: = ICMP_ECHO; PHDR ^ .u8code: = 0; phdr ^ .u16chksum: = 0; phdr ^ .u16ID: = U16 ( GetCurrentProcessid; phdr ^ .u16seq: = 0;

PDAT: = PCHAR (PCHAR); Inc (PDAT, SIZEOF (Yicmpheter)); Fillchar (PDAT ^, Len-Sizeof (Yicmpheader), 'E');

Function CHECKSUM (PBUF: PU16; SIZE: U16): U16; Var Chksum: U32; Begin Chksum: = 0;

While size> 1 do begin chksum: = chksum PBUF ^; Inc (PBUF); DEC (Size, SizeOf (U16));

IF size = 1 Then Chksum: = CHKSUM PBYTE (PBUF) ^;

Chksum: = (CHKSUM SHR 16) (CHKSUM AND $ FFF); Chksum: = Chksum (Chksum SHR 16); Chksum: = NOT Chksum; Result: = U16 (Chksum);

/ / We receive the response package is actually an IP package. The real ICMP data is / // / / but TTL and the IP of the responding host is in the IP head ~~~~

Function Decodeicmpreply (PBUF: PCHAR; Tick: U32): String; Var P, Paddr: Pchar; Picmphdr: PICMpheader; IPHDRLEN: U16; S: ​​String; Begin P: = Pbuf; Result: = 'Received from' INT_NTOA ( TINADDR (Pipheader (P) ^. U32SRCADDR); Result: = Result 'TTL =' INTOSTR (Pipheader (P) ^. U8TTL);

INC (p, (p) ^. U8verlen and $ 0f) * 4); picmphdr: = PICMPHEADER (P);

Case picmphdr ^ .U8TYPE OF 0: S: = '' return response message. '; 3: s: =''s purpose is not accessible. '; 4: s: =' source congestion message. '; 5: s: =' redirective message. '; 8: s: =''s return message. '; 11: s: =' timeout information. '; 12: s: =' parameter problem message. '; 13: s: =' timestamp. '; 14: s: =' timestamp response message. 'Information requests for'; 15: s: = '. '; Information response message for 16: s: ='. '; Unknown type message of Else S: ​​='. '; End; Result: = Result S ' Time: ' INTOSTR (GettickCount () - Tick) ' MS ';

Procedure errmsg (MSG: String); Begin MessageBox (0, Pchar (MSG), 'Ping Program Error', MB_ICONERROR); END;

Procedure TForm1.FormCreate (Sender: Tobject); Var WSA: TWSADATA; Begin IF Wsastartup ($ 0202, WSA) <> 0 Then Errmsg ('Windows Socket IS Not Responed.');

Procedure TForm1.FormClose (Sender: TpoBject; VAR Action: Tclosection); Begin IF WSACLEANUP <> 0 Then Errmsg ('Windows Socket CAN NOT BE CLOSED.'); END;

procedure TForm1.Button1Click (Sender: TObject); var rawsock: TSocket; ret: s32; DestAdr, FromAdr: TSockAddr; pDestIP, pIcmpHdr: PICMPHeader; pRecvBuf: Pchar; DataSize: u16; fd_read: TFDSet; timeval: TTimeVal; fromlen: s32 ; Tick: U32; Phost: phostent; begin

// Create a Raw Socket, this is a must, otherwise we can't analyze the IP package ~~~~~ Rawsock: = Socket (AF_INET, SOCK_RAW, IPPROTO_ICMP); if Rawsock = INVALID_SOCKET THEN BEGIN Errmsg ('socket failed.' EXIT;

Picmphdr: = allocmem (max_packet_size); precvbuf: = allocmem (MAX_PACKET_SIZE)

DataSize: = Sizeof (Yicmpheader);

// Fill the ICMP head FillicmpData (picmphdr, max_packet_size);

// Calculate the check and PICMPHDR ^ .u16chksum: = 0; picmphdr ^ .u16chksum: = Checksum (PU16 (Picmphdr), DataSize; Tick: = gettickcount ();

Fillchar (Destadr, Sizeof (Destadr), 0); Destadr.sin_Family: = Af_Inet; destr.sin_addr.s_addr: = inet_addr (pchar (edit1.text));

// If edit1.text is not an IP address, but the domain name if destadr.sin_addr.s_addr = INADDR_NONE THEN becom phost: = gethostByname (pchar (edit1.text)); if phost <> nil dam move (phost ^ .h_addr ^ ^, Destadr.sin_addr, phost ^ .h_length; destadr.sin_family: = phost ^ .h_addrtype; end else begin listbox1.items.add ('parsing domain name:' edit1.text 'error.'); ClossoSocket (Rawsock Freemem (PICMphDR); FreeMem (PRECVBUF); EXIT; END;

ListBox1.Items.add ('ping' edit1.text '...); listbox1.update;

// Send ICMP package RET: = Sendto (Rawsock, PicmphDR ^, DataSize, 0, destadr, sizeof (destadr)); if Ret = Socket_ERROR THEN BEGIN Errmsg ('sendto failed.'); CloseSocket (Rawsock); FreeMem (PICMphdr Freemem (precvbuf); exit;

FD_ZERO (fd_read); fd_set (rawsock, fd_read); timeval.tv_sec: = 3; timeval.tv_usec: = 0;

/ / Receive ICMP Reply Bag if SELECT (0, @fd_read, nil, nil, @timeval)> 0 The begin if fd_isset (Rawsock, FD_Read) THEN SENGIN FILLCHAR (from ADR, SIZEOF (from ADR), 0); fromAdr.sin_Family: = AF_INET; fromLen: = sizeof (FromAdr); recvfrom (rawsock, pRecvBuf ^, MAX_PACKET_SIZE, 0, FromAdr, fromLen); ListBox1.Items.Add (DecodeIcmpReply (pRecvBuf, tick)); end; end else begin ListBox1.Items. Add ('timeout.');

CloseSocket; FreeMem (Picmphdr); FreeMem (PRECVBUF); end; end;