unit SunriseChatNetworkCoreUnit;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, StdCtrls, ExtCtrls, SunriseChatCoreUtils, DateUtils, SunriseChatCoreUnit,
  cWindows, cSockets, cSocketsUDP, cTCPClient, cTCPServer, cUtils, WinSock,
  cWinSock, Registry, UEthernetAddress, IdUDPBase, IdUDPServer, IdUDPClient,
  IdBaseComponent, IdComponent, IdGlobal, IdSocketHandle, IdCustomTCPServer,
  IdTCPServer, IdTCPConnection, IdTCPClient, IdContext, IdAntiFreeze;

const
  DefaultUdpPort = 55557;
  BroadcastIPAddress = '255.255.255.255';

type
  TBroadcastType = (btLocal, btGlobal);

  TSunriseChatNetworkCore = class;

  TReadingThread = class(TThread)
  protected
    FConnection: TIdTCPConnection;
    FParent: TSunriseChatNetworkCore;
    procedure Execute; override;
  public
    constructor Create(AParent: TSunriseChatNetworkCore; AConnection: TIdTCPConnection); reintroduce;
  end;

  TNetworkInterface = class
  private
    FParent: TSunriseChatNetworkCore;
  public
    IPAddress: string;
    BroadcastIPAddress: string;
    SubNetMask: string;
    Name: string;
    DeviceName: string;
    GUID: string;
    procedure Select;
    constructor Create(Parent: TSunriseChatNetworkCore);
  end;

  TSunriseChatNetworkCore = class(TSunriseChatCore)
  private
    IdTCPServer1: TIdTCPServer;
    IdTCPClient1: TIdTCPClient;
    IdUDPServer1: TIdUDPServer;
    IdUDPClient1: TIdUDPClient;
    FConnected: Boolean;
    FOnChangeNetworkState: TClassMethod;
    FUdpPort: Word;
    FActive: Boolean;
    FBroadcastType: TBroadcastType;
    FActiveNetworkInterface: TNetworkInterface;
    FAutoReconnect: Boolean;
    FTimer2: TTimer;
    FReadingThread: TReadingThread;
    procedure Timer2Timer(Sender: TObject);
    function GetLocalIPAddress: string;
    procedure SetLocalIPAddress(const Value: string);
    procedure SetActive(const Value: Boolean);
    procedure StartNetwork;
    procedure StopNetwork;
    procedure SendCommandToNetwork(const S: string);
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure IdTCPClient1Disconnect(Sender: TObject);
    procedure SetAutoReconnect(const Value: Boolean);
    property OnSendCommand;
  public
    NetworkInterfaces: TList; // TList<TNetworkInterface>;
    constructor Create(AOwner: TComponent); override;
    function IPAddrToStr(Addr: Cardinal): string;
    function StrToIPAddr(Addr: string): Cardinal;
    procedure LoadNetworkInterfaceList;
    procedure SelectNetworkInterfaceByGUID(GUID: string);
    destructor Destroy; override;
    property ActiveNetworkInterface: TNetworkInterface read FActiveNetworkInterface;
  published
    property AutoReconnect: Boolean read FAutoReconnect write SetAutoReconnect;
    property BroadcastType: TBroadcastType read FBroadcastType write FBroadCastType;
    property Active: Boolean read FActive write SetActive;
    property UdpPort: Word read FUdpPort write FUdpPort;
    property OnChangeNetworkState: TClassMethod read FOnChangeNetworkState write FOnChangeNetworkState;
    property Connected: Boolean read FConnected;
  end;

procedure Register;

implementation

uses
  IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog, IdIOHandlerSocket;

procedure Register;
begin
  RegisterComponents('Chronosoft', [TSunriseChatNetworkCore]);
end;

{ TReadingThread }

constructor TReadingThread.Create(AParent: TSunriseChatNetworkCore;
  AConnection: TIdTCPConnection);
begin
  FConnection := AConnection;
  FParent := AParent;
  inherited Create(False);
end;

procedure TReadingThread.Execute;
var
  Text: string;
begin
  try
    while not Terminated and FConnection.Connected do
    begin
      Text := FConnection.IOHandler.Readln;
      //ProtocolMessageLogForm.Memo1.Lines.Add('TCPClientDataAvailable: ' + Data);
      FParent.ProcessCommand(Text);
    end;
  except
  end;
end;

{ TSunriseChatNetworkCore }

constructor TSunriseChatNetworkCore.Create(AOwner: TComponent);
begin
  inherited;
  NetworkInterfaces := TList.Create;
  IdTCPServer1 := TIdTCPServer.Create(Self);
  IdTCPServer1.OnExecute := IdTCPServer1Execute;
  IdTCPClient1 := TIdTCPClient.Create(Self);
  IdTCPClient1.OnDisconnected := IdTCPClient1Disconnect;
  IdTCPClient1.OnConnected := IdTCPClient1Connected;
  IdUDPServer1 := TIdUDPServer.Create(Self);
  IdUDPServer1.OnUDPRead := IdUDPServer1UDPRead;
  IdUDPClient1 := TIdUDPClient.Create(Self);
  FUdpPort := DefaultUdpPort;
  FActive := False;
  OnSendCommand := SendCommandToNetwork;
  LoadNetworkInterfaceList;
  LocalUser.Id.User := Application.Handle;
  FAutoReconnect := False;
end;

destructor TSunriseChatNetworkCore.Destroy;
var
  I: Integer;
begin
//  IdTCPClient1.OnDisconnected := nil;
  OnChangeNetworkState := nil;
  Active := False;
  for I := 0 to NetworkInterfaces.Count - 1 do
    TNetworkInterface(NetworkInterfaces[I]).Free;
  NetworkInterfaces.Free;
  IdTCPServer1.Destroy;
  IdTCPClient1.Destroy;
  IdUDPServer1.Destroy;
  IdUDPClient1.Destroy;
  inherited;
end;

procedure TSunriseChatNetworkCore.IdTCPClient1Connected(Sender: TObject);
begin
  FReadingThread := TReadingThread.Create(Self, IdTCPClient1);
  FReadingThread.FreeOnTerminate := True;
end;

procedure TSunriseChatNetworkCore.IdTCPClient1Disconnect(Sender: TObject);
begin
  FConnected := False;
  if Assigned(FOnChangeNetworkState) then FOnChangeNetworkState;
  if FActive and FAutoReconnect then begin
    StopNetwork;
    StartNetwork;
  end;
end;

procedure TSunriseChatNetworkCore.IdTCPServer1Execute(AContext: TIdContext);
var
  Text: string;
begin
  Text := AContext.Connection.IOHandler.ReadLn;
 (*
  if AContext.Connection.Connected then begin
    Text := ''; // AContext.Connection.IOHandler.AllData;
  *)
//  ProtocolMessageLogForm.Memo1.Lines.Add('TCPServerDataAvailable: ' + Text);
    if BroadcastType = btGlobal then
      IdUDPClient1.Broadcast(Text, UDPPort) else
      IdUDPClient1.Send(FActiveNetworkInterface.BroadcastIPAddress, UDPPort, Text);
//  end;
end;

procedure TSunriseChatNetworkCore.IdUDPServer1UDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle);
var
  Text: string;
  I: Integer;
  ClientList: TList;
begin
  SetLength(Text, Length(AData));
  for I := 0 to Length(AData) - 1 do
    Text[I + 1] := Chr(AData[I]);
  //ProtocolMessageLogForm.Memo1.Lines.Add('UDPServerDataAvailable: ' + Text);

  // Send data to all clients
  if FConnected then begin
    ClientList := IdTCPServer1.Contexts.LockList;
    try
      for I := 0 to ClientList.Count - 1 do
        TIdContext(ClientList.Items[I]).Connection.IOHandler.WriteLn(Text);
    finally
      IdTCPServer1.Contexts.UnlockList;
    end;
  end;
end;

function TSunriseChatNetworkCore.GetLocalIPAddress: string;
begin
  Result := IPAddrToStr(LocalUser.Id.Machine);
end;

function TSunriseChatNetworkCore.IPAddrToStr(Addr: Cardinal): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to 3 do Result := IntToStr(Byte(Addr shr (8*I))) + '.' + Result;
  Delete(Result, Length(Result), 1);
end;

procedure TSunriseChatNetworkCore.LoadNetworkInterfaceList;
var
  I, II: Integer;
  AdaptersList : array of IP_ADAPTER_INFO;
  BufSize: Cardinal;
  IPParts: TArrayOfString;
  SubnetParts: TArrayOfString;
  NewNetworkInterface: TNetworkInterface;

function IpListToStr(pIpAddr : PIP_ADDR_STRING) : String;
begin
  Result := '';
  repeat
    Result := Result + ', ' + Pchar(Addr(pIpAddr^.IpAddress));
    pIpAddr := pIpAddr.Next;
  until pIpAddr = nil;
  Delete(Result, 1, 2);
  if Result = '' then Result := 'none';
end;

begin
  for I := 0 to NetworkInterfaces.Count - 1 do
    TNetworkInterface(NetworkInterfaces[I]).Free;
  NetworkInterfaces.Clear;

  if Win32Platform > 1 then begin
    // Windows NT/2000/XP/Vista
    BufSize := 0;
    GetAdaptersInfo(@AdaptersList[0], BufSize);
    SetLength(AdaptersList, BufSize div SizeOf(IP_ADAPTER_INFO));
    GetAdaptersInfo(@AdaptersList[0], BufSize);
    for I := 0 to High(AdaptersList) do with AdaptersList[I] do begin
      if IpAddressList.IPAddress.S <> '' then begin
        NewNetworkInterface := TNetworkInterface.Create(Self);
        with NewNetworkInterface do begin
          IPAddress := IpAddressList.IPAddress.S;
          SubNetMask := IpAddressList.IPMask.s;
          GUID := AdapterName;
          Name := Description;
          if Name = '' then Name := 'Network adapter ' + IntToStr(I);
          SubnetParts := Explode('.', SubNetMask);
          IPParts := Explode('.', IPAddress);
          for II := 0 to 3 do
            IPParts[II] := IntToStr(StrToInt(IPParts[II]) or (StrToInt(SubnetParts[II]) xor $ff));
          BroadcastIPAddress := IPParts[0]+'.'+IPParts[1]+'.'+IPParts[2]+'.'+IPParts[3];
        end;
        NetworkInterfaces.Add(NewNetworkInterface);
      end;
    end;
  end else begin
    // Windows 95/98/Me
    for I := 0 to High(LocalIPAddressesStr) do begin
      NewNetworkInterface := TNetworkInterface.Create(Self);
      with NewNetworkInterface do begin
        IPAddress := LocalIPAddressesStr[I];
        Name := LocalIPAddressesStr[I];
        GUID := LocalIPAddressesStr[I];
      end;
      NetworkInterfaces.Add(NewNetworkInterface);
    end;
  end;
  if NetworkInterfaces.Count > 1 then
    TNetworkInterface(NetworkInterfaces[1]).Select
      else TNetworkInterface(NetworkInterfaces[0]).Select;
end;

procedure TSunriseChatNetworkCore.SelectNetworkInterfaceByGUID(
  GUID: string);
var
  I: Integer;
begin
  I := 0;
  while (I < NetworkInterfaces.Count) and (TNetworkInterface(NetworkInterfaces[I]).GUID <> GUID) do
    I := I + 1;
  if I >= NetworkInterfaces.Count then I := 0;
  TNetworkInterface(NetworkInterfaces[I]).Select;
end;

procedure TSunriseChatNetworkCore.SendCommandToNetwork(const S: string);
begin
  if FConnected then IdTCPClient1.IOHandler.WriteLn(S);
end;

procedure TSunriseChatNetworkCore.SetActive(const Value: Boolean);
begin
  if (not FActive) and Value then begin
    StartNetwork;
  end;
  if (FActive) and (not Value) then StopNetwork;
  FActive := Value;
  inherited SetActive(Value);
end;

procedure TSunriseChatNetworkCore.SetAutoReconnect(const Value: Boolean);
begin
  FAutoReconnect := Value;
  
end;

procedure TSunriseChatNetworkCore.SetLocalIPAddress(const Value: string);
begin
  LocalUser.Id.Machine := StrToIPAddr(Value);
end;

procedure TSunriseChatNetworkCore.StartNetwork;
var
  I, II: Integer;
  SocketBinding: TIdSocketHandle;
const
  Stav: array [0..6] of string = ('Closed', 'Resolving', 'Resolved', 'Connecting',
                  'Negotiating', 'Connected', 'Listening');
begin
  IdTCPClient1.OnDisconnected := nil;
  FConnected := False;
  try
    IdTCPClient1.Disconnect;
    with IdTCPServer1 do begin
      Active := False;
      SocketBinding := IdTCPServer1.Bindings.Add;
      SocketBinding.IP := IPAddrToStr(LocalUser.Id.Machine);
      SocketBinding.Port := UDPPort + 1;
      try
        Active := True;
      except
      end;
  //  ShowMessage(Stav[Integer(fndTCPServer1.Socket.State)]);
    end;
      IdUDPServer1.Active := False;
      SocketBinding := IdUDPServer1.Bindings.Add;
      SocketBinding.IP := IPAddrToStr(LocalUser.Id.Machine);
      SocketBinding.Port := UDPPort;
      IdUDPServer1.BroadcastEnabled := True;
      try
        IdUDPServer1.Active := True;
      except
      end;
      IdUDPClient1.Disconnect;
      IdUDPClient1.Host := FActiveNetworkInterface.BroadcastIPAddress;
      IdUDPClient1.Port := UdpPort;
      IdUDPClient1.BroadcastEnabled := True;
      try
        IdUDPClient1.Connect;
      except
      end;
    with IdTCPClient1 do begin
      Disconnect;
      Host := IPAddrToStr(LocalUser.Id.Machine); // 'localhost';
      Port := UDPPort + 1;
      BoundIP := IPAddrToStr(LocalUser.Id.Machine); //'localhost';
      Connect;
(*
      I := 2;
      repeat
        Disconnect;
        //BoundPort := UDPPort + I;
        I := I + 1;
        try
          Connect;
        except
        end;
        II := 0;
        while (not Connected and (II < 100)) do begin
          Application.ProcessMessages;
          Sleep(10);
          II := II + 1;
        end;
  //     ShowMessage(Stav[Integer(fndTCPClient1.Socket.State)]);
      until (Connected) or (I > 30); //or (fndTCPServer1.Socket.State = ssClosed);
*)
      FConnected := IdUDPServer1.Active and IdUDPClient1.Active and
        IdTCPServer1.Active and IdTCPClient1.Connected;
      //ShowMessage(IntToStr(Integer(fndTCPClient1.Socket.State))+','+BoolToStr(fndUDPClientSocket1.Bound)
      //+','+BoolToStr(FConnected)+','+BoolToStr(fndTCPClient1.Socket.Connected));
      if FConnected then begin
        SendCommand(scUserInfo);
        SendCommand(scConnect);
      end;
      if Assigned(FOnChangeNetworkState) then OnChangeNetworkState;
    end;
  finally
    IdTCPClient1.OnDisconnected := IdTCPClient1Disconnect;
  end;
end;

procedure TSunriseChatNetworkCore.StopNetwork;
begin
  FAutoReconnect := False;
  if IdTCPClient1.Connected then IdTCPClient1.Disconnect;
  IdTCPServer1.Active := False;
  IdUDPClient1.Active := False;
  IdUDPServer1.Active := False;
end;

function TSunriseChatNetworkCore.StrToIPAddr(Addr: string): Cardinal;
var
  Parts: TArrayOfString;
  I: Integer;
begin
  Result := 0;
  Parts := Explode('.', Addr);
  for I := 0 to 3 do Result := Result or (Byte(StrToInt(Parts[I])) shl (24-8*I));
end;

procedure TSunriseChatNetworkCore.Timer2Timer(Sender: TObject);
begin
  if not FConnected then StartNetwork;
end;

{ TNetworkInterface }

constructor TNetworkInterface.Create(Parent: TSunriseChatNetworkCore);
begin
  FParent := Parent;
end;

procedure TNetworkInterface.Select;
begin
  FParent.FActiveNetworkInterface := Self;
  FParent.LocalUser.Id.Machine := FPArent.StrToIPAddr(IPAddress);
  if FParent.FActive then begin
    FParent.Active := False;
    FParent.Active := True;
  end;
end;

end.