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

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

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

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

...

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

procedure AddEvent(strEvent: string);

begin

section.Enter;

frmServer.lstEvents.Items.Append(strEvent);

section.Leave;

end;

В листинге 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.

...

Посылка сообщения клиенту с заданным именем

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;