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

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

ping? D7 enterprize [D7]


HaJik ©   (2007-09-26 22:10:00) 

Требуется функцию, которая пингует удаленый компьютер, а возвращает время ответа удаленого компьютера.


HaJik   (2007-09-28 15:27:00) [1]

Eraser - Респект, тебе и уважуха. Помог.


Eraser   (2007-09-28 01:25:00) [2]

> [3] Rav   (27.09.07 07:09)

для этого требуются права админа.
вот более универсальное синхронное решение
unit Ping;

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;

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: string; var AInAddr);
var
 phe: PHostEnt;
 pac: PChar;
 GInitData: TWSAData;
begin
 WSAStartup($101, GInitData);
 try
   phe := GetHostByName(PChar(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;
var
Handle : THandle;
InAddr : IPAddr;
DW : DWORD;
rep : array[1..128] of byte;
begin
 Result := False;
 Handle := IcmpCreateFile;
 if Handle = INVALID_HANDLE_VALUE then
  Exit;
 TranslateStringToTInAddr(InetAddress, InAddr);
 DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
 Result := (DW <> 0);
 IcmpCloseHandle(Handle);
end;

end.

прикрутить измеритель времени думаю труда не составит.


HaJik   (2007-09-27 11:50:00) [3]

Спасибо


Rav   (2007-09-27 07:09:00) [4]

я использовал для пинга TIdIcmpClient, как раз на D7E


Slym   (2007-09-27 04:06:00) [5]

Option Explicit

Dim WMIService,Pings,Status
Set WMIService = GetObject("winmgmts:\\.\root\cimv2")
Set Pings = WMIService.ExecQuery ("Select * From Win32_PingStatus where Address = 'www.delphimaster.ru'")

For Each Status in Pings
 If IsNull(Status.StatusCode) or Status.StatusCode0 Then
   WScript.Echo "Computer did not respond."
 Else
   Wscript.Echo "Computer responded in " & Status.ResponseTime & "ms " & Status.ResponseTimeToLive & " TTL"
 End If
Next


grisme   (2007-09-27 01:20:00) [6]

так напиши, тут вроде не против %-)


Наверх

Титульная страница Поиск, карта сайта Написать письмо