unit UNetworkInterfaceMonitor;

interface

uses
  System.SysUtils,
  System.Classes,
  System.Generics.Collections,
  System.SyncObjs,
  MSI_Network,
  UTimeUtils;

type
  TNetworkInterfaceMonitor = class(TObject)
  public type
    TInterest = record
    public type
      TKind =
      (
        Alias,
        Name
      );

      TKindHelper = record Helper for TKind
      public
        function ToString: string;
      end;
    public
      Kind: TKind;
      Value: string;
    end;

    TNetworkInterface = record
      Alias: string;
      Name: string;
      IP: string;

      procedure Clear;
    end;

    TResult = record
      Found: Boolean;
      NetworkInterface: TNetworkInterface;

      procedure Clear;
    end;

    Exception = class(System.SysUtils.Exception);
  strict private type
    TThread = class(System.Classes.TThread)
    strict private const
      Interval = 5000;
    strict private type
      TOwner = TNetworkInterfaceMonitor;
      TEvent = TLightweightEvent;
    strict private
      FEvent: TEvent;
    protected
      procedure Execute; override;
    public
      constructor Create;
      destructor Destroy; override;

      procedure Signal;
    end;

    TNetwork = TMiTeC_Network;

    TLock = System.SysUtils.TMultiReadExclusiveWriteSynchronizer;

    THost = record
    strict private
      FTimestamp: TMillisecond;
      FName: string;
    public
      property Timestamp: TMillisecond read FTimestamp;
      function Touched: Boolean;
      procedure Touch;

      property Name: string read FName write FName;
    end;

    TDictionary = class(TObject)
    public type
      TOwner = TNetworkInterfaceMonitor;
      TKey = string;
      TRefCount = Cardinal;

      Exception = TOwner.Exception;
    strict private type
      TDictionary<T> = class(System.Generics.Collections.TDictionary<TKey, T>)
      public type
        TKey = TDictionary.TKey;
        TValue = T;
        TPair = TPair<TKey, TValue>;
      strict private
        FTimestamp: TMillisecond;
      public
        property Timestamp: TMillisecond read FTimestamp;
        procedure Touch;

        procedure Assign(const ASource: TDictionary<T>); inline;
      end;
    public type
      TInterest = class(TDictionary<TRefCount>)
      public type
        TKey = TDictionary.TKey;
        TValue = TRefCount;
        TPair = TPair<TKey, TValue>;
      end;

      TNetworkInterface = class(TDictionary<TOwner.TNetworkInterface>)
      public type
        TKey = TDictionary.TKey;
        TValue = TOwner.TNetworkInterface;
        TPair = TPair<TKey, TValue>;
      end;
    strict private
      FInterest: TDictionary.TInterest;
      FNetworkInterface: TDictionary.TNetworkInterface;
    public
      constructor Create;
      destructor Destroy; override;

      function Key(const AInterest: TOwner.TInterest): TDictionary.TKey;{$IFNDEF DEBUG}inline;{$ENDIF}

      procedure QueryInterest(const AInterest: TOwner.TInterest; out AFound: Boolean; out AKey: TDictionary.TKey; out ARefCount: TDictionary.TRefCount);{$IFNDEF DEBUG}inline;{$ENDIF}
      procedure ValidateInterest(const AInterest: TOwner.TInterest; out AKey: TDictionary.TKey; out ARefCount: TDictionary.TRefCount);{$IFNDEF DEBUG}inline;{$ENDIF}
      function TryAddNetworkInterface(const AInterest: TInterest; const ANetworkInterface: TOwner.TNetworkInterface): Boolean;{$IFNDEF DEBUG}inline;{$ENDIF}

      property Interest: TDictionary.TInterest read FInterest;
      property NetworkInterface: TDictionary.TNetworkInterface read FNetworkInterface;
    end;
  strict private class var
    FTerminating: Boolean;
    FThread: TThread;
    FNetwork: TNetwork;
  strict private class var
    FLock: TLock;
    FHost: THost;
    FDictionary: TDictionary;
  private class
    function Refresh: Boolean;
  strict private const
    EnsureRefreshedYieldTime = 100;
  public const
    EnsureRefreshedDefault = False;
  public
    class constructor Create;
    class destructor Destroy;

    function HostName(const AEnsureRefreshed: Boolean = EnsureRefreshedDefault): string;

    procedure RegisterInterest(const AInterest: TInterest);
    procedure DeregisterInterest(const AInterest: TInterest);

    function Query(const AInterest: TInterest; const AEnsureRefreshed: Boolean = EnsureRefreshedDefault): TResult;
  end;

implementation

{ TNetworkInterfaceMonitor.TInterest.TKindHelper }

function TNetworkInterfaceMonitor.TInterest.TKindHelper.ToString: string;
const
  Strings: array[TKind] of string =
  (
    'Alias',
    'Name'
  );
begin
  Result := Strings[Self];
end;

{ TNetworkInterfaceMonitor.TNetworkInterface }

procedure TNetworkInterfaceMonitor.TNetworkInterface.Clear;
begin
  Alias := '';
  Name := '';
  IP := '';
end;

{ TNetworkInterfaceMonitor.TResult }

procedure TNetworkInterfaceMonitor.TResult.Clear;
begin
  Found := False;
  NetworkInterface.Clear;
end;

{ TNetworkInterfaceMonitor.TThread }

constructor TNetworkInterfaceMonitor.TThread.Create;
begin
  FEvent := TEvent.Create;

  inherited Create(False);

  FreeOnTerminate := False;
end;

destructor TNetworkInterfaceMonitor.TThread.Destroy;
begin
  inherited;

  FreeAndNil(FEvent);
end;

procedure TNetworkInterfaceMonitor.TThread.Execute;
begin
  TThread.NameThreadForDebugging(ClassName);

  while not Terminated do
  begin
    FEvent.WaitFor(Interval);
    FEvent.ResetEvent;

    if not TOwner.Refresh then
    begin
      Terminate;
    end;
  end;
end;

procedure TNetworkInterfaceMonitor.TThread.Signal;
begin
  FEvent.SetEvent;
end;

{ TNetworkInterfaceMonitor.THost }

function TNetworkInterfaceMonitor.THost.Touched: Boolean;
begin
  Result := FTimestamp <> 0;
end;

procedure TNetworkInterfaceMonitor.THost.Touch;
begin
  FTimestamp := NowAsMilliseconds;
end;

{ TNetworkInterfaceMonitor.TDictionary.TDictionary<T> }

procedure TNetworkInterfaceMonitor.TDictionary.TDictionary<T>.Touch;
begin
  FTimestamp := NowAsMilliseconds;
end;

procedure TNetworkInterfaceMonitor.TDictionary.TDictionary<T>.Assign(const ASource: TDictionary<T>);
begin
  FTimestamp := ASource.Timestamp;
  Clear;

  for var LPair: TPair in ASource do
  begin
    Add(LPair.Key, LPair.Value);
  end;
end;

{ TNetworkInterfaceMonitor.TDictionary }

constructor TNetworkInterfaceMonitor.TDictionary.Create;
begin
  inherited;

  FInterest := TDictionary.TInterest.Create;
  FNetworkInterface := TDictionary.TNetworkInterface.Create;
end;

destructor TNetworkInterfaceMonitor.TDictionary.Destroy;
begin
  FreeAndNil(FNetworkInterface);
  FreeAndNil(FInterest);

  inherited;
end;

function TNetworkInterfaceMonitor.TDictionary.Key(const AInterest: TOwner.TInterest): TDictionary.TKey;
begin
  Result := AInterest.Kind.ToString + '_' + LowerCase(AInterest.Value);
end;

procedure TNetworkInterfaceMonitor.TDictionary.QueryInterest(const AInterest: TOwner.TInterest; out AFound: Boolean; out AKey: TDictionary.TKey; out ARefCount: TDictionary.TRefCount);
begin
  AKey := Key(AInterest);
  AFound := FInterest.TryGetValue(AKey, ARefCount);
end;

function TNetworkInterfaceMonitor.TDictionary.TryAddNetworkInterface(const AInterest: TInterest; const ANetworkInterface: TOwner.TNetworkInterface): Boolean;
begin
  var LKey: TDictionary.TKey;
  var LInterestValue: TDictionary.TInterest.TValue;

  QueryInterest(AInterest, Result, LKey, LInterestValue);

  if not Result then
  begin
    Exit; // ==>
  end;

  FNetworkInterface.TryAdd(LKey, ANetworkInterface);
end;

procedure TNetworkInterfaceMonitor.TDictionary.ValidateInterest(const AInterest: TOwner.TInterest; out AKey: TDictionary.TKey; out ARefCount: TDictionary.TRefCount);
begin
  var LFound: Boolean;
  QueryInterest(AInterest, LFound, AKey, ARefCount);

  if not LFound then
  begin
    raise TDictionary.Exception.Create('Unknown interest');
  end;
end;

{ TNetworkInterfaceMonitor }

class constructor TNetworkInterfaceMonitor.Create;
begin
  inherited;

  FLock := TLock.Create;
  FDictionary := TDictionary.Create;
  FNetwork := TNetwork.Create(nil);
  FThread := TThread.Create;
end;

class destructor TNetworkInterfaceMonitor.Destroy;
begin
  FTerminating := True;

  if Assigned(FThread) then
  begin
    FThread.Signal;
    FThread.WaitFor;

    FreeAndNil(FThread);
  end;

  FreeAndNil(FNetwork);
  FreeAndNil(FDictionary);
  FreeAndNil(FLock);

  inherited;
end;

class function TNetworkInterfaceMonitor.Refresh: Boolean;
const
  YieldTime = 100;
begin
  if FTerminating then
  begin
    Exit(False); // ==>
  end;

  var LDictionary: TDictionary := TDictionary.Create;
  try
    FLock.BeginRead;
    try
      LDictionary.Interest.Assign(FDictionary.Interest);
    finally
      FLock.EndRead;
    end;

    if FTerminating then
    begin
      Exit(False); // ==>
    end;

    FNetwork.RefreshData; // TODO: Filter???
    var LTCPIP: TMiTeC_TCPIP := FNetwork.TCPIP;

    if FTerminating then
    begin
      Exit(False); // ==>
    end;

    FLock.BeginWrite;
    try
      FHost.Name := LTCPIP.HostName;
      FHost.Touch;
    finally
      FLock.EndWrite;
    end;

    Sleep(YieldTime);

    var LRequiredCount: Integer := LDictionary.Interest.Count;

    if LRequiredCount = 0 then
    begin
      Exit(True); // ==>
    end;

    for var LIndex: Integer := 0 to LTCPIP.AdapterCount - 1 do
    begin
      if FTerminating then
      begin
        Exit(False); // ==>
      end;

      var LAdapter: TAdapter := LTCPIP.Adapter[LIndex];
      var LNetworkInterface: TNetworkInterface;

      LNetworkInterface.Alias := LAdapter.Alias;
      LNetworkInterface.Name := LAdapter.Name;
      LNetworkInterface.IP := Trim(LAdapter.IPAddress.Text);

      var LInterest: TInterest;
      LInterest.Kind := TInterest.TKind.Alias;
      LInterest.Value := LAdapter.Alias;

      if LDictionary.TryAddNetworkInterface(LInterest, LNetworkInterface) and (LDictionary.NetworkInterface.Count = LRequiredCount) then
      begin
        Exit(True); // ==>
      end;

      if FTerminating then
      begin
        Exit(False); // ==>
      end;

      LInterest.Kind := TInterest.TKind.Name;
      LInterest.Value := LAdapter.Name;

      if LDictionary.TryAddNetworkInterface(LInterest, LNetworkInterface) and (LDictionary.NetworkInterface.Count = LRequiredCount) then
      begin
        Exit(True); // ==>
      end
    end;
  finally
    try
      if not FTerminating then
      begin
        FLock.BeginWrite;
        try
          if FDictionary.Interest.Timestamp = LDictionary.Interest.Timestamp then
          begin
            FDictionary.NetworkInterface.Assign(LDictionary.NetworkInterface);
            FDictionary.NetworkInterface.Touch;
          end; // else there's been a change to the input, i.e., we need to wait for the next cycle to refresh the output to match
        finally
          FLock.EndWrite;
        end;
      end;
    finally
      FreeAndNil(LDictionary);
    end;
  end;

  Result := not FTerminating;
end;

function TNetworkInterfaceMonitor.HostName(const AEnsureRefreshed: Boolean = False): string;
begin
  if FTerminating then
  begin
    Exit(''); // ==>
  end;

  var LForceRefresh: Boolean := not FHost.Touched; // Unlike a network interface, the host name must always have been obtained at least once

  if LForceRefresh or AEnsureRefreshed then
  begin
    var LTimestamp: TMillisecond := FHost.Timestamp;
    FThread.Signal;

    while FHost.Timestamp = LTimestamp do
    begin
      Sleep(EnsureRefreshedYieldTime);

      if FTerminating then
      begin
        Exit(''); // ==>
      end;
    end;
  end;

  FLock.BeginRead;
  try
    Result := FHost.Name;
  finally
    FLock.EndRead;
  end;
end;

procedure TNetworkInterfaceMonitor.RegisterInterest(const AInterest: TInterest);
begin
  FLock.BeginWrite;
  try
    var LFound: Boolean;
    var LKey: TDictionary.TKey;
    var LRefCount: TDictionary.TInterest.TValue;

    FDictionary.QueryInterest(AInterest, LFound, LKey, LRefCount);

    if LFound then
    begin
      LRefCount := LRefCount + 1;
    end else
    begin
      LRefCount := 1;
    end;

    FDictionary.Interest.AddOrSetValue(LKey, LRefCount);
    FDictionary.Interest.Touch;
  finally
    FDictionary.Interest.Touch;
    FLock.EndWrite;
    FThread.Signal;
  end;
end;

procedure TNetworkInterfaceMonitor.DeregisterInterest(const AInterest: TInterest);
begin
  FLock.BeginWrite;
  try
    var LKey: TDictionary.TKey;
    var LRefCount: TDictionary.TInterest.TValue;

    FDictionary.ValidateInterest(AInterest, LKey, LRefCount);

    if (LRefCount = 1) and (FDictionary.Interest.Count = 1) then
    begin
      FDictionary.Interest.Clear;
      FDictionary.NetworkInterface.Clear;

      Exit; // ==>
    end;

    if LRefCount = 1 then
    begin
      FDictionary.Interest.Remove(LKey);
      FDictionary.NetworkInterface.Remove(LKey);

      Exit; // ==>
    end;

    LRefCount := LRefCount - 1;
    FDictionary.Interest.AddOrSetValue(LKey, LRefCount);
  finally
    FDictionary.Interest.Touch;
    FLock.EndWrite;
    FThread.Signal;
  end;
end;

function TNetworkInterfaceMonitor.Query(const AInterest: TInterest; const AEnsureRefreshed: Boolean): TResult;
begin
  if FTerminating then
  begin
    Result.Clear;
    Exit; // ==>
  end;

  if AEnsureRefreshed then
  begin
    var LTimestamp: TMillisecond := FDictionary.NetworkInterface.Timestamp;
    FThread.Signal;

    while FDictionary.NetworkInterface.Timestamp = LTimestamp do
    begin
      Sleep(EnsureRefreshedYieldTime);

      if FTerminating then
      begin
        Result.Clear;
        Exit; // ==>
      end;
    end;
  end;

  FLock.BeginRead;
  try
    var LKey: TDictionary.TKey;
    var LRefCount: TDictionary.TInterest.TValue;

    FDictionary.ValidateInterest(AInterest, LKey, LRefCount);

    var LFound: Boolean;
    var LNetworkInterface: TDictionary.TNetworkInterface.TValue;

    LFound := FDictionary.NetworkInterface.TryGetValue(LKey, LNetworkInterface);

    if not LFound then
    begin
      Result.Clear;
      Exit; // ==>
    end;

    Result.NetworkInterface := LNetworkInterface;
    Result.Found := True;
  finally
    FLock.EndRead;
  end;
end;

end.