mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 08:30:54 +02:00
Fixed work in ThreadMode := wtmNone mode.
This commit is contained in:
parent
0366df9fbd
commit
73ee25071d
@ -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;
|
||||
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user