Windows supports an Internet Control Message Protocol (ICMP) to determine whether
or not a particular host is available. ICMP is a network layer protocol that
delivers flow control, error messages, routing, and other data between Internet
hosts. ICMP is primarily used by application developers for a network ping.
A ping is the process of sending an echo message to an IP address and reading the
reply to verify a connection between TCP/IP hosts.
If you are writing new application will be better to use the Winsock 2 raw sockets
support, implemented in Indy, for example.
Please note, however, that for Windows NT and Windows 2000 implementations, Raw
Sockets are subject to security checks and are accessible only to members of the
administrator's group.
Icmp.dll provides functionality that allows developers to write Internet ping
applications on Windows systems without Winsock 2 support.
Note that the Winsock 1.1 WSAStartup function must be called prior to using the
functions exposed by ICMP.DLL.
If you do not do this, the first call to IcmpSendEcho will fail with error 10091
(WSASYSNOTREADY).
1 unit Ping;
2
3 interface
4 uses
5 Windows, SysUtils, Classes;
6
7 type
8 TSunB = packed record
9 s_b1, s_b2, s_b3, s_b4: byte;
10 end;
11
12 TSunW = packed record
13 s_w1, s_w2: word;
14 end;
15
16 PIPAddr = ^TIPAddr;
17 TIPAddr = record
18 case integer of
19 0: (S_un_b: TSunB);
20 1: (S_un_w: TSunW);
21 2: (S_addr: longword);
22 end;
23
24 IPAddr = TIPAddr;
25
26 function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
27 function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcall; external
28 'icmp.dll'
29 function IcmpSendEcho (IcmpHandle : THandle; DestinationAddress : IPAddr;
30 RequestData : Pointer; RequestSize : Smallint;
31 RequestOptions : pointer;
32 ReplyBuffer : Pointer;
33 ReplySize : DWORD;
34 Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';
35
36
37 function Ping(InetAddress : string) : boolean;
38
39 implementation
40
41 uses
42 WinSock;
43
44 function Fetch(var AInput: string; const ADelim: string = ' '; const ADelete:
45 Boolean = true)
46 : string;
47 var
48 iPos: Integer;
49 begin
50 if ADelim = #0 then begin
51 // AnsiPos does not work with #0
52 iPos := Pos(ADelim, AInput);
53 end else begin
54 iPos := Pos(ADelim, AInput);
55 end;
56 if iPos = 0 then begin
57 Result := AInput;
58 if ADelete then begin
59 AInput := '';
60 end;
61 end else begin
62 result := Copy(AInput, 1, iPos - 1);
63 if ADelete then begin
64 Delete(AInput, 1, iPos + Length(ADelim) - 1);
65 end;
66 end;
67 end;
68
69 procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
70 var
71 phe: PHostEnt;
72 pac: PChar;
73 GInitData: TWSAData;
74 begin
75 WSAStartup($101, GInitData);
76 try
77 phe := GetHostByName(PChar(AIP));
78 if Assigned(phe) then
79 begin
80 pac := phe^.h_addr_list^;
81 if Assigned(pac) then
82 begin
83 with TIPAddr(AInAddr).S_un_b do begin
84 s_b1 := Byte(pac[0]);
85 s_b2 := Byte(pac[1]);
86 s_b3 := Byte(pac[2]);
87 s_b4 := Byte(pac[3]);
88 end;
89 end
90 else
91 begin
92 raise Exception.Create('Error getting IP from HostName');
93 end;
94 end
95 else
96 begin
97 raise Exception.Create('Error getting HostName');
98 end;
99 except
100 FillChar(AInAddr, SizeOf(AInAddr), #0);
101 end;
102 WSACleanup;
103 end;
104
105 function Ping(InetAddress : string) : boolean;
106 var
107 Handle : THandle;
108 InAddr : IPAddr;
109 DW : DWORD;
110 rep : array[1..128] of byte;
111 begin
112 result := false;
113 Handle := IcmpCreateFile;
114 if Handle = INVALID_HANDLE_VALUE then
115 Exit;
116 TranslateStringToTInAddr(InetAddress, InAddr);
117 DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
118 Result := (DW <> 0);
119 IcmpCloseHandle(Handle);
120 end;
121
122 end.
|
