unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, WinSock;
type
ip_option_information = packed record // header of an IP packet
// Otherwise, the route option should be formatted as specified in RFC 791
Ttl: byte; // Time to live
Tos: byte; // Type of service, generally 0
Flags: byte; // IP header flags, generally 0
OptionsSize: byte; // Size in bytes of options data, generally 0, max 40
OptionsData: Pointer; // Pointer to options data
end;
icmp_echo_reply = packed record
Address: u_long; // Replying address, in the form of an IPAddr structure
Status: u_long; // Status of the echo request,
//in the form of an IP_STATUS code
RTTime: u_long; // Round trip time, in milliseconds
DataSize: u_short; // Reply data size, in bytes
Reserved: u_short; // Reserved for system use
Data: Pointer; // Pointer to the reply data
Options: ip_option_information; // Reply options, in the form of an
// IP_OPTION_INFORMATION structure
end;
PIPINFO = ^ip_option_information;
PVOID = Pointer;
function IcmpCreateFile(): THandle; stdcall;
external 'ICMP.DLL' name 'IcmpCreateFile';
function IcmpCloseHandle(IcmpHandle: THandle): BOOL; stdcall;
external 'ICMP.DLL' name 'IcmpCloseHandle';
function IcmpSendEcho(IcmpHandle: THandle; // handle, returned IcmpCreateFile()
DestAddress: u_long; // Destination IP Address
RequestData: PVOID; // The buffer that contains the data to send in the request
RequestSize: Word; // The size, in bytes, of the request data buffer.
RequestOptns: PIPINFO; // A pointer to the IP header options for the request,
//in the form of an IP_OPTION_INFORMATION structure.
//May be NULL
ReplyBuffer: PVOID; // A buffer to hold any replies to the request.
ReplySize: DWORD; // The allocated size, in bytes, of the reply buffer.
// The buffer should be large enough to hold at least one
// ICMP_ECHO_REPLY structure plus RequestSize bytes of data.
Timeout: DWORD // The time, in milliseconds, to wait for replies.
): DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
// function InternetGetConnectedState(lpdwFlags: LPDWORD; dwReserved: DWORD): BOOL;
// stdcall; external 'wininet.dll' name 'InternetGetConnectedState';
// function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';
function ping_iphost(iphost: PAnsiChar): Boolean;
implementation
uses Wininet;
{$R *.dfm}
function InternetConnected: Boolean;
var
lpdwConnectionTypes: DWORD;
begin
lpdwConnectionTypes := INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
{ Returns TRUE if there is an active modem or a LAN Internet connection,
or FALSE if there is no Internet connection, or if all possible Internet
connections are not currently active.}
Result := InternetGetConnectedState(@lpdwConnectionTypes, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// checking internet connection
// function ping_iphost(IP_HOST): TRUE — internet is ON, FALSE — internet is OFF
// sent ICMP echo reply
if ping_iphost('8.8.8.8') then
ShowMessage('You are connected to Internet!')
else
ShowMessage('This computer is not connected to Internet!');
end;
function ping_iphost(iphost: PAnsiChar): Boolean;
var
hIP: THandle;
pingBuffer: array [0 .. 31] of AnsiChar;
pIpe: ^icmp_echo_reply;
error: DWORD;
begin
Result := True;
pingBuffer := 'Data Buffer';
// Create handle
hIP := IcmpCreateFile();
//allocates a memory block
GetMem(pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer));
try
// sends an ICMP Echo request and returns any replies
IcmpSendEcho(hIP, inet_addr(iphost), @pingBuffer,
sizeof(pingBuffer), Nil, pIpe, sizeof(icmp_echo_reply) +
sizeof(pingBuffer), 1000);
// Returns the last error reported by an operating system API call
error := GetLastError();
if (error <> 0) then
begin
Result := False;
end;
finally
//closes a handle opened by a call to IcmpCreateFile
IcmpCloseHandle(hIP);
// terminates use of the WS2_32.DLL
WSACleanup();
// frees a memory block previously allocated with GetMem
FreeMem(pIpe);
end;
end;
end.
