| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Проверить наличие коннекта к определенному IP [D7, Win2k, WinXP]

stas ©   (2008-11-27 21:52:00) 

Функция иипа Ping, но возвращает true,false
Как можно это реализовать?

---

Anatoly Podgoretsky   (2008-11-28 12:27:00) [1]

> Спасибо!

За что? Приведеная информация к вопросу отношения не имеет.

---

Сергей М.   (2008-11-28 09:03:00) [2]

> Функция иипа Ping


Такая функция не проверяет наличие коннекта.
С ее помощью можно лишь проверить доступность хоста по определенному протоколу (ICMP).

---

stas   (2008-11-28 09:02:00) [3]

Спасибо!

---

Eraser   (2008-11-27 23:08:00) [4]

unit ROMPing;

interface

uses
 Windows, SysUtils, Classes;

function Ping(InetAddress : string) : Boolean;

implementation

uses
 WinSock;

type
 TSunB = packed record
   s_b1, s_b2, s_b3, s_b4: byte;
 end;

 TSunW = packed record
   s_w1, s_w2: word;
 end;

 PIPAddr = ^TIPAddr;
 TIPAddr = record
   case integer of
     0: (S_un_b: TSunB);
     1: (S_un_w: TSunW);
     2: (S_addr: longword);
 end;
 IPAddr = TIPAddr;

type
 IP_OPTION_INFORMATION = record
   Ttl: Byte;          // Time To Live
   Tos: Byte;          // Type Of Service
   Flags: Byte;        // IP header flags
   OptionsSize: Byte;  // Size in bytes of options data
   OptionsData: PByte; // Pointer to options data
 end;
 PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;
 TIpOptionInformation = IP_OPTION_INFORMATION;
 PIpOptionInformation = PIP_OPTION_INFORMATION;

type
 ICMP_ECHO_REPLY = record
   Address: IPAddr;      // Replying address
   Status: ULONG;        // Reply IP_STATUS
   RoundTripTime: ULONG; // RTT in milliseconds
   DataSize: Word;     // Reply data size in bytes
   Reserved: Word;     // Reserved for system use
   Data: Pointer;         // Pointer to the reply data
   Options: IP_OPTION_INFORMATION; // Reply options
 end;
 PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
 TIcmpEchoReply = ICMP_ECHO_REPLY;
 PIcmpEchoReply = PICMP_ECHO_REPLY;

function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean;
 stdcall; external 'icmp.dll'
function IcmpSendEcho
  (IcmpHandle : THandle; DestinationAddress : IPAddr;
   RequestData : Pointer; RequestSize : Smallint;
   RequestOptions : pointer;
   ReplyBuffer : Pointer;
   ReplySize : DWORD;
   Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';

function Fetch(var AInput: string;
 const ADelim: string = ' '; const ADelete: Boolean = true): string;
var
 iPos: Integer;
begin
 if ADelim = #0 then begin
   // AnsiPos does not work with #0
   iPos := Pos(ADelim, AInput);
 end else begin
   iPos := Pos(ADelim, AInput);
 end;
 if iPos = 0 then begin
   Result := AInput;
   if ADelete then begin
     AInput := '';
   end;
 end else begin
   result := Copy(AInput, 1, iPos - 1);
   if ADelete then begin
     Delete(AInput, 1, iPos + Length(ADelim) - 1);
   end;
 end;
end;

procedure TranslateStringToTInAddr(AIP: AnsiString; var AInAddr);
var
 phe: PHostEnt;
 pac: PAnsiChar;
 GInitData: TWSAData;
begin
 WSAStartup($101, GInitData);
 try
   phe := GetHostByName(PAnsiChar(AIP));
   if Assigned(phe) then
   begin
     pac := phe^.h_addr_list^;
     if Assigned(pac) then
     begin
       with TIPAddr(AInAddr).S_un_b do begin
         s_b1 := Byte(pac[0]);
         s_b2 := Byte(pac[1]);
         s_b3 := Byte(pac[2]);
         s_b4 := Byte(pac[3]);
       end;
     end
     else
     begin
       raise Exception.Create('Error getting IP from HostName');
     end;
   end
   else
   begin
     raise Exception.Create('Error getting HostName');
   end;
 except
   FillChar(AInAddr, SizeOf(AInAddr), #0);
 end;
 WSACleanup;
end;

function Ping(InetAddress: string) : Boolean;
const
 IP_SUCCESS = 0;
var
Handle : THandle;
InAddr : IPAddr;
DW : DWORD;
sAnsiAddress: AnsiString;
Icmp: ICMP_ECHO_REPLY;
begin
 Result := False;
 Handle := IcmpCreateFile;
 if Handle = INVALID_HANDLE_VALUE then
   Exit;

 sAnsiAddress := AnsiString(InetAddress);
 TranslateStringToTInAddr(sAnsiAddress, InAddr);
 DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @Icmp, SizeOf(ICMP_ECHO_REPLY), 5000);
 Result := (DW <> 0) and (Icmp.Status = IP_SUCCESS);
 IcmpCloseHandle(Handle);
end;

end.

---

Наверх