如何用delphi编写ping.exe程序(200分)

shangjintong · 2001-02-02

如何用delphi编写ping.exe程序

xujiancai · 2001-02-02

来自：garden_wood 时间：2000-6-22 8:50:15 ID：269817 see it: Delphi编程实现Ping操作  　　张泰立  　　使用过网络的用户都熟悉“Ping”这个指令，它是一个DOS下的可执行文件，一般用  它来检查网络连接的好坏程度。其基本原理是利用TCP/IP协议包中ICMP协议中的一个功  能，即向所指定的计算机发送一个请求，收到请求的计算机返回一个应答，借此来判断该  计算机是否在网上运行或者检查网络连接是否稳定可靠。在Ping程序执行过程中，双方  计算机所耗费的资源都很少，因此，它是一个非常实用的工具。  　　我们可以通过编程来实现“Ping”操作，对其加以改进，使之具有Windows的界面  风格，显示比DOS更加直观。  　　首先，对编程中需要的动态链接库作一简要说明：在Windows的System目录下，你  可以找到Icmp.dll文件，该动态链接库提供了ICMP协议的所有功能，我们的编程就建立  在  　　对该动态链接库的调用上。  　　Icmp.dll文件内的调用函数说明如下：  　　1、IcmpCreateFile  　　打开一个句柄，通过该句柄你可以发送ICMP的请求回送报文。  　　2、IcmpCloseHandle  　　关闭你通过IcmpCreateFile函数打开的句柄。  　　3、IcmpSendEcho  　　通过你打开的句柄发送ICMP请求，在超时或应答报文接收后返回。其参数基本上和  它的帧结构一致，可参看下面的程序部分，其具体含意你可以参看有关ICMP协议的书  籍。  　　初步了解了上述的三个函数后，我们就可以开始编程了。  　　首先，我们的程序运行后应该有如图1所示的基本功能。为此，我们可先在Delphi的  窗口中放入右上图中所示的控件，如按钮、编辑框和文本显示框等。  　　（G72.JPG）  　　例程运行示意图  　　然后，在程序的开始部分（FormCreate）对WinSocket进行初始化，其作用是申明  使用的版本信息，同时调入Icmp.dll库。  　　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;  　　 TMyPing = class(TForm)  　　 Panel1: TPanel;  　　 Label1: TLabel;  　　 PingEdit: TEdit;  　　 ExeBtn: TButton;  　　 Button2: TButton;  　　 Button3: TButton;  　　 StatusShow: TMemo;  　　 procedure Button3Click(Sender: TObject);  　　 procedure FormCreate(Sender: TObject);  　　 procedure ExeBtnClick(Sender: TObject);  　　 private  　　 { Private declarations }  　　 hICMP: THANDLE;  　　 IcmpCreateFile : TIcmpCreateFile;  　　 IcmpCloseHandle: TIcmpCloseHandle;  　　 IcmpSendEcho: TIcmpSendEcho;  　　 public  　　 { Public declarations }  　　end;  　　procedure TMyPing.FormCreate(Sender: TObject);  　　var  　　 WSAData: TWSAData;  　　 hICMPdll: HMODULE;  　　begin  ?  　　 // Load the icmp.dll stuff  　　 hICMPdll := LoadLibrary('icmp.dll');  　　 @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');  　　 @IcmpCloseHandle := GetProcAddress(hICMPdll,  'IcmpCloseHandle');  　　 @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');  　　 hICMP := IcmpCreateFile;  　　 StatusShow.Text := '';  　　 StatusShow.Lines.Add('目的IP地址字节数返回时间(毫秒)');  　　end;  　　接下来，就要进行如下所示的Ping操作的实际编程过程了。  　　procedure TMyPing.ExeBtnClick(Sender: TObject);  　　var  　　 IPOpt:TIPOptionInformation;// IP Options for packet to send  　　 FIPAddress

WORD;  　　 pReqData,pRevData

Char;  　　 pIPE

IcmpEchoReply;// ICMP Echo reply buffer  　　 FSize: DWORD;  　　 MyString:string;  　　 FTimeOut

WORD;  　　 BufferSize

WORD;  　　begin  　　 if PingEdit.Text <> '' then  　　 begin  　　 FIPAddress := inet_addr(PChar(PingEdit.Text));  　　 FSize := 40;  　　 BufferSize := SizeOf(TICMPEchoReply) + FSize;  　　 GetMem(pRevData,FSize);  　　 GetMem(pIPE,BufferSize);  　　 FillChar(pIPE^, SizeOf(pIPE^), 0);  　　 pIPE^.Data := pRevData;  　　 MyString := 'Hello,World';  　　 pReqData := PChar(MyString);  　　 FillChar(IPOpt, Sizeof(IPOpt), 0);  　　 IPOpt.TTL := 64;  　　 FTimeOut := 4000;  　　 IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),  @IPOpt, pIPE, BufferSize, FTimeOut);  　　 if pReqData^ = pIPE^.Options.OptionsData^ then  　　 begin  　　 StatusShow.Lines.Add(PChar(PingEdit.Text) + ' '  +IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT));  　　 end;  　　 begin  　　 StatusShow.Lines.Add(PChar(PingEdit.Text) + ' '  +IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT));  　　 end;  　　 FreeMem(pRevData);  　　 FreeMem(pIPE);  　　 end  　　end;  　　通过上面的编程，我们就实现了Ping功能的界面操作。实际上，ICMP协议的功能还  有很  　　多，都可以通过对Icmp.dll的函数调用来实现。

guotong · 2001-02-02

调用icmp.dll中的函数

honestman · 2001-02-02

ICS中有个PING的控件。

liersbaby · 2001-02-02

以下是我从www.delphi3000.com上paste来的,用icmp.dll,也可以用ics里的ping,不错 Question/Problem/Abstract: How to create the PING functionality from ICMP.DLL Answer: A Little PING application. Once a received a email from a VB developer asking how we can ping a host from a delphi application. But Whats&acute;s PING ? Ping is a protocol for testing whether a particular computer is connected to the Internet by sending a packet to its Internet Protocol (IP) address and waiting for a response. We build a little application that implements the ping funcionality. To do that we use the ICMP protocol implemented on ICMP.DLL. ICMP - Internet Control Message Protocol. The ICMP delivers error and control messages from hosts to the requesters.  An ICMP test can determine whether a destination is reachable and responding. 1. open Delphi; 2. On a new project, Add a Tbutton, a Tedit and a Tmemo in your form; 3. Insert the “winsock” in the uses clausule; 4. Declare a record constant to put the IP head: type   IPINFO = record   Ttl     :char;   Tos     :char;   IPFlags :char;   OptSize :char;   Options :^char; end; 5. Declare a record constant to put the ICMP package: type ICMPECHO = record Source  :longint; Status  :longint; RTTime  :longint; DataSize:Shortint; Reserved:Shortint; pData   :^variant; i_ipinfo:IPINFO; end; 6. Declare the functions/procedures that you wiil call from ICMP.DLL TIcmpCreateFile = function():integer; {$IFDEF WIN32} stdcall; {$ENDIF} TIcmpCloseHandle = procedure(var handle:integer);{$IFDEF WIN32} stdcall; {$ENDIF} TIcmpSendEcho = function(var handle:integer; endereco

WORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp

WORD; tempo

WORD)

WORD;{$IFDEF WIN32} stdcall; {$ENDIF} 7. In the Tbutton&acute;s Onclick event insert this code:: procedure TForm1.Button1Click(Sender: TObject); var wsadt : wsadata; icmp  :icmpecho; HNDicmp : integer; hndFile :integer; Host

HostEnt; Destino :in_addr; Endereco :^DWORD; IP : ipinfo; Retorno :integer; dwRetorno

WORD; x :integer; IcmpCreateFile : TIcmpCreateFile; IcmpCloseHandle : TIcmpCloseHandle; IcmpSendEcho : TIcmpSendEcho; begin     if (edit1.Text = '') then begin      Application.MessageBox('Enter a HostName ro a IP Adress',                            'Error', MB_OK);      exit;     end;     HNDicmp := LoadLibrary('ICMP.DLL');     if (HNDicmp <> 0) then begin        @IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');        @IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');        @IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');        if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or (@IcmpSendEcho=nil) then  begin          Application.MessageBox('Error getting ICMP Adress’,'Error', MB_OK);          FreeLibrary(HNDicmp);        end;     end;     Retorno := WSAStartup($0101,wsadt);     if (Retorno <> 0) then begin       Application.MessageBox('Can&acute;t Load WinSockets','WSAStartup', MB_OK);       WSACleanup();       FreeLibrary(HNDicmp);     end;     Destino.S_addr := inet_addr(Pchar(Edit1.text));     if (Destino.S_addr = 0) then begin        Host := GetHostbyName(PChar(Edit1.text));        end     else begin        Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);     end;     if (host = nil) then begin          Application.MessageBox('Host not found','Error', MB_OK);          WSACleanup();          FreeLibrary(HNDicmp);          exit;     end;     memo1.Lines.Add('Pinging ' + Edit1.text);     Endereco := @Host.h_addr_list;     HNDFile := IcmpCreateFile();     for x:= 0 to 4 do begin       Ip.Ttl := char(255);       Ip.Tos := char(0);       Ip.IPFlags := char(0);       Ip.OptSize := char(0);       Ip.Options := nil;       dwRetorno := IcmpSendEcho(                    HNDFile,                    Endereco^,                    null,                    0,                    Ip,                    Icmp,                    sizeof(Icmp),                    DWORD(5000));       Destino.S_addr := icmp.source;       Memo1.Lines.Add('Ping ' + Edit1.text);      end;    IcmpCLoseHandle(HNDFile);    FreeLibrary(HNDicmp);    WSACleanup(); end; This code is not complete functional, sometimes it&acute;s doesn&acute;t work with Hostnames, only with IP adresses. For NT users don&acute;t use the IcmpCloseHandle function. If you have some idea to make this code work better, mail me. That&acute;s All….. Now, the complete unit &acute;s code: ---------------------------------- unit Unit1; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   winsock, StdCtrls; type   IPINFO = record   Ttl     :char;   Tos     :char;   IPFlags :char;   OptSize :char;   Options :^char; end; type ICMPECHO = record Source  :longint; Status  :longint; RTTime  :longint; DataSize:Shortint; Reserved:Shortint; pData   :^variant; i_ipinfo:IPINFO; end; TIcmpCreateFile = function():integer; {$IFDEF WIN32} stdcall; {$ENDIF} TIcmpCloseHandle = procedure(var handle:integer);{$IFDEF WIN32} stdcall; {$ENDIF} TIcmpSendEcho = function(var handle:integer; endereco

WORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp

WORD; tempo

WORD)

WORD;{$IFDEF WIN32} stdcall; {$ENDIF} type   TForm1 = class(TForm)     Button1: TButton;     Button2: TButton;     Edit1: TEdit;     Memo1: TMemo;     procedure Button1Click(Sender: TObject);     procedure Button2Click(Sender: TObject);   private     { Private declarations }   public   end; var   Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var wsadt : wsadata; icmp  :icmpecho; HNDicmp : integer; hndFile :integer; Host

HostEnt; Destino :in_addr; Endereco :^DWORD; IP : ipinfo; Retorno :integer; dwRetorno

WORD; x :integer; IcmpCreateFile : TIcmpCreateFile; IcmpCloseHandle : TIcmpCloseHandle; IcmpSendEcho : TIcmpSendEcho; begin     if (edit1.Text = '') then begin      Application.MessageBox('Digite um HostName ou um End. IP',                            'Error', MB_OK);      exit;     end;     HNDicmp := LoadLibrary('ICMP.DLL');     if (HNDicmp <> 0) then begin        @IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');        @IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');        @IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');        if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or (@IcmpSendEcho=nil) then  begin          Application.MessageBox('Erro pegando endere&ccedil;os ICMP','Error', MB_OK);          FreeLibrary(HNDicmp);        end;     end;     Retorno := WSAStartup($0101,wsadt);     if (Retorno <> 0) then begin       Application.MessageBox('N&atilde;o foi possível carregar WinSockets','WSAStartup', MB_OK);       WSACleanup();       FreeLibrary(HNDicmp);     end;     Destino.S_addr := inet_addr(Pchar(Edit1.text));     if (Destino.S_addr = 0) then begin        Host := GetHostbyName(PChar(Edit1.text));        end     else begin        Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);     end;     if (host = nil) then begin          Application.MessageBox('Host n&atilde;o encontrado','Error', MB_OK);          WSACleanup();          FreeLibrary(HNDicmp);          exit;     end;     memo1.Lines.Add('Pinging ' + Edit1.text);     Endereco := @Host.h_addr_list;     HNDFile := IcmpCreateFile();     for x:= 0 to 4 do begin       Ip.Ttl := char(255);       Ip.Tos := char(0);       Ip.IPFlags := char(0);       Ip.OptSize := char(0);       Ip.Options := nil;       dwRetorno := IcmpSendEcho(                    HNDFile,                    Endereco^,                    null,                    0,                    Ip,                    Icmp,                    sizeof(Icmp),                    DWORD(5000));       Destino.S_addr := icmp.source;       Memo1.Lines.Add('Pingou ' + Edit1.text);      end;    IcmpCLoseHandle(HNDFile);    FreeLibrary(HNDicmp);    WSACleanup(); end; end.

beta · 2001-02-02

uses ...WinSock; const   IcmpDLL = 'icmp.dll';   TimeOut = 5000; ......   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

WORD;     RequestData

ointer;     RequestSize:Word;     RequestOptions

IPOptionInformation;     ReplyBuffer: Pointer;     ReplySize: DWord;     Timeout: DWord   &nbsp

: DWord; stdcall; ...... var   hICMPlib: HModule;   IcmpCreateFile: TIcmpCreateFile;   IcmpCloseHandle: TIcmpCloseHandle;   IcmpSendEcho: TIcmpSendEcho;   hICMP: THandle;// Handle for the ICMP Calls   Size: integer;   Address: DWord;                     // Address of host to contact   HostName, HostIP: String;           // Name and dotted IP of host to contact   Phe: PHostEnt;                      // HostEntry buffer for name lookup   BufferSize, nPkts: Integer;   pReqData, pData: Pointer;   pIPE: PIcmpEchoReply;               // ICMP Echo reply buffer   IPOpt: TIPOptionInformation;        // IP Options for packet to send ...... procedure TForm1.FormCreate(Sender: TObject); var   wsadata: TWSAData; begin   // initialise winsock   if WSAStartup($101, wsadata) <> 0 then   begin    ShowMessage('初始化Winsock错误');    halt;   end;   // register the icmp.dll stuff   hICMPlib := loadlibrary(icmpDLL);   if hICMPlib <> null then   begin    @ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');    @IcmpCloseHandle:= GetProcAddress(hICMPlib, 'IcmpCloseHandle');    @IcmpSendEcho:= GetProcAddress(hICMPlib, 'IcmpSendEcho');    if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then    begin     ShowMessage('读入函数出错');     halt;    end;    hICMP := IcmpCreateFile;    if hICMP = INVALID_HANDLE_VALUE then    begin     ShowMessage('无效句柄');     halt;    end;   end   else   begin    ShowMessage('库注册错误');    halt;   end; end; procedure TForm1.Ping; begin   Memo1.Lines.Add('发出 ' + IntToStr(Size) + ' 字节给 ' +                   HostName + ' (' + HostIP + ')');   // Get some data buffer space and put something in the packet to send   BufferSize := SizeOf(TICMPEchoReply) + Size;   GetMem(pReqData, Size);   GetMem(pData, Size);   GetMem(pIPE, BufferSize);   FillChar(pReqData^, Size, $AA);   pIPE^.Data := pData;   // Finally Send the packet   FillChar(IPOpt, SizeOf(IPOpt), 0);   IPOpt.TTL := 64;   NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,                         @IPOpt, pIPE, BufferSize, TimeOut);   if NPkts = 0 then    ShowError(GetLastError)   else   begin    HostIP := StrPas(inet_ntoa(TInAddr(pIPE^.Address)));    Memo1.Lines.Add('收到 ' + IntToStr(pIPE^.DataSize) +                    ' 字节,来自: ' + HostIP + #13#10 +                    '用时: ' + IntToStr(pIPE^.RTT) + ' 毫秒')   end;   // Free those buffers   FreeMem(pIPE);   FreeMem(pData);   FreeMem(pReqData);   Memo1.Lines.Add(''); end;

shangjintong · 2001-02-03

多人接受答案了。

如何用delphi编写ping.exe程序(200分)

shangjintong

Unregistered / Unconfirmed

xujiancai

Unregistered / Unconfirmed

guotong

Unregistered / Unconfirmed

honestman

Unregistered / Unconfirmed

liersbaby

Unregistered / Unconfirmed

beta

Unregistered / Unconfirmed

shangjintong

Unregistered / Unconfirmed

Similar threads