lstEvents: TListBox; //Список событий
…
end;
var
frmServer: TfrmServer;
REPORT: Boolean; //Если = True, то все события
//записываются в ListBox
//окна сервера
SERVERVISIBLE: Boolean; //Если = True, то окно показывается
//на экране и приложение есть
//на Панели задач
implementation
//Следующая структура используется для хранения информации
//о пользователе, подключившемся к серверу
type
client = record
fUsed: Boolean; {Ячейка занята}
fNamed: Boolean; {Клиент сообщил свое имя}
strName: string; {Имя пользователя}
strIP: string; {IP-адрес клиента}
Connection: TIdTCPServerConnection; {Соединение клиента
с сервером}
end;
const
MAX_CLIENT = 100;//Максимальное количество книентов
var
clients: array [1..MAX_CLIENT] of client;//Массив со сведениями о клиентах
section: TCriticalSection; //Критическая секция для синхронизации потоков
Процедура, записывающая событие в журнал (ListBox на форме сервера), приведена в листинге 11.11.
Листинг 11.11.
Добавление события в журнал сервера
procedure AddEvent(strEvent: string);
begin
section.Enter;
frmServer.lstEvents.Items.Append (strEvent);
section.Leave;
end;
В листинге 11.12 приводится процедура, рассылающая текстовое сообщение всем присоединенным к серверу клиентам.
Листинг 11.12.
Рассылка сообщения всем клиентам
procedure SendAll(strMessage: string);
var
i: Integer;
begin
for i:=1 to MAX_CLIENT do
if (clients [i].fNamed)then
begin
try
clients[i].Connection.WriteLn (strMessage);
except
//При возникновении ошибки отключим клиента
//и продолжим рассылку
ErrorCloseConnection(clients [i].Connection);
end;
end;
end;
Далее, в листинге 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;
AddClien t := 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 + '' на компьютере
