很多时候不检查局域网内的IP是否连通,直接通过IP访问,程序会卡住很久,有1分钟左右,这给用户的体验非常不好,现在通过检查是否连通,设置为1.5S后不连通则不进行后面的操作,程序效率大大提升,如下是检查局域网内的IP或者外网的IP是否连通的实现。
后面的代码直接保存为Ping.Pas,即可直接使用,下面是使用方法 :
var
str: string;
ping: Tping;
isconOK: Boolean;
begin
ping := Tping.create; //一定要初试化,否则下次打开会卡住程序
ping.pinghost('192.168.1.100', str, isconOK); //ping IP 192.168.1.100 //
ping.destroy;
if isconOK then
begin //IP能ping通,则进行更新 .否则不进行更新,这是为了避免 长时间等待
ShowMessage('ping OK');
end;
end;
如下是Ping.pas文件的所有内容
unit Ping;
interface
uses
Windows, SysUtils, Classes, Controls, Winsock, StdCtrls;
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;
Tping = class(Tobject)
private
{ Private declarations }
hICMP: THANDLE;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
public
procedure pinghost(ip: string; var info: string; var IsConnectedOk: Boolean);
constructor create;
destructor destroy; override;
{ Public declarations }
end;
var
hICMPdll: HMODULE;
implementation
constructor Tping.create;
begin
inherited create;
hICMPdll := LoadLibrary('icmp.dll');
@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
end;
destructor Tping.destroy;
begin
FreeLibrary(hIcmpDll);
inherited destroy;
end;
procedure Tping.pinghost(ip: string; var info: string; var IsConnectedOk: Boolean);
var
// IP Options for packet to send
IPOpt: TIPOptionInformation;
FIPAddress: DWORD;
pReqData, pRevData: PChar;
// ICMP Echo reply buffer
pIPE: PIcmpEchoReply;
FSize: DWORD;
MyString: string;
FTimeOut: DWORD;
BufferSize: DWORD;
isConnected: Integer;
begin
if ip <> '' then
begin
// FIPAddress := inet_addr(PChar(ip));//Delphi 7
IsConnectedOk := False;
FIPAddress := inet_addr(PAnsiChar(AnsiString(ip)));
isConnected := 0;
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData, FSize);
GetMem(pIPE, BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := 'Test Net – Sos Admin';
pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL := 64;
FTimeOut := 1500; //连接时间,1500MS 1.5S后停止
try
isConnected := IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), //
@IPOpt, pIPE, BufferSize, FTimeOut);
if isConnected = 1 then
begin
info := '连通';
IsConnectedOk := True;
end
else
begin
info := '不连通';
IsConnectedOk := False;
end;
info := info + ' ' + ip + ' time= ' + IntToStr(pIPE^.RTT);
// if pReqData^ = pIPE^.Options.OptionsData^then
// info := ip + ' ' + IntToStr(pIPE^.DataSize) + ' ' + IntToStr(pIPE^.RTT);
except
info := 'Can not find host!';
FreeMem(pRevData);
FreeMem(pIPE);
Exit;
end;
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
end.