In many cases, if you do not check whether the IP in the LAN is connected, and directly access it through the IP, the program will be stuck for a long time, about 1 minute, which gives the user a very bad experience. Now, by checking whether the IP is connected, if it is set to 1.5S and then it is not connected. Without the following operations, the program efficiency is greatly improved. The following is the implementation of checking whether the IP in the LAN or the IP in the external network is connected.
The following code is directly saved as Ping.Pas and can be used directly. The following is the usage method:
var
str: string;
ping: Tping;
isconOK: Boolean;
begin
ping := Tping.create; //Must be initialized, otherwise the program will be stuck next time you open it
ping.pinghost('192.168.1.100', str, isconOK) ; //ping IP 192.168.1.100 //
ping.destroy;
if isconOK then
begin //IP can be pinged, then update. Otherwise, do not update, this is to avoid long waiting
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.