Ping source program of Delphi

Unit Ping;

Interface

Uses

Windows, messages, sysutils, classes, graphics, controls, forms,

Dialogs, WinSock,

Stdctrls, grids;

Type

Pipoptioninformation = ^ tipoptioninformation;

Tipoptioninformation = packed record

TTL: byte;

ToS: byte;

Flags: byte;

Optionssize: byte;

Optionsdata: pchar;

End;

Type picmpechoreply = ^ ticmpechoreply;

Ticmpechoreply = packed record

Address: DWORD;

Status: DWORD;

RTT: DWORD;

Datasize: word;

Reserved: word;

Data: pointer;

Options: tipoptioninformation;

End;

Ticmpcreatefile = function: thandle; stdcall;

Ticmpclosehandle = function (icmphandle: thandle): Boolean; stdcall;

Ticmpsendecho = function (icmphandle: thandle; destinationaddress: DWORD; requestda

Ta: pointer; requestsize: word; requestoptions: pipoptioninformation; replybuffer

: Pointer; replysize: DWORD; Timeout: DWORD): DWORD; stdcall;

Type

Tfrmping = Class (tform)

Echogrid: tstringgrid;

Ipaddr: tedit;

Label1: tlabel;

Ping: tbutton;

Procedure formcreate (Sender: tobject );

Procedure pingclick (Sender: tobject );

Procedure formdestroy (Sender: tobject );

Private

Hicmp: thandle;

Icmpcreatefile: ticmpcreatefile;

Icmpclosehandle: ticmpclosehandle;

Icmpsendecho: ticmpsendecho;

Line: integer;

{Private Declarations}

Public

Hicmpdll: hmodule; {public declarations}

End;

VaR

Frmping: tfrmping;

Implementation

{$ R *. DFM}

Procedure tfrmping. formcreate (Sender: tobject );

Begin

Hicmpdll: = loadlibrary ('ICMP. dll ');

@ Icmpcreatefile: = getprocaddress (hicmpdll, 'icmpcreatefile ');

@ Icmpclosehandle: = getprocaddress (hicmpdll, 'icmpclosehandle ');

@ Icmpsendecho: = getprocaddress (hicmpdll, 'icmpsendecho ');

Hicmp: = icmpcreatefile;

Echogrid. cells [0, 0]: = 'Return address ';

Echogrid. cells []: = 'Return packet size ';

Echogrid. cells [2, 0]: = 'status ';

Echogrid. cells [3, 0]: = 'rtt (round-trip-Time )';

Line: = 1;

End;

Procedure tfrmping. pingclick (Sender: tobject );

VaR

Ipopt: tipoptioninformation; // IP options for packet to send

Fipaddress: DWORD;

Preqdata, prevdata: pchar;

Pipe: picmpechoreply; // ICMP echo reply Buffer

Fsize: DWORD;

Mystring: string;

Ftimeout: DWORD;

Buffersize: DWORD;

Begin

If ipaddr. Text <> ''then

Begin

Fipaddress: = inet_addr (pchar (ipaddr. Text ));

If fipaddress = inaddr_none then MessageBox (self. Handle, 'the address is invalid.

', 'Ping32', 64)

Else

Begin

Fsize: = 40;

Buffersize: = sizeof (ticmpechoreply) + fsize;

Getmem (prevdata, fsize );

Getmem (pipe, buffersize );

Fillchar (pipe ^, sizeof (pipe ^), 0 );

Pipe ^. Data: = prevdata;

Mystring: = 'argen ping32 sending message .';

Preqdata: = pchar (mystring );

Fillchar (ipopt, sizeof (ipopt), 0 );

Ipopt. TTL: = 64;

Ftimeout: = 10000;

Icmpsendecho (hicmp, fipaddress, preqdata, length (mystring), @ ipopt, pipe,

Buffersize, ftimeout );

Try

Try

If preqdata ^ = pipe ^. Options. optionsdata ^ then

With echogrid do

Begin

If line> 1 then rowcount: = line + 1;

Cells [0, line]: = ipaddr. text;

Cells [1, line]: = inttostr (pipe ^. datasize );

Cells [3, line]: = inttostr (pipe ^. RTT );

Row: = rowcount-1;

Line: = line + 1;

End;

Except

MessageBox (self. Handle, 'destination cannot reach ', 'ping32', 64)

End;

Finally

Freemem (prevdata );

Freemem (PIPE );

End;

End;

End;

End;

Procedure tfrmping. formdestroy (Sender: tobject );

Begin

Icmpclosehandle (hicmp );

Freelibrary (hicmpdll );

End;

End.