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

Вниз

Как сделать 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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.024 c
14-1123574910
Андрей Жук
2005-08-09 12:08
2005.09.04
Леонид Буряк отправлен в отставку!


14-1123732123
XenoX
2005-08-11 07:48
2005.09.04
Люди плиз help нужны иконки


14-1123408022
Juice
2005-08-07 13:47
2005.09.04
Специфика ноутбуков


1-1124084151
Damager
2005-08-15 09:35
2005.09.04
String to Char


2-1067014118
овен
2003-10-24 20:48
2005.09.04
компоненты





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский