Шрифт:
Особенностью реакции сервера на отключение клиентской программы (процедура 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;