Цитата(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.
|
|
А в каком месте ты его ставишь?