Приветствую уважаемых форумчан. Имеется самописный сервер, всё отлично принимает, обслуживает клиентов. При этом клиенты писаны на ActiveScript 3 и используют флешовые сокеты. Однако периодически, когда клиент отключается, остаётся висеть зомби коннект в состоянии CLOSE_WAIT. На данный момент обсулживание клиента выглядит так:
| Код |
procedure TTCPServer.ClientThread;
var
ID: NativeUInt;
Error, BytesTransferred: Cardinal;
pOvr: POverlapped;
pOper: PTCPOperation;
begin
while not FThreadPoolAborted do
begin
ID := 0;
BytesTransferred := 0;
if not GetQueuedCompletionStatus(FCompletionPort, BytesTransferred, ID,
POverlapped(pOvr), 250) then
begin
Error := GetLastError;
if (Error = WAIT_TIMEOUT) or (ID = 0) then
Continue;
end;
// Клиент отключился
if (BytesTransferred = 0) and (pOvr = nil) then
begin
if pOvr <> nil then
OperationDestroy(pOvr, True);
Disconnect(ID);
Continue;
end;
if pOvr <> nil then
begin
pOper := Pointer(pOvr^.Offset);
case pOper^.OperationType of
ServerOperationRecv: // Приём
begin
InterlockedDecrement(FOperationsPending);
if BytesTransferred > 0 then
DataReceived(ID, pOper^.Buffer.Buf, BytesTransferred);
try
if ID and $FFFFF000 <> 0 then
Exit;
ReceiveDataPending(pOvr);
except
OperationDestroy(pOvr, True);
Disconnect(ID);
end;
end;
ServerOperationSend:
begin
InterlockedDecrement(FOperationsPending);
pOper^.Success := BytesTransferred = pOper^.Buffer.len;
// Отправитель ожидает результат?
if pOper^.OperationDone <> 0 then
begin
SetEvent(pOper^.OperationDone);
WaitForSingleObject(pOper^.ReadyToDestroy, INFINITE);
end;
if pOper^.Success then
DataSended(ID, pOper^.Buffer.Buf, BytesTransferred)
else
Disconnect(ID);
OperationDestroy(pOvr, True);
end;
end;
end;
Sleep(10);
end;
InterlockedDecrement(FActiveThreadsCount);
end;
|
Структура TCPOperation:
| Код |
PTCPOperation = ^TTCPOperation;
TTCPOperation = record
OperationType: Integer;
Socket: TSocket;
Buffer: WSABUF;
Success: Boolean;
OperationDone: THandle;
ReadyToDestroy: THandle;
end;
|
Disconnect:
| Код |
procedure TTCPServer.Disconnect(ID: Integer; FlushData: Boolean);
var
Conn: TTCPConnection;
begin
Lock('Disconnect');
try
try
Conn := FConnections.ItemByID(ID);
if Conn = nil then
Exit;
FConnections.Remove(Conn);
except
on E: Exception do
raise Exception.Create('TTCPServer.Disconnet');
end;
finally
if Conn <> nil then
begin
uWinSock2.shutdown(Conn.Socket, SD_BOTH);
ClientDisconnected(Conn);
Conn.Free;
end;
Unlock('Disconnect');
end;
end;
|
Деструктор коннекта:
| Код |
destructor TTCPConnection.Destroy;
begin
Self.CloseSocket;
if FBuffer <> nil then
FBuffer.Free;
inherited;
end;
procedure TTCPConnection.CloseSocket;
begin
if FSocket <> INVALID_SOCKET then
begin
uWinSock2.closesocket(FSocket);
FSocket := INVALID_SOCKET;
end;
end
|
Собственно вопрос заключается в том, что я делаю неправильно при отключении клиента, что остаётся висеть зомби процесс, и как сделать правильно, чтобы оных не оставалось? |