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.