Валерий Борисок - Delphi. Трюки и эффекты

ProcessMessage(AThread.Connection, AThread.Connection.ReadLn);

end;

procedure TfrmServer.TCPServerConnect(AThread: TIdPeerThread);

begin

//Попытаемся добавить нового пользователя

if (AddClient(AThread.Connection)) then

//Пользователь должен прислать свое имя

ProcessMessage(AThread.Connection, AThread.Connection.ReadLn)

else

begin

//Нет места для нового пользователя

AThread.Connection.WriteLn('error:Достигнуто максимальное

количество ' + 'пользователей. Извините, невозможно принять вас

в разговор.');

AThread.Connection.Socket.Close;

end;

end;

procedure TfrmServer.TCPServerDisconnect(AThread: TIdPeerThread);

var clDisconnected: client; //Структура с информацией об

//отсоединенном клиенте (заполнены

//только поля strName и strIP)

begin

//Удалим информацию об отсоединенном клиенте

clDisconnected := DeleteClient(AThread.Connection);

if (clDisconnected.strName <> '')then

begin

//Сообщим о событии остальным клиентам

SendAll('deluser:' + clDisconnected.strName);

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

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

if (REPORT) then AddEvent('Отсоединился клиент "' +

clDisconnected.strName + '" на компьютере "' +

clDisconnected.strIP + '"');

end;

end;

procedure TfrmServer.FormCreate(Sender: TObject);

begin

//Создаем критическую секцию

section := TCriticalSection.Create;

end;

Первая и последняя из приведенных в листинге 11.9 процедур не имеют непосредственного отношения к работе TCP-сервера. Процедура Tf rmServer. TimerlTimer вызывается только один раз при первом срабатывании таймера Timer 1. В ней, исходя из заданного значения глобальной переменной SERVERVISIBLE, происходит (или не происходит) скрытие окна сервера. Значение глобальной переменной SERVERVISIBLE (и переменной REPORT) определяется в момент запуска сервера.

Процедура Tf rmServer. FormCreate создает объект синхронизации, используемый остальными функциями и процедурами для предотвращения одновременного доступа к общим данным нескольких потоков (ведь сервер-то у нас многопоточный).

Остальные три процедуры используются непосредственно для организации взаимодействия сервера с клиентами. Как было сказано ранее, сервер хранит информацию о присоединенных к нему клиентах. Хранилищем этой информации является массив структур (подробно он будет рассмотрен немного ниже). Здесь же необходимо сказать, что при присоединении к серверу нового клиента (процедура Tf rmServer. TCPServerConnect) предпринимается попытка найти для информации о новом пользователе место в указанном массиве (вызов функцшФ^СНеп^. Если место нашлось, то функция AddClient возвращает True, и сервер переходит в режим регистрации пользователя. Для регистрации клиентская программа должна передать серверу имя пользователя (сообщение с префиксом name:).

Особенностью реакции сервера на отключение клиентской программы (процедура Tf rmServer. TCPServerDisconnect) является то, что, помимо удаления информации об отсоединившемся клиенте (вызов функции DeleteClient), все остальные пользователи уведомляются об отсоединении собеседника (вызовы функции SendAll).

При получении сообщения от клиента (процедура Tf rmServer. Execute) происходит всего лишь передача полученной строки функции ProcessMessage, которая и занимается анализом текста сообщения и определением действий, которые сервер должен выполнять.

Теперь рассмотрим функции и процедуры, которые прямо или косвенно используются описанными выше обработчиками событий и на которых по большей части и основывается работа серверного приложения. Часть файла Unitl.pas, содержащая объявление типов данных, переменных и подключения модулей (добавленные вручную), которые нужны для работы сервера, приведена в листинге 11.10.

Листинг 11.10.

Типы данных и переменные серверного приложения (Unitl.pas)

unit Unit1;

interface

uses

…, SyncObjs;

type

TfrmServer = class(TForm)

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;

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;