Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2008.07.27;
Скачать: [xml.tar.bz2];

Вниз

ping? D7 enterprize   Найти похожие ветки 

 
HaJik ©   (2007-09-26 22:10) [0]

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


 
grisme ©   (2007-09-27 01:20) [1]

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


 
Slym ©   (2007-09-27 04:06) [2]

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.StatusCode<>0 Then
   WScript.Echo "Computer did not respond."
 Else
   Wscript.Echo "Computer responded in " & Status.ResponseTime & "ms " & Status.ResponseTimeToLive & " TTL"
 End If
Next


 
Rav   (2007-09-27 07:09) [3]

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


 
HaJik ©   (2007-09-27 11:50) [4]

Спасибо


 
Eraser ©   (2007-09-28 01:25) [5]

> [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-28 15:27) [6]

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



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

Форум: "Сети";
Текущий архив: 2008.07.27;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.007 c
2-1214450709
Олег
2008-06-26 07:25
2008.07.27
Удаление дубликатов в DBF


2-1214322411
KVV
2008-06-24 19:46
2008.07.27
Загрузка файла по HTTP


2-1214302930
savyhinst
2008-06-24 14:22
2008.07.27
Debuging troubles


15-1213269006
fics
2008-06-12 15:10
2008.07.27
Программы для построения графов


10-1148306525
atruhin
2006-05-22 18:02
2008.07.27
overload функции и IDispatch





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский