Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Проблемы с пингом! / 11 сообщений из 11, страница 1 из 1
20.06.2017, 11:51:00
    #39474648
KonstF
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
День добрый!

Столкнулся с следующей проблемой.
Есть функция, просто пингует точку - в моем случае просто проверяю есть нет сеть.
Вроде все хорошо работает, обрывы определяет!

Но в случае простых пользователей( нет локального админа) столкнулся с тем, что код не работает. Функция возвращает отсутствие сети.

Как быть с данной ситуацией кто, что посоветует?!



Код: pascal
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.
function ClassFNDll.QuietPing( AHost: string = Null_Set_Str ): Boolean;
 var
  R: array of Cardinal;
  i, ATimes: integer;
  AvgMS: Double;
begin
  InitbseSettings;
  if( AHost = Null_Set_STR )
    then
      AHost := iniGL.ReadString( cntBSE_Connect, cntBSE_Host_QuietPing, def_cntBSE_Host_QuietPing );
  ATimes := iniGL.ReadInteger( cntBSE_Connect, cntBSE_Delay_QuietPing, def_cntBSE_Delay_QuietPing );

  Result := True;
  AvgMS := 0;
  if ATimes>0 then
    with TIdIcmpClient.Create( Application ) do
      try
        Host := AHost;
        ReceiveTimeout := 999; //TimeOut du ping
        SetLength(R,ATimes);
        {Pinguer le client}
        for i:=0 to Pred(ATimes) do
        begin
            try
              Ping();
              Application.ProcessMessages; //ne bloque pas l'application
              R[i] := ReplyStatus.MsRoundTripTime;
            except
              Result := False;
              Exit;

            end;
          if ReplyStatus.ReplyStatusType<>rsEcho Then result := False; //pas d'echo, on renvoi false.
        end;
        {Faire une moyenne}
        for i:=Low(R) to High(R) do
        begin
          Application.ProcessMessages;
          AvgMS := AvgMS + R[i];
        end;
        AvgMS := AvgMS / i;
      finally
        Free;
      end;
end;
...
Рейтинг: 0 / 0
20.06.2017, 12:51:22
    #39474689
Luke1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
Use IcmpSendEcho , Luke!
...
Рейтинг: 0 / 0
20.06.2017, 13:17:14
    #39474710
KonstF
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
Luke1, сегодня собрал вариант на его основе благо в статье все расписано - ситуация примерно та же, только с сообщением "Can not allocate socket.". Если запускать с правами админа все проходит!

Почему от пользователя на работает. Если азпустить тот же cmd и пингануть с минимальными правами все будет работать?!
...
Рейтинг: 0 / 0
20.06.2017, 13:17:44
    #39474712
KonstF
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
Если кому понадобиться
ссылочка
...
Рейтинг: 0 / 0
20.06.2017, 13:18:00
    #39474714
KonstF
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
...
Рейтинг: 0 / 0
20.06.2017, 13:57:38
    #39474751
Проблемы с пингом!
можно попробовать с помощью IdEcho из пакета Indy, в моем случае работало нормально под обычными юзерами
...
Рейтинг: 0 / 0
20.06.2017, 14:29:40
    #39474766
KonstF
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
ПаWWWлОдАрЕц, черкните где что не так - указал хост - подключаюсь и сразу эксепшн.


Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
  IdEcho1.Host := 'май_ИП';
  IdEcho1.Connect( 0 );
  if( IdEcho1.Connected )
    then
      Caption := 'YEEEEEEES'
    else
      Caption := 'NOOOOOOOOOO'
end;
...
Рейтинг: 0 / 0
20.06.2017, 14:52:23
    #39474790
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
KonstFФункция возвращает отсутствие сети.Врете Вы все. Ваша функция такого возвратить не может. Она возвращает True или False
KonstF
Код: pascal
1.
2.
3.
4.
5.
6.
            except
              Result := False;
              Exit;

            end;
          if ReplyStatus.ReplyStatusType<>rsEcho Then result := False; //pas d'echo, on renvoi false.

Правильно! Выводить реальную ошибку не наш метод! Есть же форум с телепатами
...
Рейтинг: 0 / 0
21.06.2017, 05:15:08
    #39475157
Проблемы с пингом!
[quote KonstF]ПаWWWлОдАрЕц, черкните где что не так - указал хост - подключаюсь и сразу эксепшн.

Ну во первых, надо указать у компонента номер порта по которому он будет обращаться к удаленной машине. И да, логика как раз и строится на отлове эксепшена который генерирует идэхо. Ну а далее, как то так:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
try   
    IdEcho1.Disconnect;
    IdEcho1.Port := 1433; (Порт на котором сидит MSSQL)
    IdEcho1.Connect(5000);//ждем 5 сек.
    rez := true;
    IdEcho1.Disconnect;
except
    IdEcho1.Disconnect;
    rez := false;
end;
...
Рейтинг: 0 / 0
21.06.2017, 07:59:21
    #39475182
KonstF
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
_Vasilisk_, согласен!
Посмотрел на что ругается, выкидывает с сообщением eIDInvalidSocket.

ПаWWWлОдАрЕц, дААА ваша правда. Уже после сообразил, что лучше ломится по конкретному порту.
Все заработало, но тянуть лишниее 300 кб в программу не гут! В любом случае всем спасибо!

поправил ф-ю, обрыв отлавливает! Может кому пригодится.
Код: pascal
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.
function ClassFNDll.QuietPing( AHost: string = Null_Set_Str ): Boolean;
 var                                                                                                                                                                                  
  i, ATimes: integer;
  idCMP: TIdIcmpClient;
begin
  Result := False;                                                                                                                                                                      InitbseSettings;
  if( AHost = Null_Set_STR )
    then
      AHost := iniGL.ReadString( cntBSE_Connect, cntBSE_Host_QuietPing, def_cntBSE_Host_QuietPing );
  ATimes := iniGL.ReadInteger( cntBSE_Connect, cntBSE_Delay_QuietPing, def_cntBSE_Delay_QuietPing );
  if ATimes > 0 then begin
    idCMP := TIdIcmpClient.Create( Application );
    idCMP.Host := AHost;
    idCMP.Port := 3050;
    idCMP.ReceiveTimeout := 1000;                                                                                                                                                     
    for i := 0 to Pred( ATimes ) do begin
      try                                                                                                                                                                             
        idCMP.Ping( );                                                                                                                                                                
      except
        on E: Exception  do begin
          MessageDlg(
                      e.ClassName,
                      mtInformation,
                      [ mbOK ],
                      0
         ); 
         Result := False;
        end;
      end;
      if idCMP.ReplyStatus.ReplyStatusType = rsEcho
        then
          Result := True;                                                                                                                                                             
    end;                                                                                                                                                                                end;
end;
...
Рейтинг: 0 / 0
21.06.2017, 09:05:24
    #39475197
KonstF
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с пингом!
Luke1, отличный совет!

Кто будет кропать смотрите здесь - отличный пример!
http://www.delphimaster.ru/articles/icmp.html
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Проблемы с пингом! / 11 сообщений из 11, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]