Excel. Трюки и эффекты
Шрифт:
Далее, в листинге 11.13, приведена процедура, посылающая текстовое сообщение strMessage клиенту с заданным именем strName.
Листинг 11.13.
Посылка сообщения клиенту с заданным именем
procedure SendTo(strMessage: string; strName: string);
var
i: Integer;
begin
for i:=1 to MAX_CLIENT do
if (clients[i].fNamed)then
if (clients[i].strName = strName) then
//Нашли клиента с заданным именем
try
clients[i].Connection.WriteLn(strMessage);
except
//При возникновении ошибки отключим клиента
//и продолжим рассылку
ErrorCloseConnection(clients[i].Connection);
end;
end;
Процедура, приведенная в листинге 11.14, находит и помечает как занятую для нового пользователя запись в массиве clients. Если свободных записей в массиве не осталось, то достигнуто максимальное количество пользователей.
Листинг 11.14.
Добавление
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.
Листинг 11.15. Удаление информации о клиенте
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: с именем каждого зарегистрированного ранее пользователя.
Листинг 11.16.
Посылка списка всех присоединенных клиентов
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) вызывается при ошибке отправки сообщений пользователям (например, при нарушении сетевого соединения). Она отключает пользователя, соединение с которым работает с ошибками, и сообщает об этом другим пользователям.
Листинг 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;
Процедура RegisterClient, приведенная в листинге 11.18, регистрирует пользователя под указанным в сообщении name: именем (ранее выполнялась функция AddClient, которая нашла для записи этого пользователя место в MaccHBeclients). Если имя, под которым хочет зарегистрироваться пользователь, уже используется, то клиентской программе посылается соответствующее уведомление, после чего соединение разрывается.
Листинг 11.18.
Регистрация нового клиента
procedure RegisterClient(Connection: TIdTCPServerConnection;
strName: string);
var
i: Integer;
begin
//Проверим, чтобы имя клиента еще не использовалось
for i:=1 to MAX_CLIENT do
begin
if (clients[i].fNamed) then
if (clients[i].strName = strName) then
begin
//Дублирование имени – придется разрывать соединение
Connection.WriteLn(\'error:Пользователь с именем "\' +
strName + \'" уже участвует в разговоре.’);
DeleteClient(Connection);
Connection.Socket.Close;
Exit;
end;
end;
//Поиск записи о нужном клиенте и присвоение ему имени
for i:=1 to MAX_CLIENT do
begin
if (not clients[i].fNamed and clients[i].fUsed) then
if (clients[i].Connection = Connection) then
begin
//Вот он,
наш клиент…clients[i].fNamed := True;
clients[i].strName := strName;
//Сообщим другим о появлении нового участника
SendAll(\'adduser:\' + strName);
SendAll(\'text:К нам присоединился "\' + strName +
\'". Поприветствуем!\');
//Отсылаем новому книенту список остальных участников
//разговора
SendClientList(Connection);
//Разрешим новому клиенту отсылать сообщения
Connection.WriteLn(\'ok:\');
//Если нужно, то добавим событие в список
if (REPORT) then AddEvent(\'Присоединен клиент "\' +
strName + \'" на компьютере "\' +
Connection.Socket.Binding.PeerIP + \'"\');
end;
end;
end;
В листинге 11.19 приведена служебная функция, возвращающая имя пользователя по ссылке на объект TIdTCPServerConnection, соответствующий этому клиенту.
Листинг 11.19.
Определение имени клиента по его соединению с сервером
function GetClientName(Connection: TIdTCPServerConnection):string;
var
i: Integer;
begin
for i:=1 to MAX_CLIENT do
if (clients[i].fNamed) then
if (clients[i].Connection.Socket.Binding.Handle =
Connection.Socket.Binding.Handle) then
begin
GetClientName := clients[i].strName;
Exit;
end;
end;
И, наконец, в листинге 11.20 приводится главная процедура серверного приложения, обрабатывающая сообщения, полученные от клиентов.
Листинг 11.20.
Обработка сообщения от клиента
procedure ProcessMessage(Connection: TIdTCPServerConnection;
strMessage: string);
var
strName: string; //Имя отправителя сообщения
strAction: string; //Строка с обозначением действия (префикс)
len: Integer; //Длина строки strAction
begin
//Определим действие, которое хочет выполнить клиент
len := Pos(\':\', strMessage);
strAction := Copy(strMessage,1,len-1);
Delete(strMessage,1,len);
if (strAction = \'name\') then
begin
//Клиент сообщает свое имя – пытаемся его зарегистрировать
RegisterClient(Connection, strMessage);
end
else if (strAction = \'text\') then
begin
//Клиент передает сообщение всем – подпишем сообщение и отошлем
strMessage := GetClientName(Connection) + \': \' + strMessage;
SendAll(\'text:\' + strMessage);
//Если надо, то сохраняем сообщение в списке событий
if (REPORT) then AddEvent(\'Сообщение от \' + strMessage);
end
else
begin
//Клиент передает сообщение определенному собеседнику
//(строка strAction содержит имя собеседника)
strName := GetClientName(Connection);
SendTo(\'text:\' + strName + \': \' + strMessage, strAction);
if (strName <> strAction) then
//Передадим копию сообщения отправителю
Connection.WriteLn(\'text:\' + strName + \' для \' +
strAction + \': \' + strMessage);
//Если надо, то сохраняем сообщение в списке событий
if (REPORT) then AddEvent(\'Сообщение для \' + strAction +
\' от \' + strName + \': \' + strMessage);
end;
end;
Информация о каждом пользователе (участнике разговора) хранится в отдельной структуре client:
type
client = record
fUsed: Boolean; {Ячейка занята}
fNamed: Boolean; {Клиент сообщил свое имя}
strName: string; {Имя пользователя}
strIP: string; {IP-адрес клиента}
Connection: TIdTCPServerConnection; {Соединение клиента с сервером}
end;
Непосредственно к пользователю имеют отношение три последних поля структуры. Самым полезным из них является ссылка на объект TIdTCPServerConnection, с помощью которой сервер может в любое время отправить данные определенному пользователю.
Информация обо всех пользователях хранится в массиве clients. Его размер органичен (константа MAXCLIENT) и определяет максимальное количество пользователей – участников разговора. Так как используется массив с постоянным количеством элементов, то можно применять специальный флаг (поле f Used) для индикации того, что ячейка массива занята (значение True) или свободна (значение False). Поле fName структуры client используется для фиксации факта сообщения клиентской программой имени пользователя (клиентские программы незарегистрированных пользователей сообщения не получают). Изначально значение поля fNamed равно False и устанавливается в True, только если имя пользователя сообщено серверу и не используется одним из участников разговора.
Одним из самых сложных моментов работы рассматриваемого сервера является обеспечение синхронизации доступа к массиву clients. Для этого используется критическая секция. Она также применяется для синхронизации добавления событий в список IstEvents сервера.
И, наконец, последний момент в реализации сервера. Чтобы сервер можно было запускать с отключенным протоколированием событий, а также чтобы окно сервера не мешало пользователю, можно хранить значения переменных REPORT и SERVERVISIBLE в INI-файле. Так, собственно, и сделано: значения этих переменных хранятся в секции [Common] файла Server. ini. Для считывания значений из INI-файла при запуске сервера код в модуле Server (файл Server. dpr) изменен следующим образом (листинг 11.21).