Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Erkennen der Lan Verbindung (Netzwerkkabel rein/raus) (https://www.delphipraxis.net/149487-erkennen-der-lan-verbindung-netzwerkkabel-rein-raus.html)

Rudirabbit 22. Mär 2010 18:56


Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Hallo
Wenn das Lankabel rein/ausgesteckt wird (und eine Lan Verbingung aufgebaut wird),
müsste das WinOS doch eine WM_Message schicken :?:

WM_devicechange ist es nicht ....(ist auch logisch - es wird im prinzip kein Gerät angesteckt)

Zur Zeit polle ich (Code in etwa von DP übernommen) :
Delphi-Quellcode:
function TForm1.isOnline: Boolean;
var dlvFlag : DWord;
begin
dlvFlag :=Internet_Connection_Lan;
result:= InternetGetConnectedState ( @dlvFlag, 0 );
end;
Viel schöner wäre wenn ich ein Event dafür hätte :gruebel:

Luckie 22. Mär 2010 21:03

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Was willst du erreichen? Was wenn jemand das Kabel vom Router oder Switch rauszieht?

s.h.a.r.k 22. Mär 2010 21:29

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Und selbst dann muss ja noch lange nichts funktionieren. Wenn eine feste IP vergeben wurde, dann kann das Netz arbeiten, in so fern auch andere Rechner im selben Bereich liegen. Aber wenn z.B. DHCP auf den Rechnern aktiviert ist und der DHCP-Server ausfällt bringt dir das auch nicht wirklich viel.

ghost007 22. Mär 2010 21:35

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
@Meine zwei vorredner:
Ich verstehe nicht wieso ihr gleich versucht ihn auf einen anderen Pfad zu bringen bzw. versucht etwas in seine Fragestellung hinenzuinterpretieren.
Er will doch einfach nur wissen ob man feststellen kann ob das Kabel drin ist oder nicht. :wink:

Luckie 22. Mär 2010 21:55

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Und da man genau dies nicht kann, versuchen wir aus ihm herauszubekommen, was er eigentlich erreichen will.

Klaus01 22. Mär 2010 21:58

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
.. ich weiß zwar nicht wie, aber sollte es nicht gehen?
Windows zeigt den Status doch auch an (connected oder disconnected).

Grüße
Klaus

Christian Seehase 22. Mär 2010 22:02

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Zitat:

Zitat von Luckie
Und da man genau dies nicht kann, versuchen wir aus ihm herauszubekommen, was er eigentlich erreichen will.

Dann zieh' doch einfach mal das Netzwerkkabel aus Deinem Rechner (soweit Du nicht mit WLAN arbeitest):
Wenn Du in der Netzwerkverbindung "Benachrichtigen, wenn diese Verbindung eingeschränkte oder keine Konnektivität besitzt" aktiviert hast, kommt im Tray eine Meldung.
Den Grund für diese Meldung abzufangen ist Rudirabbits Problem.

Meflin 22. Mär 2010 22:04

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Zitat:

Zitat von Luckie
Und da man genau dies nicht kann, versuchen wir aus ihm herauszubekommen, was er eigentlich erreichen will.

Erkennung Netzwerkkabel != Erkennung des Onlinestatus. Bis zum Loswerden des obligatorischen Belehrungslinks musst du also noch warten, sollte sich herausstellen, dass letzteres das Ziel war :P

Klaus01 22. Mär 2010 22:13

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
.. vielleicht hier bei NetworkAvailabilityChangedEventHandler genauer nachschauen.

Grüße
Klaus

alzaimar 23. Mär 2010 08:20

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
So und nu ohne dot.net..?

Remko 23. Mär 2010 08:25

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
You can use the SENS api to get an event when a network cable is (un)plugged.
SENS headers are in the Jedi ApiLib (JwaSens and JwaSensApi), below is some very old code from a testproject that might help you:

MainUnit:
Delphi-Quellcode:
uses
  JwaSens,
  ActiveX, ComObj,
  SensNetworkClient_TLB, EventSystemLib_TLB, SensEvents_TLB;

const
  CLS_NetworkID: TGUID = '{7257843D-7E82-416A-AF80-03BEB9B026EE}';

procedure TMainForm.StartSenseActionExecute(Sender: TObject);
var
  EventSystem: IEventSystem;
  Subscription: IEventSubscription;
  NetworkSubscriber: ISensNetwork;
begin
  CoInitialize(nil);

  NetworkSubscriber := CoSensNetworkSubscriber.Create;

  CoCreateInstance(
    ProgIdToClassId('EventSystem.EventSubscription'), nil, CLSCTX_SERVER,
    IID_IEventSubscription, Subscription);
  Subscription.SubscriptionID := GuidToString(CLS_NetworkID);
  Subscription.SubscriptionName := 'SENS Client';
  Subscription.EventClassID := GuidToString(SENSGUID_EVENTCLASS_NETWORK);
  Subscription.SubscriberInterface := NetworkSubscriber;

   CoCreateInstance(
    ProgIdToClassId('EventSystem.EventSystem'), nil, CLSCTX_SERVER,
    IID_IEventSystem, EventSystem);
  EventSystem.Store('EventSystem.EventSubscription', Subscription);
end;

procedure TMainForm.StopSenseActionExecute(Sender: TObject);
var
  EventSystem: IEventSystem;
  Error: Integer;
begin
  CoCreateInstance(
    ProgIdToClassId('EventSystem.EventSystem'), nil,
    CLSCTX_SERVER, IID_IEventSystem, EventSystem);
  EventSystem.Remove(
    'EventSystem.EventSubscription',
    'SubscriptionID == ' + GuidToString(CLS_NetworkID), Error);
end;
and

Delphi-Quellcode:
unit SensNetworkClientImpl;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, SensNetworkClient_TLB, StdVcl, ExtCtrls, SensEvents_TLB,
  JwaIpHlpApi, JwaIpRtrMib;

type
  TSensNetworkSubscriber = class(TAutoObject, ISensNetwork)
  protected
    procedure ConnectionLost(const bstrConnection: WideString;
      ulType: LongWord); safecall;
    procedure ConnectionMade(const bstrConnection: WideString;
      ulType: LongWord; var lpQOCInfo: SENS_QOCINFO); safecall;
    procedure ConnectionMadeNoQOCInfo(const bstrConnection: WideString;
      ulType: LongWord); safecall;
    procedure DestinationReachable(const bstrDestination,
      bstrConnection: WideString; ulType: LongWord;
      var lpQOCInfo: SENS_QOCINFO); safecall;
    procedure DestinationReachableNoQOCInfo(const bstrDestination,
      bstrConnection: WideString; ulType: LongWord); safecall;

  end;

implementation

uses
  uMain, ComServ;
function RouteAdd(dest: PChar; mask: PChar; gw: PChar);
var pRoute: _MIB_IPFORWARDROW;
  dwStatus: DWord;
begin
  FillChar(pRoute, SizeOf(pRoute), 0);
  pRoute.dwForwardDest := inet_addr(dest);
  pRoute.dwForwardMask := inet_addr(mask);
  pRoute.dwForwardNextHop := inet_addr(gw);
  pRoute.dwForwardProto := MIB_IPPROTO_NETMGMT;

  dwStatus := CreateIpForwardEntry(pRoute);
  if dwStatus <> NO_ERROR then
  begin
    ShowMessageFmt('CreateIpForwardEntry: %s', [SysErrorMessage(dwStatus)]);
  end;
end;

procedure TSensNetworkSubscriber.ConnectionLost(const bstrConnection: WideString; ulType: LongWord);
begin
  MainForm.TrayIcon1.BalloonFlags := bfInfo;
  MainForm.TrayIcon1.BalloonTitle := 'GPR Network Monitor';
  MainForm.TrayIcon1.BalloonHint := 'Disconnected from ' + bstrConnection;
  MainForm.TrayIcon1.BalloonTimeout := 3000;
  MainForm.TrayIcon1.ShowBalloonHint;
  MainForm.ListBox1.Items.Add('ConnectionLost: ' + bstrConnection);
end;

procedure TSensNetworkSubscriber.ConnectionMade(const bstrConnection: WideString; ulType: LongWord; var lpQOCInfo: SENS_QOCINFO);
begin
  MainForm.ListBox1.Items.Add('ConnectionMade: ' + bstrConnection);
  MainForm.TrayIcon1.BalloonFlags := bfInfo;
  MainForm.TrayIcon1.BalloonTitle := 'GPR Network Monitor';
  MainForm.TrayIcon1.BalloonHint := 'Connected to ' + bstrConnection;
  MainForm.TrayIcon1.BalloonTimeout := 3000;
  MainForm.TrayIcon1.ShowBalloonHint;
end;

procedure TSensNetworkSubscriber.ConnectionMadeNoQOCInfo(const bstrConnection: WideString; ulType: LongWord);
begin
  MainForm.ListBox1.Items.Add('ConnectionLostNoQOCInfo: ' + bstrConnection);
end;

procedure TSensNetworkSubscriber.DestinationReachable(
  const bstrDestination, bstrConnection: WideString; ulType: LongWord;
  var lpQOCInfo: SENS_QOCINFO);
begin
  MainForm.ListBox1.Items.Add('DestinationReachable: ' + bstrConnection);
end;

procedure TSensNetworkSubscriber.DestinationReachableNoQOCInfo(const bstrDestination, bstrConnection: WideString; ulType: LongWord);
begin
  MainForm.ListBox1.Items.Add('DestinationReachableNoQOCInfo: ' + bstrConnection);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TSensNetworkSubscriber, Class_SensNetworkSubscriber,
    ciSingleInstance, tmApartment);
end.

Rudirabbit 23. Mär 2010 19:02

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Danke für den Tip Remko :) werde deinen Vorschlag mal Testen.
Du hast die Lösung meines Problems, und nicht eine Gegenfrage was ich damit bezwecken will. :?

Was will ich machen:
In unserer KFZ Firma sind mehrere nicht stationäre Winbasierende Diagnosetester in Betrieb.
Um Garantieansprüche geltend machen zu können, darf der Timestamp des via VPN zum
Hersteller Verschickten Diagnoseprotokolls max +/- 3 Minuten abweichen.

Die Uhren müssten nun regelmässig justiert werden.

Ein Gerät ist Stationär und immer Online.
Nun hatte ich eben die Idee, das dieses Gerät der Timeserver für die Clients sein soll.
Den Timeserver justiere ich via DCF.

Wenn also ein Client eine Onlineverbindung bekommt (LAN Kabel wird eingesteckt) soll er einmal am Tag vom Timeserver justiert werden.

Ich habe dies so erfolgreich in Betrieb, die Tester haben alle eine feste IP.

Da die Hardwareressourcen auf den Client's nicht üppig sind, wollte ich diese mit meinem Polling nicht zusätzlich ausbremsen.

Auch die Diagnosesoftware nimmt CPU ohne Ende, dazu extrem langsam, und hat jede Menge Bug's
Ich würde so einen Schrott hier nicht uploaden.
Und dies kommt auch noch von einem Deutschen sehr bekanntem Auto Hersteller. :shock:

mfg.

PS: Der Update via Internet zb.(time.windows.com) funktioniert nicht.
Evtl. blockt die Firewall der Firma diesen Port.

Rudirabbit 26. Mär 2010 18:14

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Ich hatte heute erst die Zeit um Remko's Vorschlag zu testen.

Bei Sourceforge finde ich eine Sens API 2.3, mit der ich teste.
Dort fehlt die Unit SensNetworkClient_TLB :? alle anderen sind vorhanden.

Ohne diese Unit lässt sich dies nicht compilern:
Delphi-Quellcode:
NetworkSubscriber := CoSensNetworkSubscriber.Create;
Die Klasse CoSensNetworkSubscriber gibt es nicht :?

Remko 26. Mär 2010 18:19

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Import the tlb from sens.dll

Rudirabbit 27. Mär 2010 17:52

Re: Erkennen der Lan Verbindung (Netzwerkkabel rein/raus)
 
Hallo Remko, danke für den Tip :)

Der Import von sens.dll erzeugt die Wrapper-Unit :o
Mit viel Nachlesen und (versucht zu) Verstehen und natürlich dank deiner Hilfe habe ich es dann endlich geschafft 8-)

Hatte mich vorher noch nie mit der COM-Programmierung befasst, ist auch nicht gerade einfach zu verstehen.

mfg Rudi

PS:
Als ich diesen Thread gestartet hatte, habe ich vorher natürlich hier im DP Forum gesucht.
Es gibt einige ältere Thread's mit diesem oder ähnlichen Themen.
Dort kamen aber keine Lösungen zustande.


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:44 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz