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

Вниз

Ping   Найти похожие ветки 

 
Demonenok   (2006-01-27 07:32) [0]

Привет. Ув. Мастера, помогите, весь рунет облазил(в силе плохого знания анг. языка, не мог остальной проглядеть), нигде не смог найти, примеры пинга сервера, мне нужно, что бы программа пинговала сервер, если пинг проходит, ф-ция возвращала true, иначе false. помогите пожалуйсто, как это реализовать.


 
Ezorcist   (2006-01-27 07:35) [1]

пинг проходит всмысле? пинг возвращает не boolean, а время в мс. Ну какое время тебя устраивает решай сам)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
winsock, StdCtrls;

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

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

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}

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public

end;

var
Form1: TForm1;

implementation

{$R *.DFM}

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("Digite um HostName ou um End. IP",
"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("Erro pegando endereзos ICMP","Error", MB_OK);
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);

if (Retorno <> 0) then begin
Application.MessageBox("Nгo foi possнvel carregar WinSockets",
   "WSAStartup",MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
end;

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

if (host = nil) then begin
Application.MessageBox("Host nгo encontrado","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("Pingou " + Edit1.text);
end;

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

end.


 
CyMKuH ©   (2006-01-28 13:33) [2]

Есть библиотека компанентов ICS, вот там есть компанентик Ping!


 
sniknik ©   (2006-01-28 15:26) [3]

он есть и в indy, стандартном сейчас, зачем далеко ходить... только там не компонентом а свойством оформлено какогото информационного комтанента... но какая разница?


 
Demonenok   (2006-01-30 00:19) [4]

Ezorcist   (27.01.06 07:35) [1]
Неработает =( Выдаёт ошибку.

CyMKuH ©   (28.01.06 13:33) [2]
А подробнее? Где слить библиотеку, как юзать?

sniknik ©   (28.01.06 15:26) [3]
Как его использовать? Как он работает?

Спасибо за ответы %)


 
Demonenok   (2006-01-31 12:16) [5]

Ezorcist   (27.01.06 07:35) [1]

<...>
null,
0,
Ip,
Icmp,
<...>

Тут ошибка.



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

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

Наверх




Память: 0.46 MB
Время: 0.04 c
1-1137866104
Compton's G
2006-01-21 20:55
2006.02.19
Рисоваиние на TImage


3-1135058468
jiny
2005-12-20 09:01
2006.02.19
Помогите со сводными таблицами


15-1138075876
Ozone_zabil_parol
2006-01-24 07:11
2006.02.19
Цифровой фитик. Проблема выбора.


2-1138607660
De
2006-01-30 10:54
2006.02.19
поясните


2-1139069561
Michael5
2006-02-04 19:12
2006.02.19
Вопрос по OpenGL, программа не работает, подскажите, в чем дело!





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