| unit PingThread;
interface
uses
Windows, Messages, SysUtils, Classes, winsock;
type
TPingReply = class(TObject)
IP, bytes, RTT: string;
end;
//----------------------------------------------------------------------------
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;
phe: pHostent;
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;
//----------------------------------------------------------------------------
TPingThread = class(TThread)
protected
procedure Execute; override;
private
{ Private declarations }
hICMP: THANDLE;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
IP1, IP2, TimeOut: DWORD;
reply: TPingReply;
CurrentIP: string;
procedure OnReply;
procedure OnBegin;
procedure OnEnd;
procedure OnSend;
public
{ Public declarations }
OnBeginEvent: TNotifyEvent;
OnEndEvent: TNotifyEvent;
OnRecvEvent: TNotifyEvent;
OnSendEvent: TNotifyEvent;
constructor Create(IP_1, IP_2: string; time_out: integer);
end;
var
exit_ping_thread: boolean;
implementation
constructor TPingThread.Create(IP_1, IP_2: string; time_out: integer);
var
WSAData: TWSAData;
hICMPdll: HMODULE;
begin
wsastartup($101,wsadata);
hICMPdll := LoadLibrary('icmp.dll');
@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
IP1 := ntohl(inet_addr(pchar(IP_1)));
IP2 := ntohl(inet_addr(pchar(IP_2)));
TimeOut := time_out;
FreeOnTerminate := True;
inherited Create(True);
end;
procedure TPingThread.OnReply;
begin
if assigned(OnRecvEvent) then OnRecvEvent(reply);
end;
procedure TPingThread.OnBegin;
begin
if assigned(OnBeginEvent) then OnBeginEvent(nil);
end;
procedure TPingThread.OnEnd;
begin
if assigned(OnEndEvent) then OnEndEvent(nil);
end;
procedure TPingThread.OnSend;
begin
if assigned(OnSendEvent) then OnSendEvent(TObject(CurrentIP));
end;
procedure TPingThread.Execute;
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;
i: DWORD;
ret: integer;
begin
Synchronize(OnBegin);
reply := TPingReply.Create; // must be created.
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := 'a';
pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL := 64;
FTimeOut := TimeOut;
for i:=IP1 to IP2 do
begin
//去掉x.x.x.0或x.x.x.255的地址。
if (((i - 255) mod 256)=0)or((i mod 256)=0) then continue;
FIPAddress := htonl(i);
CurrentIP := inet_ntoa(in_addr(FIPAddress));
Synchronize(OnSend);
ret := IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);
if (ret<>0)and(pReqData^ = pIPE^.Options.OptionsData^) then
begin
reply.IP := CurrentIP;
reply.bytes := IntToStr(pIPE^.DataSize);
reply.RTT := IntToStr(pIPE^.RTT);
//if assigned(OnRecvEvent) then OnRecvEvent(reply);
Synchronize(OnReply);
end;
if exit_ping_thread then break;
end;
FreeMem(pRevData);
FreeMem(pIPE);
Synchronize(OnEnd);
end;
end.
|