多线程ping代码

 

	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.
Top

	回复人： cqwty(笨小孩) ( ) 信誉：92	2005-08-31 17:02:00	得分:0
	对了，如果要原代码我给你,或者www.2ccc.com下载,名字叫做:LanExplorer1.52