VPF::Отслеживание подключения в сети

razumsap

Дата 8.1.2008, 17:18 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 52
Регистрация: 13.12.2007

Репутация: нет
Всего: нет

У нас часто пропадает инет на работе, хотелось бы написать программу, которая показывала наличие подключения (графически). Подскажите пожалуйста функцию или ещё что-нибуд, желательно чтоб можно было реализовать на Делфи 6. Или может кто уже сделал такую программу - поделитесь smile

tommy256

Дата 8.1.2008, 18:18 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 27
Регистрация: 28.11.2007

Репутация: нет
Всего: нет

А что будет показываться на графике, On or Off? smile

Можно просто без графика, например если инет пашет, то кнопочка зелёная, если нет то красная
Посмотри в drkb, там есть похожее

Yanis

Дата 8.1.2008, 18:23 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 6
Всего: 111

razumsap
Пингуй Яндекс.

--------------------

*щёлк*

remax

Дата 8.1.2008, 20:01 (ссылка)

(нет голосов)

Загрузка ...

Доцент

Профиль
Группа: Участник Клуба
Сообщений: 686
Регистрация: 7.4.2002
Где: Украина, Харьков

Репутация: нет
Всего: 5

примерно так

Код


uses WinInet;

function TFrmMain.IsConnectedToInternet: Boolean;
 var
   dwConnectionTypes: DWORD;
 begin
   try
   dwConnectionTypes :=
     INTERNET_CONNECTION_MODEM +
     INTERNET_CONNECTION_LAN +
     INTERNET_CONNECTION_PROXY;
   Result := InternetGetConnectedState(@dwConnectionTypes, 0);
   except
        result:=false;
   end;
 end;

--------------------

Как бы ты не старался быть хорошим и правильным человеком с принципами и уважительным отношением к другим, всегда найдется кто-то, кто бросит в тебя какашку

Alexeis

Дата 8.1.2008, 20:10 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 34
Всего: 459

Цитата(Yanis @ 8.1.2008, 17:23

)

Пингуй Яндекс.

лучше гугл, так надежнее.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

remax

Дата 8.1.2008, 21:08 (ссылка)

(нет голосов)

Загрузка ...

Доцент

Профиль
Группа: Участник Клуба
Сообщений: 686
Регистрация: 7.4.2002
Где: Украина, Харьков

Репутация: нет
Всего: 5

Да, возможно использования только InternetGetConnectedState будет мало.
В MSDN написано следующее:

"You cannot rely solely on the fact that InternetGetConnectedState returning TRUE means that you have a valid active Internet connection. It is impossible for InternetGetConnectedState to determine if the entire connection to the Internet is functioning without sending a request to a server. This is why you need to send a request to determine if you are really connected or not. You can be assured however that if InternetGetConnectedState returns TRUE, that attempting your connection will NOT cause you to be prompted to connect to the default Internet Service Provider."

т.е.
Вы не можете полагаться только на тот факт, что если функция InternetGetConnectedState возвращает TRUE, это означает наличие активного соединения с Интернет. InternetGetConnectedState не может определить, функционирует ли соединение с Интернет без обращения к серверу...

Для полной проверки надо будет еще пингануть. Т.е. первым пунктом используем InternetGetConnectedState, а затем если TRUE, пробуем пинговать.

Для этого необходимо использовать протокол ICMP: утилиты ping, traceroute; (так мы узнаем о доступности какого-либо узла). Ключевые фунции - IcmpSendEcho() (реализована в ICMP.DLL), InternetCheckConnection() (реализована в WININET.DLL)

Это сообщение отредактировал(а) remax - 8.1.2008, 21:14

--------------------

Yanis

Дата 8.1.2008, 22:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 6
Всего: 111

Цитата(Alexeis @ 8.1.2008, 21:10

)

лучше гугл, так надежнее.

И то верно.

Добавлено через 21 секунду

Цитата(remax @ 8.1.2008, 22:08

)

Вы не можете полагаться только на тот факт, что если функция InternetGetConnectedState возвращает TRUE, это означает наличие активного соединения с Интернет. InternetGetConnectedState не может определить, функционирует ли соединение с Интернет без обращения к серверу...

О том и речь smile

--------------------

*щёлк*

remax

Дата 8.1.2008, 23:22 (ссылка)

(нет голосов)

Загрузка ...

Доцент

Профиль
Группа: Участник Клуба
Сообщений: 686
Регистрация: 7.4.2002
Где: Украина, Харьков

Репутация: нет
Всего: 5

Цитата(Yanis @ 8.1.2008, 22:45

)

О том и речь smile

Да, для полноценной проверки и этого может быть недостаточно. Автор темы четко не определил понятие "пропал Интернет". Поэтому, как положено - от простого к сложного. Начать с InternetGetConnectedState. Если этого будет недостаточно - IcmpSendEcho(), InternetCheckConnection(). Если этого будет мало, тогда будем думать дальше. Надо решать проблемы по мере поступления!

Добавлено через 3 минуты и 1 секунду
В своих прогах, работающих с интернетом, мне обычно хватает InternetGetConnectedState. И, как не странно, пока сбоев не было... Хотя сама Микрософт ничего не гарантирует.

--------------------

razumsap

Дата 9.1.2008, 09:51 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 52
Регистрация: 13.12.2007

Репутация: нет
Всего: нет

Спасибо всем за помощь.
Да хотелось бы всего ничего, чтоб показывался индикатор On or Off.
Вот с утра попробовал InternetGetConnectedState всё время возвращяет true.

Цитата

Да, для полноценной проверки и этого может быть недостаточно. Автор темы четко не определил понятие "пропал Интернет". Поэтому, как положено - от простого к сложного. Начать с InternetGetConnectedState. Если этого будет недостаточно - IcmpSendEcho(), InternetCheckConnection(). Если этого будет мало, тогда будем думать дальше. Надо решать проблемы по мере поступления!

Попробую воспользоваться выше приведенными советами.

Программу написал, но что-то она ругается

Использовал материал http://www.realcoding.net/article/view/251 Реализация ping с помощью ICMP API, после выполнения кода

Код


pHostEn := gethostbyname('http://www.google.com.ua/');
error := GetLastError();
if (error <> 0) then
begin
Memo1.SetTextBuf('Error in call to'+
'gethostbyname().');
Memo1.Lines.Add('Error code: '+IntToStr(error));
Exit;

выдает сообщение в мемо

Error in call togethostbyname().
Error code: 11001

Написал просто

Код



procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
  var result:integer;
begin
result:=AReplyStatus.MsRoundTripTime;
if result <> 0 then
        begin
        Image1.Visible:=true;
        Image2.Visible:=false;
        end
      else
      begin
        Image1.Visible:=false;
        Image2.Visible:=true;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Self.IdIcmpClient1.Host:='209.85.135.147';
Self.IdIcmpClient1.Ping;
end;

end.

Это сообщение отредактировал(а) razumsap - 9.1.2008, 16:20

remax

Дата 10.1.2008, 00:48 (ссылка)

(нет голосов)

Загрузка ...

Доцент

Профиль
Группа: Участник Клуба
Сообщений: 686
Регистрация: 7.4.2002
Где: Украина, Харьков

Репутация: нет
Всего: 5

Попробуй такой вариант:

Код



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses WinInet;

function checkURL(aURL:string):boolean;
var
  hSession,hFile,hRequest:hInternet;
  dcInd,dcLen:dword;
  dc:array [1..20] of char;
  rs:pchar;
begin
  Result:=false;
  hSession:=InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
  if Assigned(hSession) then
    begin
      hFile:=InternetOpenUrl(hSession,PChar(aURL), nil,0,INTERNET_FLAG_RELOAD, 0);
      dcInd:=0;
      dcLen:=10;
      HttpQueryInfo(hFile, HTTP_QUERY_STATUS_CODE, @dc, dcLen, dcInd);
      rs:=PChar(@dc);
      Result:=(rs='200');
      if Assigned(hFile) then InternetCloseHandle(hFile);
      InternetCloseHandle(hSession)
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if checkURL('http://google.com')
    then panel1.Color:=clGreen
    else panel1.Color:=clRed
end;

end.

Необходимые пояснения -
программа проверяет существование определенного адреса в сети. По рекомендациям участников дискуссии - это http://google.com smile

Проверка инициируется таймером. Визуализация - изменение цвета панели.
Если все ок smile

- цвет зеленый. Если красный, то значит либо нет инета smile

либо гугля smile

, что маловероятно...

Только в таймере поставь не меньше минуты.

Это сообщение отредактировал(а) remax - 10.1.2008, 00:55

--------------------

razumsap

Дата 10.1.2008, 16:33 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 52
Регистрация: 13.12.2007

Репутация: нет
Всего: нет

Написал программу, а она ругается, выдает ошибку
---------------------------
Socket Error # 11001
---------------------------
что соответсвует IP_BUF_TOO_SMALL
где мальнький буфер и как его увеличить?

вобщем, админ наш сказал, что пинг не проходит, по причине того, что мы(наша ОАО) работаем через 2 прокси и сказал такое Киска не выпустит за пределы интранета smile

Это сообщение отредактировал(а) razumsap - 10.1.2008, 16:59

Rennigth

Дата 10.1.2008, 17:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 15
Всего: 76

razumsap,
нет, это озночает что сервер не найден.
Вот немного поправленны вариант:

Код


function checkURL(aURL:string):boolean;
var
  hSession,hFile,hRequest: hInternet;
  dcInd,dcLen:dword;
  dc:array [1..20] of char;
  rs:pchar;
begin
  Result := False;
  ZeroMemory(@dc, 20);
  hSession := InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
  if Assigned(hSession) then
  begin
    hFile := InternetOpenUrl(hSession, PChar(aURL), nil, 0, INTERNET_FLAG_RELOAD, 0);
    if Assigned(hFile) then
    begin
      dcInd:=0;
      dcLen:=10;
      HttpQueryInfo(hFile, HTTP_QUERY_STATUS_CODE, @dc, dcLen, dcInd);
      rs := PChar(@dc);
      Result := (rs='200');
      InternetCloseHandle(hFile);
    end;
    InternetCloseHandle(hSession);
  end;
end;

procedure TForm24.FormCreate(Sender: TObject);
begin
  if checkURL('http://www.google.ru/') then
    Color := clGreen
  else
    Color := clRed;
end;

Добавлено через 46 секунд
razumsap,
можно было бы и самому заметить что хухл неправильно написан smile

Добавлено через 1 минуту и 55 секунд
если есть прокся, работать не будет, нужно будет дописывать аутентификацию.

--------------------

(* Honesta mors turpi vita potior *)

remax

Дата 10.1.2008, 21:54 (ссылка)

(нет голосов)

Загрузка ...

Доцент

Профиль
Группа: Участник Клуба
Сообщений: 686
Регистрация: 7.4.2002
Где: Украина, Харьков

Репутация: нет
Всего: 5

Цитата(Rennigth @ 10.1.2008, 17:03

)

можно было бы и самому заметить что хухл неправильно написан

Интересно, с каких пор http://google.com это неправильно?

У меня, например, все нормально сработало. Причем, вернуло именно 200, а не какой либо другой код.

--------------------

remax

Дата 10.1.2008, 22:12 (ссылка)

(нет голосов)

Загрузка ...

Доцент

Профиль
Группа: Участник Клуба
Сообщений: 686
Регистрация: 7.4.2002
Где: Украина, Харьков

Репутация: нет
Всего: 5

Пример автоматического определения параметров прокси (кусок моей рабочей проги)

Код


  procedure TfrmMain.AvtoProxy;
var
  proxyinfo: pinternetproxyinfo;
  len: longword;
  use_proxyserver:boolean;
begin
  len := 4096;
  use_proxyserver:=false;
  getmem(proxyinfo, len);
  try
    if internetqueryoption(nil, internet_option_proxy, proxyinfo, len) then
      if proxyinfo^.dwaccesstype = internet_open_type_proxy then
        begin
          use_proxyserver := true;
          cbPROXY_SERV.Text:=proxyinfo^.lpszproxy;
          if  pos(':',cbPROXY_SERV.Text)>0
            then
              begin
                try
                  cbPROXY_PORT.Text:=trim(copy(cbPROXY_SERV.Text,pos(':',cbPROXY_SERV.Text)+1,5));
                except
                  cbPROXY_PORT.Text:='3128';
                end;
                cbPROXY_SERV.Text:=copy(cbPROXY_SERV.Text,1,pos(':',cbPROXY_SERV.Text)-1);
              end
            else cbPROXY_PORT.Text:='3128';

          update;
        end
  finally
     freemem(proxyinfo);
  end;
  cbProxyEnabled.Checked:= use_proxyserver;
  Update;
end;

Добавлено через 5 минут и 1 секунду
Rennigth, твои изменения изменили логику работы проги. Весь смысл - периодический опрос. А в твоей модификации - только FormCreate?

Добавлено через 7 минут и 17 секунд
razumsap, а в самом деле, чего мы мучаемся - посмотри в настройках своего броузера - есть явное указание прокси или нет?

Добавлено через 13 минут и 12 секунд

Цитата(razumsap @ 10.1.2008, 16:33

)

вобщем, админ наш сказал, что пинг не проходит, по причине того, что мы(наша ОАО) работаем через 2 прокси

А админ не сказал причину регулярного отсутствия интернета? Может дело в выключении каких то рутеров или проксей? И пинговать достаточно их, или те же ваши прокси?

--------------------

Rennigth

Дата 10.1.2008, 23:23 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 15
Всего: 76

Цитата(remax @ 10.1.2008, 21:54

)

Интересно, с каких пор http://google.com это неправильно?

Наверное от настроек зависит, разбираться лень но у меня так не работает smile

Цитата(remax @ 10.1.2008, 22:12

)

Rennigth, твои изменения изменили логику работы проги. Весь смысл - периодический опрос. А в твоей модификации - только FormCreate?

дык я только тестировал, а в таймере функция будет вызываться или нет это я думаю уже автору топика решать. А изменение это зануление dc, т.к. если HttpQueryInfo выполниться неудачно, то вdc останеться тотже мусор что и при инициялизации, и есть шанс(хоть и мизерный) что там будет значение 200 и функция вернет в итоге True smile

--------------------

(* Honesta mors turpi vita potior *)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »