Delphi-PRAXiS
Seite 2 von 2     12   

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)

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 20:01 Uhr.
Seite 2 von 2     12   

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