Status síťového adaptéru

[jarex]

Poprosil bych, zda by mi někdo neporadil, jak mám zjistit status síťového adaptéru například podle jeho názvu.
Zda je připojen, nebo odpojen.

Například: GetStatusInterface('Připojení k místní síti')

Výsledek boolean.

Moc děkuji.

[jarex]

zatím jsem vyplodil toto:

Kód: Delphi [Vybrat]

1. function TForm1.GetStatusInterface: boolean;
2. var
3. Stng: Tinifile;
4. atm: Tstringlist;
5. Adapter: string;
6. i: integer;
7. begin
8. result:=false;
9. atm:=Tstringlist.create;
10. stng:=tinifile.create(extractfilepath(application.ExeName)+'\settings.ini');
11. Adapter:= stng.ReadString('private settings','Adapter','Ethernet 2');
12. atm.text:=(Getdosoutput('netsh interface show interface', systemdisk));
13. for i := 0 to atm.count - 1 do if pos(adapter,atm[i])>0 then
14.     begin
15.     if (pos('Odpojen',atm[i])>0) or (pos('Disconnected',atm[i])>0) then result:=false else result:=true;
16.     end;
17. stng.Free;
18. atm.Free;
19. end;

Funguje to, ale má to svá ale.

[Ján Masaryk]

Nebudeš mať jednoduchšie urobiť ping na bránu (napr. ping -t 192.168.0.1) pre localhost a napr. (napr. ping -t 8.8.8.8  ) pre pripojenie na internet ?
Ide o to, že na PC môžeš mať viacero sieťových adaptérov (ja mám 2x Ethernet + USB Wifi) a nemusíš zisťovať, ktorý je momentálne aktívny.

[jarex]

Ale mně nejde o připojení k internetu, mně jde o to, zda je adaptér připojen do sítě. Název adaptéru znám a chci podle jeho názvu vědět, jestli linkuje. V mém případě se jedná o připojení kabelem. Však je to z toho kódu, co jsem poslal i zřejmé, že se ptám přímo na konkrétní název adaptéru, a pak zda je připojen, nebo odpojen. Jen mi tento způsob nepřijde zrovna ideální, jelikož spolehlivost na základě dosoutputu nebude bůhví jaká. A potřebuji se na to ptát cyklicky. Nejlépe by vyhovoval nějaký event, ale to opravdu nevím, jak na to.

[tomak586]

Tohle reseni je pres Windows Management Instrumentation. Nevim jestli ti to bude vyhovovat, ale koukni se.

Kód: Delphi [Vybrat]

1. program TestConnectAdapt;
2.  
3. {$APPTYPE CONSOLE}
4.  
5. {$R *.res}
6.  
7. uses
8.   Winapi.Windows,
9.   System.SysUtils,
10.   Winapi.ActiveX,
11.   System.Win.ComObj,
12.   System.Variants;
13.  
14. function GetStatusInterface(AdapterName: string): Boolean;
15. var
16.   FSWbemLocator: OLEVariant;
17.   FWMIService: OLEVariant;
18.   FWbemObjectSet: OLEVariant;
19.   FWbemObject: OLEVariant;
20.   oEnum: IEnumvariant;
21.   iValue: LongWord;
22. begin
23.   Result := False;
24.   try
25.     FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
26.     FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
27.  
28.     FWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM Win32_NetworkAdapter WHERE NetConnectionID = "' + AdapterName + '"', 'WQL', 0);
29.     oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
30.  
31.     if oEnum.Next(1, FWbemObject, iValue) = 0 then
32.     begin
33.       Result := (FWbemObject.NetConnectionStatus = 2); // 2 - připojeno
34.     end;
35.   except
36.   end;
37. end;
38.  
39. begin
40.   try
41.     CoInitialize(nil);
42.     var IsConnected := GetStatusInterface('Wi-Fi');
43.     CoUninitialize;
44.  
45.     if IsConnected then
46.       Writeln('Adaptér je připojen')
47.     else
48.       Writeln('Adaptér je odpojen');
49.  
50.   except
51.     on E: Exception do
52.       Writeln(E.ClassName, ': ', E.Message);
53.   end;
54. end.
55.  

[jarex]

Moc děkuji. Funguje to, ale pouze v hlavním vlákně, navíc procedura trvá okolo 2s. Jakmile to dám do samostatného tthread, skončí to na

Kód: Delphi [Vybrat]

1.   FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');

Celé vlákno mám takto:

Kód: Delphi [Vybrat]

1. procedure TGetLan.Execute;
2. var
3.   FSWbemLocator: OLEVariant;
4.   FWMIService: OLEVariant;
5.   FWbemObjectSet: OLEVariant;
6.   FWbemObject: OLEVariant;
7.   oEnum: IEnumvariant;
8.   iValue: LongWord;
9. begin
10. while not GetLan.terminated do
11.     begin
12.     sleep(1000);
13.     try
14.     FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
15.     FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
16.     FWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM Win32_NetworkAdapter WHERE NetConnectionID = "' + 'Ethernet 2' + '"', 'WQL', 0);
17.     oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
18.     if oEnum.Next(1, FWbemObject, iValue) = 0 then
19.     begin
20.     if (FWbemObject.NetConnectionStatus = 2) then LANLED:='1' else LANLED:='0'; // 2 - připojeno
21.     end;
22.     except
23.     end;
24.     end;
25. end;

[zdenek]

A není potřeba ve vlákně inicialilzovat COM?

[jarex]

Ano bylo to tak:

Kód: Delphi [Vybrat]

1. CoInitializeEx(nil,COINIT_APARTMENTTHREADED)

díky za rady.

[jarex]

Tak trochu problem. Cyklické provadeni procedury zapříčiní celkem velké vytížení procesoru. Je to primitivní zařízení s jednojádrem, a i když se procedura ve vlákně provádí se sleepem 2000 ms, procesor toto vlákno vytíží na 10- 15%. Tedy pro potřebu rozsvítit, či zhasnout LED diodu katastrofa. Nedá se to vyčíst třeba z registrů, nebo podobně? Nebo třeba nějaká událost? Vždyť je to primitivní požadavek . . . Na to se v Delphi nemyslelo?

[vandrovnik]

Nešlo by se inspirovat tady?
https://learn.microsoft.com/en-us/windows/win32/api/iphlpapi/nf-iphlpapi-getadaptersaddresses

Vrací to spoustu věcí, které asi nevyužiješ, ale nadějně tam vypadá "OperStatus": https://learn.microsoft.com/en-us/windows/win32/api/iptypes/ns-iptypes-ip_adapter_addresses_lh

[chaloup]

Jestli považuješ to, že má síťový adapter IP adresu, tak něco takovýho, podívej se co ti to bude vracet když to bude odpojený

https://learn.microsoft.com/en-us/windows/win32/api/iphlpapi/nf-iphlpapi-getadaptersinfo
https://learn.microsoft.com/en-us/windows/win32/api/iptypes/ns-iptypes-ip_adapter_info

Kód: Delphi [Vybrat]

1. uses
2.   Winapi.IpTypes,
3.   Winapi.IpHlpApi;
4.  
5. function IsNetworkCableConnected: Boolean;
6. const
7.   MIB_IF_TYPE_ETHERNET = 6;
8. var
9.   AdapterInfo: PIP_ADAPTER_INFO;
10.   AdapterList: PIP_ADAPTER_INFO;
11.   AdapterSize: ULONG;
12. begin
13.   Result := False;
14.   AdapterSize := 0;
15.   GetAdaptersInfo(nil, AdapterSize);
16.   GetMem(AdapterInfo, AdapterSize);
17.   try
18.     if GetAdaptersInfo(AdapterInfo, AdapterSize) = ERROR_SUCCESS then
19.     begin
20.       AdapterList := AdapterInfo;
21.       while AdapterList <> nil do
22.       begin
23.         if (AdapterList^.Type_ = MIB_IF_TYPE_ETHERNET) and (AdapterList^.AddressLength > 0) then
24.         begin
25.           Result := True; // Kabel je připojen
26.           Break;
27.         end;
28.         AdapterList := AdapterList^.Next;
29.       end;
30.     end;
31.   finally
32.     FreeMem(AdapterInfo);
33.   end;
34. end;
35.  

[vandrovnik]

Tak mi to nedalo :-)

Kód: Delphi [Vybrat]

1. procedure TMainForm.Button2Click(Sender: TObject);
2.  var Buf: PIP_ADAPTER_ADDRESSES;
3.      Item: PIP_ADAPTER_ADDRESSES;
4.      BufSize: UInt;
5.      Stav: string;
6.  begin
7.  BufSize:=0;
8.  GetAdaptersAddresses(0 {AF_UNSPEC}, 0 {flags}, nil, nil, @BufSize);
9.  GetMem(Buf, BufSize);
10.  try
11.   if GetAdaptersAddresses(0 {AF_UNSPEC}, 0 {flags}, nil, Buf, @BufSize)=ERROR_SUCCESS then begin
12.    Item:=Buf;
13.    while Item<>nil do begin
14.     case Item^.OperStatus of
15.      IfOperStatusUp: Stav:='Up';
16.      IfOperStatusDown: Stav:='Down';
17.      IfOperStatusTesting: Stav:='Testing';
18.      IfOperStatusUnknown: Stav:='Unknown';
19.      IfOperStatusDormant: Stav:='Dormant';
20.      IfOperStatusNotPresent: Stav:='Not present';
21.      IfOperStatusLowerLayerDown: Stav:='Lower level down';
22.      else Stav:='?';
23.     end;
24.     eLog.Lines.Add(Item^.FriendlyName+': '+Stav);
25.     Item:=Item^.Next;
26.    end;
27.   end;
28.  finally
29.   FreeMem(Buf);
30.  end;
31. end;
32.  

[jarex]

Moc díky, nějak se s tím popasuji.