unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,WinSock;
type
TForm1 = 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;
var
Form1: TForm1;
implementation
{$R *.dfm}
function PingHost(HostIP: String): Boolean;
type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
end;
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;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord; stdcall;
var
hICMP :THandle;
hICMPdll :THandle;
IcmpCreateFile :TIcmpCreateFile;
IcmpCloseHandle :TIcmpCloseHandle;
IcmpSendEcho :TIcmpSendEcho;
pIPE :PIcmpEchoReply;// ICMP Echo reply buffer
FIPAddress :DWORD;
FSize :DWORD;
FTimeOut :DWORD;
BufferSize :DWORD;
pReqData,pRevData:PChar;
MyString:string;
begin
Result :=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 buffer
pReqData :=PChar(MyString);
FSize :=40; //receive data buffer
BufferSize :=SizeOf(TICMPEchoReply)+FSize;
GetMem(pIPE,BufferSize);
FillChar(pIPE^,SizeOf(pIPE^),0);
GetMem(pRevData,FSize);
pIPE^.Data :=pRevData;
FTimeOut :=1000;
try
Result :=IcmpSendEcho(hICMP,FIPAddress,pReqData,
Length(MyString),nil,pIPE,BufferSize,FTimeOut)>0;
finally
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPdll);
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
function HostToIP(Name: string; var Ip: string): Boolean;
var
wsdata : TWSAData;
hostName : array [0..255] of char;
hostEnt : PHostEnt;
addr : PChar;
begin
WSAStartup ($0101, wsdata);
try
gethostname (hostName, sizeof (hostName));
StrPCopy(hostName, Name);
hostEnt := gethostbyname (hostName);
if Assigned (hostEnt) then
if Assigned (hostEnt^.h_addr_list) then begin
addr := hostEnt^.h_addr_list^;
if Assigned (addr) then begin
IP := Format ('%d.%d.%d.%d', [byte (addr [0]),
byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Result := True;
end
else
Result := False;
end
else
Result := False
else begin
Result := False;
end;
finally
WSACleanup;
end
end;
procedure TForm1.Button1Click(Sender: TObject);
var
IP:String;
flag:Boolean;
begin
//IP:='123.125.114.118';
IP:=edit2.text;
flag:=PingHost(IP);
if flag=true then
MessageBox(0,'ping1','通路',MB_ICONASTERISK and MB_ICONINFORMATION)
else
MessageBox(0,'ping2','断路',MB_ICONASTERISK and MB_ICONINFORMATION);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hqw:string;
begin
HostToIP(edit1.text,hqw);
edit2.text:=hqw;
end;
end.
