unit PingThread;interfaceuses 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;implementationconstructor 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. Top 
