From 73ee25071d4922d336dd4c1810d5415271b58729 Mon Sep 17 00:00:00 2001
From: Yuri Serebrennikov <yus.serebrennikov@gmail.com>
Date: Sat, 10 Aug 2024 01:30:55 +0300
Subject: [PATCH] Fixed work in ThreadMode := wtmNone mode.

---
 .../fcl-web/src/websocket/fpcustwsserver.pp   | 20 +++++++++----------
 packages/fcl-web/src/websocket/fpwebsocket.pp |  5 +----
 .../src/websocket/fpwebsocketserver.pp        |  3 ---
 3 files changed, 10 insertions(+), 18 deletions(-)

diff --git a/packages/fcl-web/src/websocket/fpcustwsserver.pp b/packages/fcl-web/src/websocket/fpcustwsserver.pp
index dfb27008e6..655735bd5d 100644
--- a/packages/fcl-web/src/websocket/fpcustwsserver.pp
+++ b/packages/fcl-web/src/websocket/fpcustwsserver.pp
@@ -444,14 +444,16 @@ Var
   L : TList;
   aContinue : Boolean;
   I : Integer;
-
 begin
   aContinue:=True;
   L:=Connections.LockList;
   try
     For I:=L.Count-1 downto 0 do
-      if aContinue then
-        aIterator(TWSServerConnection(L[i]),aContinue);
+      begin
+        aIterator(TWSServerConnection(L[i]), aContinue);
+        if not aContinue then
+          RemoveConnection(TWSServerConnection(L[i]), True);
+      end;
   finally
     Connections.UnlockList;
   end;
@@ -633,13 +635,12 @@ end;
 
 procedure TWSServerConnectionHandler.DoCheckConnectionRequests(aConnection: TWSServerConnection; var aContinue: boolean);
 begin
-  aConnection.CheckIncoming(WaitTime,True);
-  aContinue:=True;
+  aContinue := aConnection.CheckIncoming(WaitTime, True) <> irClose;
 end;
 
 procedure TWSServerConnectionHandler.RemoveConnection(aConnection: TWSServerConnection);
 begin
-  FServer.RemoveConnection(aConnection,True);
+  FServer.RemoveConnection(aConnection, True);
 end;
 
 procedure TWSServerConnectionHandler.HandleError(aConnection : TWSServerConnection; E: Exception);
@@ -700,7 +701,6 @@ begin
 end;
 
 procedure TWSThreadedConnectionHandler.TWSConnectionThread.Execute;
-
 begin
   try
     // Always handle first request
@@ -711,7 +711,7 @@ begin
         Terminate;
       end;
     While not Terminated do
-      if Connection.CheckIncoming(10)=irClose then
+      if Connection.CheckIncoming(WaitTime) = irClose then
       begin
         // answer for client about close connection
         if not (Connection.CloseState = csClosed) then
@@ -827,15 +827,13 @@ begin
 end;
 
 procedure TWSPooledConnectionHandler.ConnectionDone(Sender: TObject);
-
 var
   aTask : THandleRequestTask absolute Sender;
   aConn : TWSServerConnection;
-
 begin
   aConn:=aTask.Connection;
   FBusy.Remove(aConn);
-  if aConn.CheckIncoming(10)=irClose then
+  if aConn.CheckIncoming(WaitTime) = irClose then
     RemoveConnection(aConn);
 end;
 
diff --git a/packages/fcl-web/src/websocket/fpwebsocket.pp b/packages/fcl-web/src/websocket/fpwebsocket.pp
index fe963e6154..867ba5b5fb 100644
--- a/packages/fcl-web/src/websocket/fpwebsocket.pp
+++ b/packages/fcl-web/src/websocket/fpwebsocket.pp
@@ -354,7 +354,7 @@ type
     // read & process incoming message. Return nil if connection was close.
     function ReadMessage: Boolean;
     // Disconnect
-    Procedure Disconnect;
+    Procedure Disconnect; inline;
     // Descendents can override this to provide custom frames
     Function FrameClass : TWSFrameClass; virtual;
     // Send raw frame. No checking is done !
@@ -1602,8 +1602,6 @@ end;
 procedure TWSConnection.Disconnect;
 begin
   DoDisconnect;
-  if Assigned(FOnDisconnect) then
-    FOnDisconnect(Self);
 end;
 
 procedure TWSConnection.Close(aData: TBytes);
@@ -1664,7 +1662,6 @@ begin
 end;
 
 function TWSConnection.CheckIncoming(aTimeout: Integer; DoRead: Boolean = True): TIncomingResult;
-
 begin
   if not Transport.CanRead(aTimeOut) then
     Result:=irNone
diff --git a/packages/fcl-web/src/websocket/fpwebsocketserver.pp b/packages/fcl-web/src/websocket/fpwebsocketserver.pp
index 87864adc80..e51d063f4c 100644
--- a/packages/fcl-web/src/websocket/fpwebsocketserver.pp
+++ b/packages/fcl-web/src/websocket/fpwebsocketserver.pp
@@ -150,7 +150,6 @@ begin
 end;
 
 procedure TAcceptThread.Execute;
-
 begin
   FServer.StartAccepting;
 end;
@@ -357,14 +356,12 @@ begin
 end;
 
 procedure TWebSocketServer.StartAccepting;
-
 begin
   FActive:=True;
   FServer.StartAccepting;
 end;
 
 procedure TWebSocketServer.StartServer;
-
 begin
   StartConnectionHandler;
   CreateServerSocket;