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ę.
Lazarus