Serwer - sprawdzanie podłączenia.

I jak zwykle zacznę od kodu.

unit Server_Unit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ContNrs, SyncObjs,
  NewConnections, CheckDisconnects, SendRecvData, Clients;

type

  { TForm1 }

  TForm1 = class(TForm)
    bStart: TButton;
    bStop: TButton;
    bClose: TButton;
    eConsole: TEdit;
    eServerStatus: TEdit;
    lServerStatus: TLabel;
    mConsole: TMemo;
    procedure bCloseClick(Sender: TObject);
    procedure bStartClick(Sender: TObject);
    procedure bStopClick(Sender: TObject);
    procedure eConsoleKeyPress(Sender: TObject; var Key: char);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { private declarations }
    procedure ParseCommand(Cmd : String; var RealCmd, Par1, Par2 : String);
  public
    { public declarations }
    NewConnection   : TNewConnection;
    CheckDisconnect : TCheckDisconnect;
    SendRecvData    : TSendRecvData;
  end;

var
  Form1    : TForm1;
  Client   : TFPObjectList;
  CritSect : TCriticalSection;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.ParseCommand(Cmd : String; var RealCmd, Par1, Par2 : String);
var
  tmpCommand     : String;
  tmpPar1,
  tmpPar2        : String;
  CharNumber1,
  CharNumber2, i : Word;
Begin
  tmpCommand := '';
  tmpPar1 := '';
  tmpPar2 := '';
  CharNumber1 := 0;
  CharNumber2 := 0;
  for i := 1 to Length(cmd) do
    if cmd[i] <> ' ' then
      tmpCommand := tmpCommand + UpCase(cmd[i])
    else
    begin
      CharNumber1 := i;
      break;
    end;
  If CharNumber1 > 0 then
    for i := CharNumber1 + 1 to Length(cmd) do
      if cmd[i] <> ' ' then
        tmpPar1 := tmpPar1 + UpCase(cmd[i])
      else
      begin
        CharNumber2 := i;
        break;
      end;
  If CharNumber2 > 0 then
    for i := CharNumber2 + 1 to Length(cmd) do
      tmpPar2 := tmpPar2 + UpCase(cmd[i]);
  Par1 := tmpPar1;
  Par2 := tmpPar2;
  RealCmd := tmpCommand;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  bStart.Left := 10;
  bStart.Top := 10;

  bStop.Left := bStart.Left;
  bStop.Top := BStart.Height + 10;

  lServerStatus.Left := bStop.Left;
  lServerStatus.Top := bStop.Top + bStop.Height + 5;

  eServerStatus.Left := lServerStatus.Left;
  eServerStatus.Top := lServerStatus.Top + lServerStatus.Height + 5;

  bClose.Left := eServerStatus.Left;
  bClose.Top := Form1.Height - bClose.Height - 10;

  mConsole.Left := Form1.Width div 2;
  mConsole.Top := 0;
  mConsole.Width := Form1.Width div 2 - 5;
  mConsole.Height := Form1.Height - eConsole.Height - 10;

  eConsole.Left := mConsole.Left;
  eConsole.Top := 5 + mConsole.Height;
  eConsole.Width := mConsole.Width;
end;

procedure TForm1.bCloseClick(Sender: TObject);
begin
  if bStop.enabled then bStop.Click;
  Form1.Close;
end;

procedure TForm1.bStartClick(Sender: TObject);
begin
  eServerStatus.Text := 'Starting server...';

  NewConnection.Resume;

  bStart.Enabled := false;
  bStop.Enabled := true;

  eServerStatus.Text := 'Server running...';
end;

procedure TForm1.bStopClick(Sender: TObject);
var
  i : LongInt;
begin
  eServerStatus.Text := 'Stopping Server...';

  if Client.Count > 0 then
    for i := 0 to Client.Count - 1 do
      TClient(Client[i]).Send('disconnect');
  NewConnection.Suspend;

  bStart.Enabled := true;
  bStop.Enabled := false;

  eServerStatus.Text := 'STOPPED';
end;

procedure TForm1.eConsoleKeyPress(Sender: TObject; var Key: char);
var
  Command, Param1, Param2 : String;
  i                       : LongInt;
begin
  if key = #13 then
  begin
    Command := '';
    Param1 := '';
    Param2 := '';
    ParseCommand(eConsole.Text,Command,Param1,Param2);
    if command = 'CONNECTED' then
      mConsole.Lines.Add(DateTimeToStr(now) + ' Connected clients: ' + IntToStr(Client.Count))
    else if command = 'SEND' then
    begin
      if Client.Count > 0 then
      begin
        i := 0;
        while not (i > Client.Count - 1) do
        begin
          if TClient(Client[i]).ID = Param1 then
            TClient(Client[i]).Send(Param2);
          Inc(i);
        end;
      end;
    end;
    eConsole.Text := '';
  end
 end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Client := TFPObjectList.Create;
  CritSect := TCriticalSection.Create;

  NewConnection := TNewConnection.Create(true);
  CheckDisconnect := TCheckDisconnect.Create(false);
  SendRecvData := TSendRecvData.Create(false);

  bStop.Enabled := false;

  eServerStatus.Text := 'STOPPED';
end;

end.

unit Clients;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils, BlckSock, SynSock;

{==============================================================================}

type
  TClient = Class
    private
      fID        : String;
      fSocket    : TTCPBlockSocket;
      fConnected : Boolean;
    public
      constructor Create(ID : String; sock : TSocket);
      function Connected : Boolean;
      function ID : String;
      procedure Send(Data : String);
      function Recv : String;
      destructor Destroy;
  end;

{==============================================================================}

implementation

{==============================================================================}

constructor TClient.Create(ID : String; sock : TSocket);
begin
  fSocket := TTCPBlockSocket.Create;
  fSocket.Socket := sock;
  fID := ID;
  fConnected := true;
  fSocket.SendString(ID+CRLF);
end;

{------------------------------------------------------------------------------}

function TClient.Connected : boolean;
begin
  result := fConnected;
end;

{------------------------------------------------------------------------------}

function TClient.ID : String;
begin
  result := fID;
end;

{------------------------------------------------------------------------------}

procedure TClient.Send(Data : String);
begin
  fSocket.SendString(Data+CRLF);
end;

{------------------------------------------------------------------------------}

function TClient.Recv : String;
var
  tmpData      : String;
  TimeoutCount : Byte;
begin
  TimeoutCount := 0;
  repeat
    tmpData := fSocket.RecvString(2000);
    if fSocket.Lasterror <> 0 then
      Inc(TimeoutCount);
  until (tmpData <> '') or (TimeoutCount >= 5);
  if Timeoutcount >= 5 then
    fConnected := false;
  result := tmpData;
end;

{------------------------------------------------------------------------------}

destructor TClient.Destroy;
begin
  fConnected := false;
  fID := '';
  FreeAndNil(fSocket);
  inherited Destroy;
end;

{==============================================================================}
end.

unit NewConnections;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils, BlckSock, SynSock, Clients;

{==============================================================================}

type
  TNewConnection = class(TThread)
  private
    fListeningSocket : TTCPBlockSocket;
    fMessage         : String;

    procedure ShowMessage;
    function SetID : String;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended : boolean);
  end;

{==============================================================================}

implementation

{==============================================================================}

uses
  Server_Unit;

{==============================================================================}

constructor TNewConnection.Create(CreateSuspended : boolean);
begin
  FreeOnTerminate := True;
  fListeningSocket := TTCPBlockSocket.Create;
  fListeningSocket.Bind('127.0.0.1','1234');
  fListeningSocket.Listen;
  fMessage := '';
  inherited Create(CreateSuspended);
end;

{------------------------------------------------------------------------------}

procedure TNewConnection.ShowMessage;
begin
  Form1.mConsole.Lines.Add(fMessage);
end;

{------------------------------------------------------------------------------}

function TNewConnection.SetID : String;
var
  Year, Month, Day, Hour, min, sec, msec : Word;
  tmpID : String;
begin
  DecodeDate(Date,Year,Month,Day);
  DecodeTime(Time,Hour,Min,Sec,MSec);
  tmpID := IntToStr(Year) + IntToStr(Month) + IntToStr(Day) + IntToStr(Hour) + IntToStr(min) + IntToStr(sec) + IntToStr(msec) + IntToStr(Client.Count);
  result := tmpID;
end;

{------------------------------------------------------------------------------}

procedure TNewConnection.Execute;
var
  tmpID     : String;
  tmpSocket : TSocket;
  tmpClient : TClient;
begin
  repeat
    if fListeningSocket.CanRead(1) then
    begin
      tmpID := SetID;
      tmpSocket := fListeningSocket.Accept;
      tmpClient := TClient.Create(tmpID,tmpSocket);
      CritSect.Enter;
      try
        Client.Add(tmpClient);
      finally
        CritSect.Leave;
      end;
      fMessage := DateTimeToStr(now) + ' Client connected. ID: ' + tmpID;
      Synchronize(@ShowMessage);
    end;
  until Terminated;
end;

{==============================================================================}
end.

unit CheckDisconnects;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils, Clients;

{==============================================================================}

type
  TCheckDisconnect = class(TThread)
  private
    fMessage : String;

    procedure ShowMessage;

  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended : boolean);
  end;

{==============================================================================}

implementation

{==============================================================================}

uses Server_Unit;

{==============================================================================}

constructor TCheckDisconnect.Create(CreateSuspended : boolean);
begin
  FreeOnTerminate := True;
  fMessage := '';
  inherited Create(CreateSuspended);
end;

{------------------------------------------------------------------------------}

procedure TCheckDisconnect.ShowMessage;
begin
  Form1.mConsole.Lines.Add(fMessage);
end;

{------------------------------------------------------------------------------}

procedure TCheckDisconnect.Execute;
var
  i         : LongInt;
  Connected : Boolean;
begin
  repeat
    i := 0;
    if Client.Count > 0 then
    begin
      while not (i > Client.Count - 1) do
      begin
        CritSect.Enter;
        try
          Connected := TClient(Client[i]).Connected;
        finally
          CritSect.Leave;
        end;
        if not Connected then
        begin
          CritSect.Enter;
          try
            Client.Delete(i);
          finally
            CritSect.Leave;
            fMessage := DateTimeToStr(now) + ' Client disconnected';
            Synchronize(@ShowMessage);
          end;
        end;
        Inc(i);
      end;
    end;
    Sleep(1); // <- Zwiększyć wartość?
  until Terminated;
end;

{==============================================================================}

end.

unit SendRecvData;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils, Clients;

{==============================================================================}

type
  TSendRecvData = class(TThread)
  private
    fMessage : String;

    procedure ShowMessage;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended : boolean);
  end;

{==============================================================================}

implementation

{==============================================================================}

uses Server_Unit;

{==============================================================================}

constructor TSendRecvData.Create(CreateSuspended : boolean);
begin
  FreeOnTerminate := True;
  fMessage := '';
  inherited Create(CreateSuspended);
end;

{------------------------------------------------------------------------------}

procedure TSendRecvData.ShowMessage;
begin
  Form1.mConsole.Lines.Add(fMessage);
end;

{------------------------------------------------------------------------------}

procedure TSendRecvData.Execute;
var
  tmpData : String;
  i       : LongInt;
begin
  repeat
    i := 0;
    if Client.Count > 0 then
    begin
      while not (i > Client.Count - 1) do
      begin
        TClient(Client[i]).Send('ping');
        tmpData := TClient(Client[i]).Recv;
        Inc(i);
      end;
    end;
    Sleep(1); // <- Zwiększyć wartość?
  until Terminated;
end;

{==============================================================================}
end.

Mam problem, że jak podłączy mi się załóżmy 10 klientów i potem będą się po kolei odłączać to nie są usuwane na bieżąco. W sensie odłączy się pierwszy to serwer to zarejestruje, odłączy się drugi to serwer również to zarejestruje ale jak odłączy się trzeci to serwer tego nie rejestruje i mi wisi taki klient zombie. Jednak gdy odłączy się czwarty klient to serwer zarejestruje odłączenie trzeciego i czwartego jednocześnie. W ostatecznym bilansie wszyscy podłączeni się odłączą jednak jak rozwiązać problem by serwer rejestrował odłączenie klienta w chwili gdy klient rzeczywiście się odłączy?

I pytanie numer dwa. W kodzie zaznaczyłem linijki z instrukcjami Sleep(1). Czy zwiększenie tego czasu ma sens? Bo według mnie ma gdyż akurat te dwa wątki są odpowiedzialne w tym momencie za sprawdzenie czy dany klient odpowiada i ewentualne rozłączenie jeśli nie odpowiada, więc nie musi to być sprawdzane stale a może być sprawdzane na przykład co minutę.