При падении - вот как выглядит стек:
TTCPServerBuffered.disconnet:
| Код |
procedure TTCPServerBuffered.Disconnect(ID: Integer; FlushData: Boolean);
var
Conn: TTCPConnection;
begin
if FlushData then
repeat
Lock('Disconnect');
try
try
Conn := FConnections.ItemByID(ID);
if (Conn = nil) or (not Conn.Sending) then Break;
except
on E: Exception do
raise;
end;
finally
Unlock('Disconnect');
end;
Sleep(10);
until False;
inherited;
end;
|
А ClientThread:
| Код |
procedure TTCPServer.ClientThread;
var
{$IfDef DELPHI_XE_UP}
ID: NativeUInt;
{$Else}
ID: NativeUInt;
{$EndIf}
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) or (pOvr = nil) then
begin
if pOvr <> nil then
OperationDestroy(pOvr, True);
Disconnect(ID);
Continue;
end;
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;
InterlockedDecrement(FActiveThreadsCount);
end;
|
|
