PHP DM Gate v0.9 » Корректное завершение работы TIdTCServer

Oltas © (16.05.11 10:03) [0]

Здесь находил вопросы по этому поводу, но решения в них не было... Если повтор или не нужно - удалите, пожалуйста...

Вот решение вопроса... Во всяком случае у меня работает.

Для самого компонента IdTcpServer нужно кинуть на форму еще элемент IdThreadMgrDefault1 и указать его в соответствующем пункте сервера в последней строке - TreadMgr.

Если после коннекта обращение клиента к серверу происходит в стандартной процедуре IdTCPServer1Executeвот так:
S:=Trim(AThread.Connection.ReadLn()); //где S:String;

то в момент, когда поток прерывается не по инициативе клиента, а аварийно, возникает исключение 10054Ю которое можно обработать тут же и перейти к процедуре уничтожения потока (у меня она: TcpServerTerminateAllThreads)

procedure TFServer.IdTCPServer1Execute(AThread: TIdPeerThread);
var
begin
if (AThread.Terminated) or (not AThread.Connection.Connected) then Exit;
try
S:=Trim(AThread.Connection.ReadLn());
except
if GetLastError=10054 then
begin
TcpServerTerminateAllThreads(AThread);
Exit;
end;
end;
end;

причем эта же процедура, если поток указать как nil будет работать для уничтожения всех потоков перед выключением сервера. Вот она:

procedure TFServer.TcpServerTerminateAllThreads(Tr: TIdThread);
var
I: Integer;
begin
if Tr = nil then
begin
with IdThreadMgrDefault1.ActiveThreads.LockList do
try
for I:=Count-1 downto 0 do
begin
Tr:=TIdThread(Items[I]);
Tr.Terminate;
Remove(Tr);
end;
finally
IdThreadMgrDefault1.ActiveThreads.UnLockList;
end;
end else
begin
with IdThreadMgrDefault1.ActiveThreads.LockList do
try
Tr.Terminate;
Remove(Tr);
finally
IdThreadMgrDefault1.ActiveThreads.UnLockList;
end;
end;
end;

У меня при выключении сервера эта процедура вызывается если не удалось штатно завершить работу сервера:

var
fServerRunning :Boolean; //глобальная переменная

function TFServer.StopServer: Boolean;
begin
try
try
IdTCPServer1.Active := False;
except
end;
finally
IdTCPServer1.Bindings.Clear;
Result := not IdTCPServer1.Active;
fServerRunning := not Result;
end;
end;

procedure TFServer.checkbox_ServerActiveClick(Sender: TObject);
var
StopedYes Label;
begin
if checkbox_ServerActive.Checked then
begin
//при включении
end else
begin
if not StopServer then
begin
TcpServerTerminateAllThreads(nil); //вызов процедуры уничтожения потоков (nil у меня значит всех)
//потом проверяем и еще раз пытаемся выключить сервер:
if not StopServer then
Memo1.Lines.Insert(0,'Ошибка остановки сервера'+DateTimeToStr(Now))
else Goto StopedYes;
end else
begin
StopedYes:
//если сервер отключился пишем об этом например в TMemo
Memo1.Lines.Insert(0,'Disconnect ### '+DateTimeToStr(Now));
end;
end;
end;

procedure TFServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TcpServerTerminateAllThreads(nil);
Sleep(1000);
if fServerRunning then checkbox_ServerActive.Checked:=False; //вызываем процедуру отключения сервера
end;

При закрытии сервера я вызываю процедуру уничтожения потоков заранее, так как у меня при штатном выключении есть попытка штатного завершения потоков путем отрубания клиентов (я посылаю им флаг, что они должны отрубиться сами и жду ока они отрубятся).

Многое взято из примера сервера Indy8. Пока все это работает и потоки уничтожаются и при аварийном отрубании клиента и при "насильственном" завершении потоков при выключении...

<Цитата>
Oltas © (16.05.11 20:03) [1]

Простите - не в форуме Сеть выложил...

<Цитата>