实现PING链接的问题! (50分)

  • 主题发起人 主题发起人 flyso
  • 开始时间 开始时间
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
OptionsData:PChar; //数据缓冲
end;

PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply= packed record
Address:DWord; //回应地址
Status:DWord; //IP状态值,看下
RTT:DWord; //Round Trip Time in milliseconds
DataSize:Word; //返回数据大小
Reserved:Word;
Data:Pointer; //指向回应数据缓冲区
Options:TIPOptionInformation; //Reply options
end;

TIcmpCreateFile=function:THandle;stdcall;
TIcmpCloseHandle=function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho=function(IcmpHandle:THandle;
DestinatonAddress:DWord;
RequestData:Pointer;
RequestSize:Word;
RequestOptions:PIPOptionInformation;
ReplyBuffer:Pointer;
ReplySize:DWord;
Timeout:DWord
):DWord;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
Address:DWord; //链接目标的地址
HostName,HostIP:String; //点分形式的主机地址
Phe:PHostEnt; //待查主机实体缓冲地址
BufferSize,nPkts:Integer;
pReqData,pData:Pointer;
pIPE:PIcmpEchoReply; //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.

 
你把showmessage改成messageBox(0,'nihao','nihao ',MB_OK);
 
看上面,我改了一下,虽然能够编译,但是ping出的东西有错误,不管ping哪个网址
都显示如下:
错误: 11004
发送56字节到()
接收56字节 来自255.255.255.255 耗时137兆秒

编译的时候出现下面提示:
[Warning] Unit1.pas(129): Comparison always evaluates to False
[Warning] Unit1.pas(129): Comparing signed and unsigned types - widened both operands
[Warning] Unit1.pas(146): Comparison always evaluates to False
[Warning] Unit1.pas(146): Comparing signed and unsigned types - widened both operands
 
接受答案了.
 
后退
顶部