Модераторы: Snowy, Poseidon, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> отследить пропадание/появление сети 
:(
    Опции темы
Cashey
Дата 16.6.2008, 16:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
как отследить событие пропадание/появление сети? т.е. не проверить, а есть ли сеть в текущий момент, а именно отследить момент отсоединения и присоединения это когда значек в трее с двумя компами перечеркивается крестиком.


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
Snowy
Дата 16.6.2008, 18:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484
периодически проверять состояние соединения.
Или 
Цитата(Cashey @  16.6.2008,  16:23 Найти цитируемый пост)
проверить, а есть ли сеть в текущий момент

По таймеру (или как удобней) постоянно проверяешь состояние. Как изменилось - возбуждаешь событие. Вот оно и будет...
PM MAIL   Вверх
Cashey
Дата 16.6.2008, 19:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Snowy, ну это понятно, но представь себе, несколько сотен (примерно полторы-две) будут каждую секунду пинговать сеть. ибо отследить нужно любое (а главное секундное) пропадание сети, что бы было видно у кого мерцает


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
Snowy
Дата 16.6.2008, 19:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484
А не надо пинговать.
Пинговать надо в случае ошибки подключения.
Точнее начинать пытаться.
А пока всё работает, не надо тестить сеть.
Тестить надо, пока она не появится.
Хотя две-три сотни пингов в секунду - это мелочи.
Как вариант- сервер может броадкастом периодически слать сообщение, что он жив.
Или открыть порт, на который будут вешаться клиенты - есть коннект - жив.
PM MAIL   Вверх
Delvish
Дата 26.6.2008, 16:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


oO
*


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

Репутация: нет
Всего: 4
А компонент IdIPWatch применять пробовал? Там есть событие на изменение состояния
PM MAIL   Вверх
morpheyushka
Дата 26.6.2008, 16:52 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Зеленый человек
**


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

Репутация: нет
Всего: 8
Может я не так понял смысл под словом "сеть", но все же, перед работой на клиентском приложении можно проверить есть ли у него сеть?
Если нет, то висеть или же выполнять работу. для этого понадобиться функция. ее описание
Код

function InternetGetConnectedState(lpdwFlags: LPDWORD; dwReserved:DWORD):BOOL; stdcall; external 'wininet.dll' name 'InternetGetConnectedState';



--------------------
user posted image
Спасибо делается вот так!!!
PM MAIL WWW   Вверх
Cashey
Дата 20.8.2008, 16:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
продолжаем разговор smile

сделал таким макаром:
Код

function IsInternetConnected: Boolean;
var
 dwConnectionTypes: DWORD;
begin
 dwConnectionTypes := INTERNET_CONNECTION_LAN;

 Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;
procedure TLanSpoller.Execute;
var
lLan: Boolean;
lCheck: Boolean;
begin
  while not terminated do begin
    lLan := LanSpool.IsInternetConnected; 
    if not lLan then
      if not lCheck then Continue
      else begin
        Synchronize(MainForm.LanOff) ;
        lCheck := lLan
      end
    else
      if lCheck then Continue
      else begin
        Synchronize(MainForm.LanOn) ;
        lCheck := lLan
      end;
  end;
end;


в потоке, в цикле, постоянно проверяется InternetGetConnectedState, как и советует morpheyushka, и не смотря на то, что мне надо отследить не состояние интернета,а именно локальной сети, в целом код работает и дает, в общем случае, необходимый результат. Но как оказалось при этом загружает процессор на 100%. особенно сказывается при работе с "замапинными" дисками. 
т.е. вариант не подходит.....


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
Snowy
Дата 20.8.2008, 16:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484
Вставь в цикл Sleep(32) и как рукой снимет...
PM MAIL   Вверх
Cashey
Дата 20.8.2008, 16:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(Snowy @  20.8.2008,  17:11 Найти цитируемый пост)
Вставь в цикл Sleep(32) и как рукой снимет... 

тогда я "прозеваю" краткосрочное проподание сети "мерцание", а именно ее в первую очередь надо отследить

Добавлено через 3 минуты и 9 секунд
кстати, поставил слип и 32, и даже 300. особо не повлияло


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
BaD_SeCt0R
Дата 20.8.2008, 20:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Lazy Coder
**


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

Репутация: нет
Всего: 18
Цитата(Cashey @  20.8.2008,  16:13 Найти цитируемый пост)
и даже 300

 smile А в каком месте ты его ставишь?


--------------------
Кто владеет информацией - владеет миром. (С) Френсис Бэкон.
PM MAIL ICQ   Вверх
Cashey
Дата 21.8.2008, 08:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(BaD_SeCt0R @  20.8.2008,  21:10 Найти цитируемый пост)
А в каком месте ты его ставишь?

в цикле


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
MetalFan
Дата 21.8.2008, 14:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 14
Всего: 128
Цитата(Cashey @  20.8.2008,  16:07 Найти цитируемый пост)
var
lLan: Boolean;
lCheck: Boolean;
begin
  while not terminated do begin
    lLan := LanSpool.IsInternetConnected; 
    if not lLan then
      if not lCheck then Continue

мож я что не понимаю, но мне тут видится неициализированная локальная переменная lCheck...


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Cashey
Дата 22.8.2008, 00:14 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(MetalFan @  21.8.2008,  15:53 Найти цитируемый пост)
мож я что не понимаю, но мне тут видится неициализированная локальная переменная lCheck..

не правильно видится. переменная lCheck позволяет отследить изменение статуса, что бы не генерить одно и тоже событие на каждом шаге цикла, а только при изменение состояния сети.


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
dumb
Дата 22.8.2008, 03:40 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 5
Всего: 158
Цитата(Cashey @  20.8.2008,  17:13 Найти цитируемый пост)
тогда я "прозеваю" краткосрочное проподание сети "мерцание"
врядли.

Цитата(Cashey @  22.8.2008,  01:14 Найти цитируемый пост)
не правильно видится. переменная lCheck позволяет отследить изменение статуса, что бы не генерить одно и тоже событие на каждом шаге цикла, а только при изменение состояния сети. 
речь идет не о целесообразности применения переменной, а о том, что ты, не задав ей начального значения, делаешь проверку этой переменной.

набросал сэмпл:
Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);

    procedure LanOn;
    procedure LanOff;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Dword;
  tbl: PMIB_IFTABLE;
  bs: Dword;
begin
  bs:=0;
  GetIfTable(nil, bs, true);
  GetMem(tbl, bs);
  if GetIfTable(tbl, bs, true) = NO_ERROR then
    for i:=1 to tbl.dwNumEntries do
      ListBox1.Items.AddObject(IntToStr(tbl.table[i].dwIndex) +': '+tbl.table[i].bDescr, TObject(tbl.table[i].dwIndex));
  FreeMem(tbl);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  ts: TLanSpoller;
begin
  if ListBox1.ItemIndex = -1 then exit;
  ts := TLanSpoller.Create(true);
  ts.index := Dword(ListBox1.Items.Objects[ListBox1.ItemIndex]);
  ts.FreeOnTerminate := true;
  ts.Resume;
end;

procedure TForm1.LanOn;
begin
  Label1.Caption := 'ON';
end;

procedure TForm1.LanOff;
begin
  Label1.Caption := 'OFF';
end;

end.


Код

unit Unit2;

interface

uses
  Windows, Classes;


const

  IF_OPER_STATUS_NON_OPERATIONAL  = 0;
  IF_OPER_STATUS_UNREACHABLE      = 1;
  IF_OPER_STATUS_DISCONNECTED     = 2;
  IF_OPER_STATUS_CONNECTING       = 3;
  IF_OPER_STATUS_CONNECTED        = 4;
  IF_OPER_STATUS_OPERATIONAL      = 5;

  MIB_IF_TYPE_OTHER               = 1;
  MIB_IF_TYPE_ETHERNET            = 6;
  MIB_IF_TYPE_TOKENRING           = 9;
  MIB_IF_TYPE_FDDI                = 15;
  MIB_IF_TYPE_PPP                 = 23;
  MIB_IF_TYPE_LOOPBACK            = 24;
  MIB_IF_TYPE_SLIP                = 28;

  MIB_IF_ADMIN_STATUS_UP          = 1;
  MIB_IF_ADMIN_STATUS_DOWN        = 2;
  MIB_IF_ADMIN_STATUS_TESTING     = 3;

type

  PMIB_IFROW = ^MIB_IFROW;
  MIB_IFROW = record
    wszName: array [0..255] of WCHAR;
    dwIndex: DWORD;
    dwType: DWORD;
    dwMtu: DWORD;
    dwSpeed: DWORD;
    dwPhysAddrLen: DWORD;
    bPhysAddr: array [0..7] of BYTE;
    dwAdminStatus: DWORD;
    dwOperStatus: DWORD;
    dwLastChange: DWORD;
    dwInOctets: DWORD;
    dwInUcastPkts: DWORD;
    dwInNUcastPkts: DWORD;
    dwInDiscards: DWORD;
    dwInErrors: DWORD;
    dwInUnknownProtos: DWORD;
    dwOutOctets: DWORD;
    dwOutUcastPkts: DWORD;
    dwOutNUcastPkts: DWORD;
    dwOutDiscards: DWORD;
    dwOutErrors: DWORD;
    dwOutQLen: DWORD;
    dwDescrLen: DWORD;
    bDescr: array[0..255] of char;
  end;

  PMIB_IFTABLE = ^MIB_IFTABLE;
  MIB_IFTABLE = record
    dwNumEntries: DWORD;
    table: array [0..0] of MIB_IFROW;
  end;

function GetIfTable(pIfTable: PMIB_IFTABLE; var pdwSize: ULONG; bOrder: BOOL): DWORD; stdcall;
function GetIfEntry(pIfRow: PMIB_IFROW): DWORD; stdcall;

type
  TLanSpoller = class(TThread)
  public
    index: Cardinal;
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation

uses Unit1;

function GetIfEntry; external 'iphlpapi.dll' name 'GetIfEntry';
function GetIfTable; external 'iphlpapi.dll' name 'GetIfTable';

procedure TLanSpoller.Execute;
var
  r: MIB_IFROW;
  lastState: Dword;
begin
  ZeroMemory(@r, sizeof(r));
  r.dwIndex := index;
  lastState := $FFFFFFFF;
  while not Terminated do begin
    if GetIfEntry(@r) = NO_ERROR then begin
      if lastState <> r.dwOperStatus then begin
        lastState := r.dwOperStatus;
        case r.dwOperStatus of
          IF_OPER_STATUS_NON_OPERATIONAL,
          IF_OPER_STATUS_UNREACHABLE    ,
          IF_OPER_STATUS_DISCONNECTED   :
            Synchronize(Form1.LanOff);
//          IF_OPER_STATUS_CONNECTING     :
//          IF_OPER_STATUS_CONNECTED      :
          IF_OPER_STATUS_OPERATIONAL    :
            Synchronize(Form1.LanOn);
        end;
      end;
    end
    else
      break;
    Sleep(250);
  end;
end;

end.


Это сообщение отредактировал(а) dumb - 22.8.2008, 03:40
PM MAIL   Вверх
Cashey
Дата 22.8.2008, 09:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(dumb @  22.8.2008,  04:40 Найти цитируемый пост)
Цитата(Cashey @  22.8.2008,  01:14 Найти цитируемый пост)
не правильно видится. переменная lCheck позволяет отследить изменение статуса, что бы не генерить одно и тоже событие на каждом шаге цикла, а только при изменение состояния сети. 
речь идет не о целесообразности применения переменной, а о том, что ты, не задав ей начального значения, делаешь проверку этой переменной.

переменная объявленна как Boolean. что подразумевает ее значение по умолчание как false. так что здесь все корректно.

а вот за подсказку о GetIfEntry и GetIfTable спасибо. сейчас покопаю в эту сторону. По идеи, при отключенном NetBios это работать не будет.... проверю


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0610 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.