Prevent TIdTcpServer Stuck Connections - sockets

Question

how are you?
I come here ask for a solution, how prevent TIdTcpServer stuck connections?
Version of indy 10.6.2.5341 and Rad Studio 10.1 Berlin
On both images show the number of connections on TIdTcpServer, these numbers are retrieved from this function:
var
NumClients: Integer;
begin
with Form1.IdTCPServer1.Contexts.LockList do
try
NumClients := Count;
finally
Form1.IdTCPServer1.Contexts.UnlockList;
end;
Result := NumClients;
What happen is, in almost cases this numbers only increase and not decrease. so i believe connections are being stucked on TIdTcpServer.
I use a IdSchedulerOfThreadDefault1 on Scheduler, i don't know if that change something or no but i added.
For manage connections i use ContextClass:
IdTCPServer1.ContextClass := TClientContext;
Who definition is:
type
TCommand = (
cmdConnect,
cmdDisconnect,
cmdHWID,
cmdScreenShotData,
cmdMensagem);
type
TClient = record
HWID : String[40];
Tempo : TDateTime;
Msg : String[100];
end;
const
szClient = SizeOf(TClient);
type
TProtocol = record
Command: TCommand;
Sender: TClient;
DataSize: Integer;
end;
const
szProtocol = SizeOf(TProtocol);
type
TClientContext = class(TIdServerContext)
private
FCriticalSection : TCriticalSection;
FClient : TClient;
public
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
public
procedure Lock;
procedure Unlock;
public
property Client: TClient read FClient write FClient;
end;
Others functions who are used:
procedure InitProtocol(var AProtocol: TProtocol);
begin
FillChar(AProtocol, szProtocol, 0);
end;
function ProtocolToBytes(const AProtocol: TProtocol): TBytes;
begin
SetLength(Result, szProtocol);
Move(AProtocol, Result[0], szProtocol);
end;
constructor TClientContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited Create(AConnection, AYarn, AList);
FCriticalSection := TCriticalSection.Create;
end;
destructor TClientContext.Destroy;
begin
FreeAndNil(FCriticalSection);
inherited;
end;
procedure TClientContext.Lock;
begin
FCriticalSection.Enter;
end;
procedure TClientContext.Unlock;
begin
FCriticalSection.Leave;
end;
function BytesToProtocol(const ABytes: TBytes): TProtocol;
begin
Move(ABytes[0], Result, szProtocol);
end;
procedure ClearBuffer(var ABuffer: TBytes);
begin
SetLength(ABuffer, 0);
end;
procedure ClearBufferId(var ABuffer: TIdBytes);
begin
SetLength(ABuffer, 0);
end;
All events (connect/disconnect) i manage on IdTCPServer1Execute
like this example above:
type
PTBytes = ^TBytes;
PTIdBytes = ^TIdBytes;
var
LBuffer : TIdBytes;
LProtocol : TProtocol;
FTempBuffer : TIdBytes;
Enviar : TBytes;
Protocolo : TProtocol;
Conexao : TClientContext;
//
Queue: TStringList;
List: TStringList;
x : Integer;
//
procedure AddToMemo(const AStr: string);
begin
TThread.Synchronize(nil,
procedure
begin
Memo1.Lines.Add(AStr);
Form1.StatusBar1.Panels[0].Text := Format('Connections [%d]', [RetornaOn]);
end
);
end;
begin
Conexao := TClientContext(AContext);
// QUEUE
List := nil;
try
Queue := Conexao.Queue.Lock;
try
if Queue.Count > 0 then
begin
List := TStringList.Create;
List.Assign(Queue);
Queue.Clear;
end;
finally
Conexao.Queue.Unlock;
end;
if List <> nil then
begin
for x := 0 to List.Count-1 do
begin
InitProtocol(Protocolo);
Protocolo.Command := cmdMensagem;
Protocolo.Sender.Msg := Edit2.Text;
Enviar := ProtocolToBytes(Protocolo);
Conexao.Connection.IOHandler.Write(PTIdBytes(#Enviar)^);
ClearBuffer(Enviar);
end;
// Delete Queue
for x := 0 to List.Count-1 do
begin
List.Delete(x);
end;
end;
finally
List.Free;
end;
// QUEUE
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
//AddToMemo(Format('[%s] Running 1 ...', [TimeToStr(Now)]));
AContext.Connection.IOHandler.CheckForDataOnSource(100);
AContext.Connection.IOHandler.CheckForDisconnect;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
{AddToMemo(Format('[%s] Running 2 ...', [TimeToStr(Now)]));
if GetTickDiff(Conexao.Client.Tick, Ticks) >= 10000 then
begin
AddToMemo(Format('[%s] Running 3 [%d] ...', [TimeToStr(Now), Conexao.Client.Tick]));
AContext.Connection.Disconnect;
Exit;
end;}
Exit;
end;
end;
AContext.Connection.IOHandler.ReadBytes(LBuffer, szProtocol, False);
LProtocol := BytesToProtocol(PTBytes(#LBuffer)^);
case LProtocol.Command of
cmdConnect: begin
Conexao.Client := LProtocol.Sender;
Conexao.FClient.Tick := Ticks;
AddToMemo(Format('[%s] : [%s][%s]', ['Connect', AContext.Connection.Socket.Binding.PeerIP, Protocolo.Sender.HWID]));
end;
cmdMensagem: begin
AddToMemo(Format('[%s] : [%s][%s][%s]', ['Msg', AContext.Connection.Socket.Binding.PeerIP, Conexao.Client.HWID, LProtocol.Sender.Msg]));
end;
cmdDisconnect: begin
AddToMemo(Format('[%s] : [%s][%s]', ['Disconnect', AContext.Connection.Socket.Binding.PeerIP, Conexao.Client.HWID]));
end;
end;
In next code i show how client side connect to TIdTcpServer:
type
PTIdBytes = ^TIdBytes;
var
LBuffer : TBytes;
LProtocol : TProtocol;
begin
ClientThread := TClientThread.Create(False);
InitProtocol(LProtocol);
LProtocol.Command := cmdConnect;
LProtocol.Sender.HWID := Edit1.Text;
LProtocol.Sender.Tempo := Now;
LBuffer := ProtocolToBytes(LProtocol);
IdTCPClient1.IOHandler.Write(PTIdBytes(#LBuffer)^);
ClearBuffer(LBuffer);
AddToMemo('IdTCPClient1 connected to server');
ClientThread on client:
procedure TClientThread.Execute;
type
PTBytes = ^TBytes;
PTIdBytes = ^TIdBytes;
var
LBuffer : TIdBytes;
LDataSize : Integer;
LProtocol : TProtocol;
procedure AddToMemo(const AStr: string);
begin
TThread.Synchronize(nil,
procedure
begin
Form1.Memo1.Lines.Add('Received From Server: ' + AStr);
end
);
end;
begin
inherited;
while NOT Terminated and Form1.IdTCPClient1.Connected do begin
//LDataSize := Form1.IdTCPClient1.IOHandler.InputBuffer.Size;
//if LDataSize >= szProtocol then begin
try
Form1.IdTCPClient1.IOHandler.ReadBytes(LBuffer, szProtocol);
LProtocol := BytesToProtocol(PTBytes(#LBuffer)^);
case LProtocol.Command of
cmdHWID:
begin
HWID := LProtocol.Sender.HWID;
AddToMemo('HWID > ' + LProtocol.Sender.HWID);
end;
cmdDisconnect:
begin
AddToMemo('DC > ' + LProtocol.Sender.HWID);
end;
cmdMensagem:
begin
AddToMemo('MSG > ' + LProtocol.Sender.Msg);
end;
end;
finally
ClearBufferId(LBuffer);
end;
//end;
Sleep(50);
end;
end;
Anybody know why these connections are being stucked on TIdTcpServer?
Maybe if i loop all conenctions and try send a single text will disconnect they if don't are really connected to IdTcpServer no ?
Thanks.