Текущий архив: 2010.10.24;
Скачать: CL | DM;

Вниз

Проверить наличие коннекта к определенному IP   Найти похожие ветки 

← →
stas ©   (2008-11-27 21:52) [0]

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

---

← →
Eraser ©   (2008-11-27 23:08) [1]

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.

---

← →
stas ©   (2008-11-28 09:02) [2]

Спасибо!

---

← →
Сергей М. ©   (2008-11-28 09:03) [3]

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


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

---

← →
Anatoly Podgoretsky ©   (2008-11-28 12:27) [4]

> Спасибо!

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

---

Страницы: 1 вся ветка

Текущий архив: 2010.10.24;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.009 c