Mega Code Archive
A Little PING application
<![CDATA[
Title: A Little PING application.
Question: 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 Whatss 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:DWORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD; tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}
7. In the Tbuttons Onclick event insert this code::
procedure TForm1.Button1Click(Sender: TObject);
var
wsadt : wsadata;
icmp :icmpecho;
HNDicmp : integer;
hndFile :integer;
Host :PHostEnt;
Destino :in_addr;
Endereco :^DWORD;
IP : ipinfo;
Retorno :integer;
dwRetorno :DWORD;
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('Cant 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 its doesnt work with Hostnames, only with IP adresses. For NT users dont use the IcmpCloseHandle function. If you have some idea to make this code work better, mail me.
Thats All..
Now, the complete unit 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:DWORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD; tempo:DWORD):DWORD;{$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 :PHostEnt;
Destino :in_addr;
Endereco :^DWORD;
IP : ipinfo;
Retorno :integer;
dwRetorno :DWORD;
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 endereos ICMP','Error', MB_OK);
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);
if (Retorno 0) then begin
Application.MessageBox('No foi possvel 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 no 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.
--------------------------------------------
]]>