Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.09.04;
Скачать: CL | DM;

Вниз

Как сделать ping из Дельфи и получить результаты   Найти похожие ветки 

 
Priest   (2005-04-05 12:27) [0]

Где то пробегала тема, но не помню где...Как осуществить сабж?


 
WondeRu ©   (2005-04-05 12:33) [1]


Маааленькое PING-приложеньице  
--------------------------------------------------------------------------------

Два интеpнетчика:
- Попингуй!
- От попингуя слышу.  

Протокол Ping предназначен для тестирования компьютерных соединений в Интернете путём посылки через протокол Internet Protocol (IP) по обределённому адресу сообщения и ожидания от него ответа.

ICMP - Internet Control Message Protocol. ICMP служит для передачи сообщений об ошибках а так же управляющих сообщений . ICMP-тест может показать насколько быстро проходит информация между двумя узлами в Интернете.

Запускаем Delphi;
В Новом проекте добавляем в форму Tbutton, Tedit и Tmemo;
Вставляем “winsock”;
объявляем структурку для IP-заголовка:

type
 IPINFO = record
 Ttl: char;
 Tos:har;
 IPFlags: char;
 OptSize: char;
 Options: ^char;
end;



объявляем структурку для хранения ICMP пакета:

type
 ICMPECHO = record
 Source: longint;
 Status: longint;
 RTTime: longint;
 DataSize: Shortint;
 Reserved: Shortint;
 pData: ^variant;
 i_ipinfo: IPINFO;
end;



Объявляем функции и процедуры, которые мы будем вызывать из ICMP.DLL

TIcmpCreateFile = function():integer;
{$IFDEF WIN32} stdcall; {$ENDIF}

TIcmpCloseHandle = procedure(var handle: integer);
{$IFDEF WIN32} stdcall; {$ENDIF}

TIcmpSendEcho = function(var handle: integer; endereco: DWORD;
buffer: variant; tam: WORD; IP: IPINFO; ICMP: ICMPECHO;
tamicmp: DWORD; tempo: DWORD): DWORD;
{$IFDEF WIN32} stdcall; {$ENDIF}



В TButton в событие Onclick вставляем следующий код:

procedure TForm1.Button1Click(Sender: TObject);
var
 wsadt : wsadata;
 icmp :icmpecho;
 HNDicmp : integer;
 hndFile :integer;
 Host :PHostEnt;
 Destino :in_addr;
 Endereco :^DWORD;
 IP : ipinfo;
 Retorno :integer;
 dwRetorno :DWORD;
 x :integer;

 IcmpCreateFile : TIcmpCreateFile;
 IcmpCloseHandle : TIcmpCloseHandle;
 IcmpSendEcho : TIcmpSendEcho;

begin
 if (edit1.Text = "") then
 begin
   Application.MessageBox("Enter a HostName ro a IP Adress", "Error", MB_OK);
   exit;
 end;
 HNDicmp := LoadLibrary("ICMP.DLL");
 if (HNDicmp <> 0) then
 begin
   @IcmpCreateFile := GetProcAddress(HNDicmp,"IcmpCreateFile");
   @IcmpCloseHandle := GetProcAddress(HNDicmp,"IcmpCloseHandle");
   @IcmpSendEcho := GetProcAddress(HNDicmp,"IcmpSendEcho");
   if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or (@IcmpSendEcho=nil) then
   begin
     Application.MessageBox("Error getting ICMP Adress’,"Error", MB_OK);
     FreeLibrary(HNDicmp);
   end;
 end;
 Retorno := WSAStartup($0101,wsadt);

 if (Retorno <> 0) then
 begin
   Application.MessageBox("Canґt Load WinSockets","WSAStartup", MB_OK);
   WSACleanup();
   FreeLibrary(HNDicmp);
 end;

 Destino.S_addr := inet_addr(Pchar(Edit1.text));
 if (Destino.S_addr = 0) then
   Host := GetHostbyName(PChar(Edit1.text))
 else
   Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);

 if (host = nil) then
 begin
   Application.MessageBox("Host not found","Error", MB_OK);
   WSACleanup();
   FreeLibrary(HNDicmp);
   exit;
 end;
 memo1.Lines.Add("Pinging " + Edit1.text);

 Endereco := @Host.h_addr_list;

 HNDFile := IcmpCreateFile();
 for x:= 0 to 4 do
 begin
   Ip.Ttl := char(255);
   Ip.Tos := char(0);
   Ip.IPFlags := char(0);
   Ip.OptSize := char(0);
   Ip.Options := nil;

   dwRetorno := IcmpSendEcho(
   HNDFile,
   Endereco^,
   null,
   0,
   Ip,
   Icmp,
   sizeof(Icmp),
   DWORD(5000));
   Destino.S_addr := icmp.source;
   Memo1.Lines.Add("Ping " + Edit1.text);
 end;

 IcmpCLoseHandle(HNDFile);
 FreeLibrary(HNDicmp);
 WSACleanup();
end;



У данного примера есть один недостаток - программа не воспримет доменное имя, только IP-адресс. Для пользователей NT не используйте функцию IcmpCloseHandle.

Это всё…..

Delphi World ©


 
Priest   (2005-04-05 12:42) [2]

Спасибо.........Попробую на досуге


 
}|{yk ©   (2005-04-05 12:53) [3]

Делать нечего... Запускаешь ping.exe с параметрами и перенаправляешь консольный вывод себе в программу...


 
noname:))   (2005-05-22 16:20) [4]

А как при получении ответа на пинг вытянуть из него имя пропингованой машины?


 
noname:))   (2005-05-22 16:33) [5]

Самый примитивный способ пропинговать машину:

 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 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;
 trans(InetAddress, InAddr);
 DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
 Result := (DW <> 0);
 IcmpCloseHandle(Handle);
end;

Затем где угодно:
if Ping("192,168,0,1") = true then машина пингуется.
Если хочешь то скачай исходники моей программы как раз для этого дела рлюс ещё сканирование общих ресурсов и отправки сообщений.
http://webfile.ru/306283
Если что пиши на мыло dazfx@ukr.net



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

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

Наверх




Память: 0.49 MB
Время: 0.048 c
4-1121366230
Dot
2005-07-14 22:37
2005.09.04
Обработать закрытие приожения


14-1123921274
TStas
2005-08-13 12:21
2005.09.04
Как устроены setup dialog и?


2-1081121430
ChiNick
2004-04-05 03:30
2005.09.04
Как работать с цветом


1-1124171980
~ShamaN~
2005-08-16 09:59
2005.09.04
ComboBox


3-1121839239
Bless
2005-07-20 10:00
2005.09.04
Непонятная "двуличность" операции "=NULL"