Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Форум программистов и сисадминов Киберфорум > Форум программистов > Delphi > Delphi для начинающих
Войти
Регистрация
Восстановить пароль
Правила Карта Блоги Социальные группы Поиск Сообщения за день  
 
Рейтинг 4.84/43: Рейтинг темы: голосов - 43, средняя оценка - 4.84
70 / 70 / 3
Регистрация: 29.09.2009
Сообщений: 530
1

ping

08.03.2010, 22:08. Просмотров 8343. Ответов 4
Метки нет (Все метки)

как на форме, скажем в обычном Label'e, каждую секунду (или чаще) отображать время пинга до заранее известного хоста? аналогично той команде которая пишется в консоли - ping [адрес] -t
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 08.03.2010, 22:08
Ответы с готовыми решениями:

Ping pong физика игры
Можете помочь сделать физику игры простейшую? Вот код игры ping pong var Form1: TForm1; PosX,...

Ping-Pong - шарик, игрок
Здравствуйте. Задание на курсовой - "Реализовать проект Пинг-Понг". Я создал одного игрока и мяч....

Игра Ping-Pong - сохранение и загрузка!
Здравствуйте. Необходима помощь с сохранением игры и его загрузкой в любой момент игры. Каким...

Написал игру ping pong, но шарик застревает в ракетке
Написал игру ping pong, но шарик(shape1) застревает в ракетке компьютерного игрока(shape3),...

4
Junior Developer
43 / 43 / 7
Регистрация: 08.06.2009
Сообщений: 261
08.03.2010, 22:15 2
NemiroFFyo,

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

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

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


Delphi
1
2
3
4
5
6
7
8

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

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


Delphi
1
2
3
4
5
6
7
8
9
10

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

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


Delphi
1
2
3
4
5
6
7
8
9
10

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}

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


Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

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.

(c)DelphiSource
1
70 / 70 / 3
Регистрация: 29.09.2009
Сообщений: 530
08.03.2010, 22:54  [ТС] 3
velikijmerlin, папробовал - куча ошибок которые не знаю как исправить. Может Вам не сложно будет сделать исходничек чтобы я посмотрел сразу на готовый работающий вариант?
0
Эксперт С++
3057 / 1399 / 421
Регистрация: 19.01.2009
Сообщений: 3,770
09.03.2010, 21:24 4
Цитата Сообщение от NemiroFFyo Посмотреть сообщение
папробовал - куча ошибок которые не знаю как исправить
а ты бы эти ошибочки запостил - кто-нибудь да помог бы

что сразу в глаза бросается, так это неверные символы кавычек в строках 33 и 41 в коде сорца
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

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;
К тому же можно все через Инди реализовати и не париться - TIdPing в помощь

Добавлено через 9 минут
Но можно все это дело оформить в функцию
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

function MyPing(host : String) : DWORD;
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
  Result := 0;
 
  if (host = '') 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(host));
  if (Destino.S_addr = 0) then
    Host := GetHostbyName(PChar(host))
  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();
  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;
   
  IcmpCLoseHandle(HNDFile); 
  FreeLibrary(HNDicmp); 
  WSACleanup();
  Result := dwRetorno;
end;
Добавлено через 2 минуты
добавить на форму Таймер, выставить интервал срабатывания, как нужно и в обработчике таймера добавить код типа :
Delphi
1

Label1.Caption := IntToStr(MyPing('ХОСТ,КОТОРЫЙ_ПИНГУЕМ'));
Добавлено через 12 минут
тут напрашивается оптимизация
1. строки до 71 помещаем в инициализацию, напимер в обработчик OnCreate, незабыв вынести неоходимые переменные в глобальные;
2. в обработчик таймера помещаем
Delphi
1
2
3
4
5
6
7
8
9
10

dwRetorno := IcmpSendEcho(
    HNDFile,
    Endereco^,
    null,
    0,
    Ip,
    Icmp,
    sizeof(Icmp),
    DWORD(5000));
Label1.Caption := IntToStr(dwRetorno);
3. в OnDestroy помещаем код ниже 83 строки

и будет тебе счастье
1
Junior Developer
43 / 43 / 7
Регистрация: 08.06.2009
Сообщений: 261
09.03.2010, 23:45 5
NemiroFFyo, Oleg, код не проверял на ошибки, а просто скопировал с сайта..)))
поэтому за код ответственности не несу..)))
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 09.03.2010, 23:45

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

Ping средствами делфи
Всем привет!!! Может кто подсказать как написать простой пинг в делфи, т.е при запуске...

Ping based random number generator
Реализован генератор случайных чисел, использующий Ping (измерение времени отклика определенного...

Ping-Pong. Вывести надпись Game Over при соприкосновении мячика с полем
Сделала Игру на Delphi. Но появилась одна загвоздка.Нужно, чтобы при соприкосновении с полем мячика...

Процедура с ServerSocket "портит" всю программу + как устроить "ping" для клиентских приложений
1. На форме ServerSocket1 и 2 шт. StringGrid: tableIP и tableIPwork. В первом 2 столбца: имя ПК и...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Реклама - Обратная связь
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.