用ICS组件中的PING控件
或者
从 ICMP.DLL 中调用
下面是一个例子
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´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´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.
