unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls,WinSock;typeTForm1 = class(TForm)Button1: TButton;Button2: TButton;Edit1: TEdit;Edit2: TEdit;procedure Button1Click(Sender: TObject);procedure Button2Click(Sender: TObject);private{
     Private declarations }public{
     Public declarations }end;varForm1: TForm1;implementation{
    $R *.dfm}function PingHost(HostIP: String): Boolean;typePIPOptionInformation = ^TIPOptionInformation;TIPOptionInformation = packed recordTTL: Byte;TOS: Byte;Flags: Byte;OptionsSize: Byte;OptionsData: PChar;end;PIcmpEchoReply = ^TIcmpEchoReply;TIcmpEchoReply = packed recordAddress: 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;RequestData: Pointer;RequestSize: Word;RequestOptions: PIPOptionInformation;ReplyBuffer: Pointer;ReplySize: DWord;Timeout: DWord): DWord; stdcall;varhICMP :THandle;hICMPdll :THandle;IcmpCreateFile :TIcmpCreateFile;IcmpCloseHandle :TIcmpCloseHandle;IcmpSendEcho :TIcmpSendEcho;pIPE :PIcmpEchoReply;// ICMP Echo reply bufferFIPAddress :DWORD;FSize :DWORD;FTimeOut :DWORD;BufferSize :DWORD;pReqData,pRevData:PChar;MyString:string;beginResult :=False;hICMPdll :=LoadLibrary('icmp.dll');if hICMPdll=0 then exit;@ICMPCreateFile :=GetProcAddress(hICMPdll,'IcmpCreateFile');@IcmpCloseHandle :=GetProcAddress(hICMPdll,'IcmpCloseHandle');@IcmpSendEcho :=GetProcAddress(hICMPdll,'IcmpSendEcho');hICMP :=IcmpCreateFile;if (hICMP=INVALID_HANDLE_VALUE)then exit;FIPAddress :=inet_addr(PChar(HostIP));MyString :='Hello,World'; //send data bufferpReqData :=PChar(MyString);FSize :=40; //receive data bufferBufferSize :=SizeOf(TICMPEchoReply)+FSize;GetMem(pIPE,BufferSize);FillChar(pIPE^,SizeOf(pIPE^),0);GetMem(pRevData,FSize);pIPE^.Data :=pRevData;FTimeOut :=1000;tryResult :=IcmpSendEcho(hICMP,FIPAddress,pReqData,Length(MyString),nil,pIPE,BufferSize,FTimeOut)>0;finallyIcmpCloseHandle(hICMP);FreeLibrary(hICMPdll);FreeMem(pRevData);FreeMem(pIPE);end;end;function HostToIP(Name: string; var Ip: string): Boolean;varwsdata : TWSAData;hostName : array [0..255] of char;hostEnt : PHostEnt;addr : PChar;beginWSAStartup ($0101, wsdata);trygethostname (hostName, sizeof (hostName));StrPCopy(hostName, Name);hostEnt := gethostbyname (hostName);if Assigned (hostEnt) thenif Assigned (hostEnt^.h_addr_list) then beginaddr := hostEnt^.h_addr_list^;if Assigned (addr) then beginIP := Format ('%d.%d.%d.%d', [byte (addr [0]),byte (addr [1]), byte (addr [2]), byte (addr [3])]);Result := True;endelseResult := False;endelseResult := Falseelse beginResult := False;end;finallyWSACleanup;endend;procedure TForm1.Button1Click(Sender: TObject);varIP:String;flag:Boolean;begin//IP:='123.125.114.118';IP:=edit2.text;flag:=PingHost(IP);if flag=true thenMessageBox(0,'ping1','通路',MB_ICONASTERISK and MB_ICONINFORMATION)elseMessageBox(0,'ping2','断路',MB_ICONASTERISK and MB_ICONINFORMATION);end;procedure TForm1.Button2Click(Sender: TObject);varhqw:string;beginHostToIP(edit1.text,hqw);edit2.text:=hqw;end;end.