Читаем Delphi. Трюки и эффекты полностью

Процедура, приведенная в листинге 11.14, находит и помечает как занятую для нового пользователя запись в массиве clients. Если свободных записей в массиве не осталось, то достигнуто максимальное количество пользователей.

...

Добавление информации о новом клиенте

function AddClient(Connection: TIdTCPServerConnection): Boolean;

var

i: Integer;

begin

section.Enter;

for i:=1 to MAX_CLIENT do

begin

if (not clients[i].fUsed) then

begin

//Нашли свободную запись – заполним ее

//(клиент пока безымянный)

clients[i].fUsed := True;

clients[i].Connection := Connection;

clients[i].strIP := Connection.Socket.Binding.PeerIP;

AddClient := True;

section.Leave;

Exit;

end;

end;

section.Leave;

AddClient := False;

end;

Процедура DeleteClient, приведенная в листинге 11.15, освобождает запись заданного пользователя в массиве clients.

...

function DeleteClient(Connection: TIdTCPServerConnection):client;

var

i: Integer;

begin

section.Enter;

for i:=1 to MAX_CLIENT do

if (clients[i].fUsed) then

if (clients[i].Connection = Connection) then

begin

//Вот она – запись о нужном клиенте

clients[i].fUsed := False;

clients[i].fNamed := False;

clients[i].Connection := Nil;

DeleteClient := clients[i];

clients[i].strName := \'\

clients[i].strIP := \'\

section.Leave;

Exit;

end;

end;

Процедура SendClientList, приведенная в листинге 11.16, отправляет клиентской программе заданного пользователя (только что зарегистрировавшегося) сообщения addclient: с именем каждого зарегистрированного ранее пользователя.

...

Посылка списка всех присоединенных клиентов

procedure SendClientList(Connection: TIdTCPServerConnection);

var

i: Integer;

begin

for i:= 1 to MAX_CLIENT do

if (clients[i].fNamed) then

if (clients[i].Connection <> Connection) then

try

//Сообщим имя очередного найденного пользователя

Connection.WriteLn(\'adduser:\' + clients[i].strName);

except

//При возникновении ошибки отключим клиента

//и продолжим рассылку

ErrorCloseConnection(clients[i].Connection);

end;

end;

Процедура ErrorCloseConnection (листинг 11.17) вызывается при ошибке отправки сообщений пользователям (например, при нарушении сетевого соединения). Она отключает пользователя, соединение с которым работает с ошибками, и сообщает об этом другим пользователям.

...

Закрытие соединения с клиентом (при возникновении ошибки)

procedure ErrorCloseConnection(Connection: TIdTCPServerConnection);

var

clError: client; //Информация о пользователе, соединение

//с которым прервалось (только имя и IP)

begin

//Отключим соединение, работающее с ошибками

clError := DeleteClient(Connection);

//Сообщим об отключении остальным пользователям

SendAll(\'deluser:\' + clError.strName);

SendAll(\'Нас покинул «\' + clError.strName + \'».’);

//Добавим событие в журнал

if (REPORT) then AddEvent(\'Из-за ошибки отсоединен клиент "\' +

clError.strName + \'" на компьютере «\' + clError.strIP + \'»\');

end;