用Delphi实现Ping类

网络上的一个实现PING功能的类，修改了部分代码。
=======================================

unit ping;

interface

uses

Windows, SysUtils, Classes,  Controls, Winsock, StdCtrls;

function pingip(ip:string):string;

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;

Tping =class(Tobject)
  private
    { Private declarations }
    hICMP: THANDLE;
    IcmpCreateFile : TIcmpCreateFile;
    IcmpCloseHandle: TIcmpCloseHandle;
    IcmpSendEcho: TIcmpSendEcho;
  public
    procedure   pinghost(ip:string;var info:string);
    constructor create;
    destructor destroy;override;
    { Public declarations }
end;

var
  hICMPdll: HMODULE;

implementation

constructor Tping.create;
begin
  inherited create;
  hICMPdll := LoadLibrary('icmp.dll');
  @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
  @IcmpCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
  @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
  hICMP := IcmpCreateFile;
end;

destructor Tping.destroy;
begin
  FreeLibrary(hIcmpDll);
  inherited destroy;
end;

procedure Tping.pinghost(ip:string;var info:string);
var
  // IP Options for packet to send
  IPOpt:TIPOptionInformation;
  FIPAddress:DWORD;
  pReqData,pRevData:PChar;
  // ICMP Echo reply buffer
  pIPE:PIcmpEchoReply;
  FSize: DWORD;
  MyString:string;
  FTimeOut:DWORD;
  BufferSize:DWORD;
begin
  if ip<>'' then
  begin
    FIPAddress := inet_addr(PChar(ip));
    FSize := 40;
    BufferSize := SizeOf(TICMPEchoReply) + FSize;
    GetMem(pRevData,FSize);
    GetMem(pIPE,BufferSize);
    FillChar(pIPE^, SizeOf(pIPE^), 0);
    pIPE^.Data := pRevData;
    MyString := 'Test Net - Sos Admin';
    pReqData := PChar(MyString);
    FillChar(IPOpt, Sizeof(IPOpt), 0);
    IPOpt.TTL := 64;
    FTimeOut := 4000;
    try
      IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, BufferSize, FTimeOut);
      if pReqData^ = pIPE^.Options.OptionsData^ then
        info:=ip+ '　' + IntToStr(pIPE^.DataSize) + '　　　' +IntToStr(pIPE^.RTT);
    except
      info:='Can not find host!';
      FreeMem(pRevData);
      FreeMem(pIPE);
      Exit;
    end;
    FreeMem(pRevData);
    FreeMem(pIPE);
  end;
end;

function pingip(ip:string):string;
var
  str:string;
  ping:Tping;
begin
  ping:=Tping.create ;//一定要初试化哦
  ping.pinghost('127.0.0.1',str);
  result:=str;
  ping.destroy ;
end;
end.

posted @ 2009-04-29 21:56 小宇飞刀阅读(191) 评论(0) 收藏举报

刷新页面返回顶部

小宇飞刀(xieyunc)

小宇飞刀的网络家园 | 谢祥选的技术博客

用Delphi实现Ping类

公告