F
flyso
Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,winsock;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure ShowError(error: Integer);
public
{ Public declarations }
end;
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation=packed record
TTL:Byte; //Time To Live,主要用于路由
TOS:Byte; //Type Of Service,通常为零
Flags:Byte; //IP header flags,通常为零
OptionsSize:Byte; //Size of options data,通常为零,最大为40
OptionsDataChar; //数据缓冲
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply= packed record
AddressWord; //回应地址
StatusWord; //IP状态值,看下
RTTWord; //Round Trip Time in milliseconds
DataSize:Word; //返回数据大小
Reserved:Word;
Dataointer; //指向回应数据缓冲区
Options:TIPOptionInformation; //Reply options
end;
TIcmpCreateFile=function:THandle;stdcall;
TIcmpCloseHandle=function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho=function(IcmpHandle:THandle;
DestinatonAddressWord;
RequestDataointer;
RequestSize:Word;
RequestOptionsIPOptionInformation;
ReplyBufferointer;
ReplySizeWord;
TimeoutWord
)Word;stdcall;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
IcmpDLL = 'ICMP.DLL';
var
hICMPlib: HModule;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
hICMP: THandle; // Handle for the ICMP Calls
procedure TForm1.FormCreate(Sender: TObject);
var
wsadata:TWSADATA;//所有windows sockets函数处理前的准备工作
begin
if WSAStartup($101,wsadata)<>0 then begin
ShowMessage('initialising Winsock 错误');
halt;
end;
hICMPlib := loadlibrary(icmpDLL); //加载可执行模块到指定位置,有关loadlibrary(icmppDLL)
//理解,请参阅编程思想部分说明
if hICMPlib <> 0 then begin
@ICMPCreateFile:=GetProcAddress(hICMPlib,'IcmpCreateFile');
//返回指定的输入DLLs函数的地址,以下格式相同
@IcmpCloseHandle:=GetProcAddress(hICMPlib,'IcmpCloseHandle');
@IcmpSendEcho:=GetProcAddress(hICMPlib,'IcmpSendEcho');
if (@ICMPCreateFile=Nil) or (@IcmpCloseHandle=NIL) or (@IcmpSendEcho=NIL) then
begin
ShowMessage('载入DLL函数错误');
halt;
end;
hICMP:=IcmpCreateFile;
if hICMP=INVALID_HANDLE_VALUE then begin //无效句柄值
ShowMessage('不能够得到ping句柄');
halt;
end;
end
else begin
ShowMessage('不能够注册'+'icmpDLL');
halt;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
Size=56;
TimeOut=3000;
var
AddressWord; //链接目标的地址
HostName,HostIP:String; //点分形式的主机地址
PheHostEnt; //待查主机实体缓冲地址
BufferSize,nPkts:Integer;
pReqData,pDataointer;
pIPEIcmpEchoReply; //ICMP回应缓冲地址
IPOpt:TIPOptionInformation; //IP Options 的发送包
begin
//查询
Address:=inet_addr(PChar(Edit1.Text));
if (Address=INADDR_NONE) then begin //地址出现错误
Phe:=GetHostByName(PChar(Edit1.Text)); //获取与主机名相关的主机信息
if Phe=NIl then ShowError(WSAGetLastError)
else begin
Address:=longint(plongint(Phe^.h_addr_list^)^);
HostName:=Phe^.h_name;
HostIP:=StrPas(inet_ntoa(TInAddr(Address)));
end;
end
else begin
Phe:=GetHostByAddr(@Address,4,PF_INET); //获取主机的地址信息
if Phe=NIL then ShowError(WSAGetLastError)
else begin
HostName:=Phe^.h_name;
HostIP:=StrPas(inet_ntoa(TInAddr(Address))); //将IP转换成点分字符串
end;
end;
if Address=INADDR_NONE then begin
Memo1.lines.add('不能解析主机名'+Edit1.Text);
end
else begin
Memo1.Lines.Add('发送'+IntToStr(Size)+'字节到'+HostName+'('+HostIP+')');
//获取数据缓冲空间,发送一些包
BufferSize:=SizeOf(TICMPEchoReply)+Size;
GetMem(pReqData,Size);
GetMem(pData,Size);
GetMem(pIPE,BufferSize);
FillChar(pReqData^,Size,$AA);
pIPE^.Data:=pData;
//最后发送的包
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+' 耗时'+intToStr
(pIPE^.RTT)+'兆秒')
end;
//释放这些空间
FreeMem(pIPE);FreeMem(pData);FreeMem(pReqData);
end;
end;
procedure TForm1.ShowError(error: integer);
begin
Memo1.Lines.Add('错误: ' + IntToStr(error));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Free icmp.dll
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPlib);
// free winsock
if WSACleanup <> 0 then ShowMessage('Error freeing winsock');
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,winsock;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure ShowError(error: Integer);
public
{ Public declarations }
end;
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation=packed record
TTL:Byte; //Time To Live,主要用于路由
TOS:Byte; //Type Of Service,通常为零
Flags:Byte; //IP header flags,通常为零
OptionsSize:Byte; //Size of options data,通常为零,最大为40
OptionsDataChar; //数据缓冲
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply= packed record
AddressWord; //回应地址
StatusWord; //IP状态值,看下
RTTWord; //Round Trip Time in milliseconds
DataSize:Word; //返回数据大小
Reserved:Word;
Dataointer; //指向回应数据缓冲区
Options:TIPOptionInformation; //Reply options
end;
TIcmpCreateFile=function:THandle;stdcall;
TIcmpCloseHandle=function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho=function(IcmpHandle:THandle;
DestinatonAddressWord;
RequestDataointer;
RequestSize:Word;
RequestOptionsIPOptionInformation;
ReplyBufferointer;
ReplySizeWord;
TimeoutWord
)Word;stdcall;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
IcmpDLL = 'ICMP.DLL';
var
hICMPlib: HModule;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
hICMP: THandle; // Handle for the ICMP Calls
procedure TForm1.FormCreate(Sender: TObject);
var
wsadata:TWSADATA;//所有windows sockets函数处理前的准备工作
begin
if WSAStartup($101,wsadata)<>0 then begin
ShowMessage('initialising Winsock 错误');
halt;
end;
hICMPlib := loadlibrary(icmpDLL); //加载可执行模块到指定位置,有关loadlibrary(icmppDLL)
//理解,请参阅编程思想部分说明
if hICMPlib <> 0 then begin
@ICMPCreateFile:=GetProcAddress(hICMPlib,'IcmpCreateFile');
//返回指定的输入DLLs函数的地址,以下格式相同
@IcmpCloseHandle:=GetProcAddress(hICMPlib,'IcmpCloseHandle');
@IcmpSendEcho:=GetProcAddress(hICMPlib,'IcmpSendEcho');
if (@ICMPCreateFile=Nil) or (@IcmpCloseHandle=NIL) or (@IcmpSendEcho=NIL) then
begin
ShowMessage('载入DLL函数错误');
halt;
end;
hICMP:=IcmpCreateFile;
if hICMP=INVALID_HANDLE_VALUE then begin //无效句柄值
ShowMessage('不能够得到ping句柄');
halt;
end;
end
else begin
ShowMessage('不能够注册'+'icmpDLL');
halt;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
Size=56;
TimeOut=3000;
var
AddressWord; //链接目标的地址
HostName,HostIP:String; //点分形式的主机地址
PheHostEnt; //待查主机实体缓冲地址
BufferSize,nPkts:Integer;
pReqData,pDataointer;
pIPEIcmpEchoReply; //ICMP回应缓冲地址
IPOpt:TIPOptionInformation; //IP Options 的发送包
begin
//查询
Address:=inet_addr(PChar(Edit1.Text));
if (Address=INADDR_NONE) then begin //地址出现错误
Phe:=GetHostByName(PChar(Edit1.Text)); //获取与主机名相关的主机信息
if Phe=NIl then ShowError(WSAGetLastError)
else begin
Address:=longint(plongint(Phe^.h_addr_list^)^);
HostName:=Phe^.h_name;
HostIP:=StrPas(inet_ntoa(TInAddr(Address)));
end;
end
else begin
Phe:=GetHostByAddr(@Address,4,PF_INET); //获取主机的地址信息
if Phe=NIL then ShowError(WSAGetLastError)
else begin
HostName:=Phe^.h_name;
HostIP:=StrPas(inet_ntoa(TInAddr(Address))); //将IP转换成点分字符串
end;
end;
if Address=INADDR_NONE then begin
Memo1.lines.add('不能解析主机名'+Edit1.Text);
end
else begin
Memo1.Lines.Add('发送'+IntToStr(Size)+'字节到'+HostName+'('+HostIP+')');
//获取数据缓冲空间,发送一些包
BufferSize:=SizeOf(TICMPEchoReply)+Size;
GetMem(pReqData,Size);
GetMem(pData,Size);
GetMem(pIPE,BufferSize);
FillChar(pReqData^,Size,$AA);
pIPE^.Data:=pData;
//最后发送的包
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+' 耗时'+intToStr
(pIPE^.RTT)+'兆秒')
end;
//释放这些空间
FreeMem(pIPE);FreeMem(pData);FreeMem(pReqData);
end;
end;
procedure TForm1.ShowError(error: integer);
begin
Memo1.Lines.Add('错误: ' + IntToStr(error));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Free icmp.dll
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPlib);
// free winsock
if WSACleanup <> 0 then ShowMessage('Error freeing winsock');
end;
end.