diff --git a/CATTcp.pas b/CATTcp.pas index d95a8f9..dd4df03 100644 --- a/CATTcp.pas +++ b/CATTcp.pas @@ -75,6 +75,7 @@ type FRunning: Boolean; FSendWelcome: Boolean; FLastError: string; + FStopEvent: TEvent; procedure ServerLoop; procedure PurgeLoop; @@ -291,6 +292,7 @@ begin FListenSock := SOCK_INVALID; FClients := TList.Create; FClientsLock := TCriticalSection.Create; + FStopEvent := TEvent.Create(nil, True, False, ''); FRunning := False; FSendWelcome := True; FLastError := ''; @@ -304,6 +306,7 @@ begin Stop; FClients.Free; FClientsLock.Free; + FStopEvent.Free; {$IFDEF MSWINDOWS} WSACleanup; {$ENDIF} @@ -376,12 +379,23 @@ begin if not FRunning then Exit; FRunning := False; + // Будим PurgeLoop немедленно, чтобы он не ждал 5 секунд + FStopEvent.SetEvent; + + // Закрываем listen socket — разблокирует fpAccept в ServerLoop if FListenSock <> SOCK_INVALID then begin SockShutdown(FListenSock); SockClose(FListenSock); FListenSock := SOCK_INVALID; end; + // Разрываем всех клиентов до ожидания потоков + FClientsLock.Acquire; + try + for i := 0 to FClients.Count-1 do + TCATTcpClientThread(FClients[i]).Disconnect; + finally FClientsLock.Release; end; + if Assigned(FServerThread) then begin FServerThread.Terminate; FServerThread.WaitFor; @@ -393,16 +407,18 @@ begin FreeAndNil(FPurgeThread); end; + // Теперь безопасно ждём завершения клиентских потоков и освобождаем FClientsLock.Acquire; try for i := 0 to FClients.Count-1 do begin cli := TCATTcpClientThread(FClients[i]); - cli.Disconnect; cli.WaitFor; cli.Free; end; FClients.Clear; finally FClientsLock.Release; end; + + FStopEvent.ResetEvent; end; procedure TCATTcpServer.ServerLoop; @@ -440,7 +456,7 @@ begin del := TList.Create; try while FRunning do begin - Sleep(5000); + if FStopEvent.WaitFor(5000) <> wrTimeout then Break; del.Clear; FClientsLock.Acquire; try