source: trunk/UNetwork.pas

unit UNetwork;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Contnrs, Graphics, Dialogs, fgl;

type
  TNetworkNode = class;
  TNetworkInterface = class;

  { TNetworkAddress }

  TNetworkAddress = record
    Parts: array of Integer;
    Context: Integer;
    class operator Equal(A, B: TNetworkAddress): Boolean;
    function GetString: string;
    procedure Clear;
  end;

  TNetworkPacketProtocol = (nppDIA1);

  TNetworkPacket = class
    Protocol: TNetworkPacketProtocol;
    Source: TNetworkAddress;
    Destination: TNetworkAddress;
    Data: string;
  end;

  TRecivePacketEvent = procedure(Sender: TNetworkInterface; Packet: TNetworkPacket) of object;
  TLogEvent = procedure(Sender: TNetworkNode; Data: string) of object;

  { TNetworkInterface }

  TNetworkInterface = class
  private
    FOnReceivePacket: TRecivePacketEvent;
    FRemote: TNetworkInterface;
    function GetConnected: Boolean;
    procedure SetRemote(AValue: TNetworkInterface);
    procedure ReceivePacket(Packet: TNetworkPacket);
  public
    Node: TNetworkNode;
    Address: TNetworkAddress;
    Network: Integer;
    procedure Connect(Remote: TNetworkInterface);
    procedure Disconnet;
    procedure SendPacket(Packet: TNetworkPacket);
    constructor Create;
    destructor Destroy; override;
    property Remote: TNetworkInterface read FRemote
      write SetRemote;
    property OnReceivePacket: TRecivePacketEvent read FOnReceivePacket write FOnReceivePacket;
    property Connected: Boolean read GetConnected;
  end;

  { TNetworkNode }

  TNetworkNode = class
  private
    procedure ReceivePacket(Sender: TNetworkInterface; Packet: TNetworkPacket); virtual;
  public
    Name: string;
    Position: TPoint;
    Interfaces: TFPGObjectList<TNetworkInterface>;
    function AddInterface: TNetworkInterface;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  { TNetworkSwitch }

  TNetworkSwitch = class(TNetworkNode)
  private
    procedure ReceivePacket(Sender: TNetworkInterface; Packet: TNetworkPacket); override;
  public
    constructor Create; override;
  end;

  { TNetworkHost }

  TNetworkHost = class(TNetworkNode)
  private
    FOnLog: TLogEvent;
    procedure ReceivePacket(Sender: TNetworkInterface; Packet: TNetworkPacket); override;
    procedure DoLog(Sender: TNetworkNode; Data: string);
  public
    procedure Ping(Address: TNetworkAddress);
    property OnLog: TLogEvent read FOnLog write FOnLog;
  end;

  { TNetworkRouter }

  TNetworkRouter = class(TNetworkHost)
  private
    procedure ReceivePacket(Sender: TNetworkInterface; Packet: TNetworkPacket); override;
  public
  end;

  TNetwork = class
    Nodes: TFPGObjectList<TNetworkNode>;
    function AddRouter(Name: string; Position: TPoint; InterfaceCount: Integer; Log: TLogEvent): TNetworkRouter;
    function AddHost(Name: string; Position: TPoint; InterfaceCount: Integer; Log: TLogEvent): TNetworkHost;
    function AddNode(Name: string; Position: TPoint; InterfaceCount: Integer): TNetworkNode;
    function AddSwitch(Name: string; Position: TPoint; InterfaceCount: Integer): TNetworkSwitch;
    constructor Create;
    destructor Destroy; override;
    procedure Paint(Canvas: TCanvas);
  end;

function NetworkAddress(AParts: array of Integer): TNetworkAddress;


implementation

function NetworkAddress(AParts: array of Integer): TNetworkAddress;
var
  I: Integer;
begin
  SetLength(Result.Parts, Length(AParts));
  for I := 0 to High(Result.Parts) do
    Result.Parts[I] := AParts[I];
end;

{ TNetworkAddress }

class operator TNetworkAddress.Equal(A, B: TNetworkAddress): Boolean;
var
  I: Integer;
begin
  Result := Length(A.Parts) = Length(B.Parts);
  if Result then
  for I := 0 to Length(A.Parts) - 1 do
    Result := Result and (A.Parts[I] = B.Parts[I]);
end;

function TNetworkAddress.GetString: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Length(Parts) - 1 do begin
    if I > 0 then Result := Result + '.';
    Result := Result + IntToStr(Parts[I]);
  end;
end;

procedure TNetworkAddress.Clear;
begin
  SetLength(Parts, 0);
end;

{ TNetworkRouter }

procedure TNetworkRouter.ReceivePacket(Sender: TNetworkInterface;
  Packet: TNetworkPacket);
var
  I: Integer;
begin
  if Packet.Destination = Sender.Address then
    DoLog(Self, 'Received ' + Packet.Data + ' from ' + Packet.Source.GetString)
  else begin
    if Length(Packet.Destination.Parts) > Packet.Destination.Context then
    for I := 0 to Interfaces.Count - 1 do
    with Interfaces[I] do begin
      if Network = Packet.Destination.Parts[Packet.Destination.Context + 1] then begin
        //Inc
        //SendPacket(Packet);
        Break;
      end;
    end;
  end;
end;

{ TNetworkSwitch }

procedure TNetworkSwitch.ReceivePacket(Sender: TNetworkInterface; Packet: TNetworkPacket);
var
  I: Integer;
begin
  for I := 0 to Interfaces.Count - 1 do
    if Interfaces[I] <> Sender then
      Interfaces[I].SendPacket(Packet);
end;

constructor TNetworkSwitch.Create;
begin
  inherited Create;

end;

{ TNetwork }

function TNetwork.AddRouter(Name: string; Position: TPoint;
  InterfaceCount: Integer; Log: TLogEvent): TNetworkRouter;
var
  I: Integer;
begin
  Result := TNetworkRouter.Create;
  Result.Name := Name;
  Result.Position := Position;
  Result.OnLog := Log;
  for I := 0 to InterfaceCount - 1 do
    Result.AddInterface;
  Nodes.Add(Result);
end;

function TNetwork.AddHost(Name: string; Position: TPoint;
  InterfaceCount: Integer; Log: TLogEvent): TNetworkHost;
var
  I: Integer;
begin
  Result := TNetworkHost.Create;
  Result.Name := Name;
  Result.Position := Position;
  Result.OnLog := Log;
  for I := 0 to InterfaceCount - 1 do
    Result.AddInterface;
  Nodes.Add(Result);
end;

function TNetwork.AddNode(Name: string; Position: TPoint; InterfaceCount: Integer): TNetworkNode;
var
  I: Integer;
begin
  Result := TNetworkNode.Create;
  Result.Name := Name;
  Result.Position := Position;
  for I := 0 to InterfaceCount - 1 do
    Result.AddInterface;
  Nodes.Add(Result);
end;

function TNetwork.AddSwitch(Name: string; Position: TPoint; InterfaceCount: Integer
  ): TNetworkSwitch;
var
  I: Integer;
begin
  Result := TNetworkSwitch.Create;
  Result.Name := Name;
  Result.Position := Position;
  for I := 0 to InterfaceCount - 1 do
    Result.AddInterface;
  Nodes.Add(Result);
end;

constructor TNetwork.Create;
begin
  Nodes := TFPGObjectList<TNetworkNode>.Create;
end;

destructor TNetwork.Destroy;
begin
  Nodes.Free;
  inherited Destroy;
end;

procedure TNetwork.Paint(Canvas: TCanvas);
var
  I: Integer;
  J: Integer;
  RemoteInterface: TNetworkInterface;
  RemoteInterfaceIndex: Integer;
  RemoteNode: TNetworkNode;
const
  R = 30;
begin
  Canvas.Pen.Color := clRed;
  Canvas.Pen.Style := psSolid;

  for I := 0 to Nodes.Count - 1 do
  with TNetworkNode(Nodes[I]) do begin
    for J := 0 to Interfaces.Count - 1 do
      Canvas.Rectangle(Position.X - R * Interfaces.Count div 2 + J * R, Position.Y - R div 2,
        Position.X - R * Interfaces.Count div 2 + J * R + R, Position.Y + R div 2);
    Canvas.TextOut(Position.X - Canvas.TextWidth(Name) div 2, Position.Y + R div 2, Name);
  end;
  for I := 0 to Nodes.Count - 1 do
  with TNetworkNode(Nodes[I]) do begin
    for J := 0 to Interfaces.Count - 1 do
    if Assigned(Interfaces[J]) then begin
      if Assigned(Interfaces[J].Remote) then begin
        RemoteInterface := Interfaces[J].Remote;
        RemoteNode := RemoteInterface.Node;
        RemoteInterfaceIndex := RemoteNode.Interfaces.IndexOf(RemoteInterface);
        Canvas.Line(Position.X + J * R - R * Interfaces.Count div 2 + R div 2, Position.Y,
          RemoteInterface.Node.Position.X + RemoteInterfaceIndex * R - R *
          RemoteNode.Interfaces.Count div 2 + R div 2, RemoteNode.Position.Y);
      end;
    end;
  end;
  for I := 0 to Nodes.Count - 1 do
  with TNetworkNode(Nodes[I]) do begin
    for J := 0 to Interfaces.Count - 1 do
    if Assigned(Interfaces[J]) then begin
      //if Interfaces[J].Address > 0 then
      Canvas.TextOut(Position.X + J * R - R * Interfaces.Count div 2 + R div 2 - Canvas.TextWidth(Interfaces[J].Address.GetString) div 2,
        Position.Y - Canvas.TextHeight(Interfaces[J].Address.GetString) div 2,
        Interfaces[J].Address.GetString);
      //if Interfaces[J].Network > 0 then
      Canvas.TextOut(Position.X + J * R - R * Interfaces.Count div 2 + R div 2 - Canvas.TextWidth(IntToStr(Interfaces[J].Network)) div 2,
        Position.Y - R - Canvas.TextHeight(IntToStr(Interfaces[J].Network)) div 2,
        IntToStr(Interfaces[J].Network));
    end;
  end;
end;

{ TNetworkNode }

procedure TNetworkNode.ReceivePacket(Sender: TNetworkInterface; Packet: TNetworkPacket
  );
begin
end;

procedure TNetworkHost.ReceivePacket(Sender: TNetworkInterface;
  Packet: TNetworkPacket);
begin
  if Packet.Destination = Sender.Address then
    DoLog(Self, 'Received ' + Packet.Data + ' from ' + Packet.Source.GetString);
end;

procedure TNetworkHost.DoLog(Sender: TNetworkNode; Data: string);
begin
  if Assigned(FOnLog) then FOnLog(Sender, Data);
end;

procedure TNetworkHost.Ping(Address: TNetworkAddress);
var
  NewPacket: TNetworkPacket;
  UseInterface: TNetworkInterface;
begin
  UseInterface := TNetworkInterface(Interfaces[0]);
  NewPacket := TNetworkPacket.Create;
  NewPacket.Source := UseInterface.Address;
  NewPacket.Destination := Address;
  NewPacket.Data := 'ping';
  DoLog(Self, 'Sent ping to address ' + Address.GetString);
  UseInterface.SendPacket(NewPacket);
  NewPacket.Free;
end;

function TNetworkNode.AddInterface: TNetworkInterface;
begin
  Result := TNetworkInterface.Create;
  Result.Node := Self;
  Result.Address.Clear;
  Result.OnReceivePacket := ReceivePacket;
  Interfaces.Add(Result);
end;

constructor TNetworkNode.Create;
begin
  Interfaces := TFPGObjectList<TNetworkInterface>.Create;
end;

destructor TNetworkNode.Destroy;
begin
  Interfaces.Free;
  inherited Destroy;
end;

{ TNetworkInterface }

procedure TNetworkInterface.SetRemote(AValue: TNetworkInterface);
begin
  if FRemote = AValue then Exit;
  if Assigned(FRemote) then begin
    FRemote.FRemote := nil;
  end;
  if Assigned(AValue) then begin
    if Assigned(AValue.FRemote) then
      AValue.FRemote.FRemote := nil;
    AValue.FRemote := Self;
  end;
  FRemote := AValue;
end;

procedure TNetworkInterface.ReceivePacket(Packet: TNetworkPacket);
begin
  if Assigned(FOnReceivePacket) then
    FOnReceivePacket(Self, Packet);
end;

procedure TNetworkInterface.Connect(Remote: TNetworkInterface);
begin
  Self.Remote := Remote;
end;

procedure TNetworkInterface.Disconnet;
begin
  Remote := nil;
end;

function TNetworkInterface.GetConnected: Boolean;
begin
  Result := Assigned(FRemote);
end;

procedure TNetworkInterface.SendPacket(Packet: TNetworkPacket);
begin
  if Assigned(Remote) then Remote.ReceivePacket(Packet);
end;

constructor TNetworkInterface.Create;
begin
  FRemote := nil;
  Address.Clear;
end;

destructor TNetworkInterface.Destroy;
begin
  inherited Destroy;
end;

end.