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

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).

...

Листинг 11.21. Изменения в модуле Server

program Server;

uses

Forms,

Unit1 in 'Unit1.pas' {frmServer},

IniFiles, Dialogs;

{$R *.res}

var

{Переменные из INI-файла}

config: TIniFile;

strPath: string;

begin

//Грузим информацию из INI-файла

strPath :=

Copy(Application.ExeName,1,Length(Application.ExeName)–3) +

'ini

config := TIniFile.Create(strPath);

SERVERVISIBLE := config.ReadBool('Common', 'ServerVisible',

False);

REPORT := config.ReadBool('Common',’EventReport’, False);

config.Free ;

try

//Запуск сервера

Application.Initialize;

Application.CreateForm(TfrmServer, frmServer);

Application.Run;

except

MessageDlg('Не удается запустить сервер сообщений. ' +

'Возможно, он был запущен ранее.', mtError, [mbOK], 0);

end;

end.

В приведенном листинге код создания формы помещен в блок try. Сделано это только для того, чтобы сервер не «падал» с выдачей всем прекрасно знакомого окна о критической ошибке при попытке ошибочного запуска своей копии.

Соответственно, INI-файл для запуска сервера с видимым окном и включенным протоколированием имеет следующий вид:

...

[Common]

ServerVisible=1

EventReport=1

Реализация клиентского приложения

Проект клиентской программы имеет имя Client. Внешний вид формы клиентского приложения во время его работы представлен на рис. 11.7.

Приведенная на рис. 11.7 форма имеет имя frmClient. Свойства (только существенные для работы приложения) основных элементов управления, помещенных на форму, приведены в табл. 11.2.

Рис. 11.7. Форма клиента при ведении разговора

Таблица 11.2.

Свойства элементов управления формы frmClient

Далее приведены функции и процедуры, не являющиеся обработчиками событий, но имеющие большое значение для работы клиентского приложения.

Приведенная в листинге 11.22 процедура обновляет форму при удачном подключении к серверу....

Листинг 11.22.

Обновление формы при присоединении к серверу

procedure Connect();

begin

with frmClient do

begin

cmbConnect.Caption := 'Отключиться

txtUser.Enabled := False;

txtServer.Enabled := False;

Caption := 'Разговорник [' + txtUser.Text + ' подключен к ' +

txtServer.Text + ']

lstUsers.Enabled := True;

cmbSend.Enabled := True;

txtMessage.Enabled := True;

txtChat.Enabled := True;

end;

end;

Процедура Disconnect, приведенная в листинге 11.23, обновляет форму при отключении от сервера (в таком виде форма frmClient предстает первоначально).

...

Листинг 11.23.

Обновление формы при отсоединении от сервера

procedure Disconnect();

begin

with frmClient do

begin

cmbConnect.Caption := 'Подключиться

txtUser.Enabled := True;

txtServer.Enabled := True;

Caption := 'Разговорник

lstUsers.Enabled := False;

lstUsers.Clear;

cmbSend.Enabled := False;

txtMessage.Enabled := False;

txtChat.Enabled := False;

end;

end;

Процедура ProcessMessage (листинг 11.24) обрабатывает сообщение, полученное от сервера, аналогично такой же процедуре в серверном приложении (естественно, сообщения и реакция на них отличны от серверных).

...

Листинг 11.24.

Обработка строки, полученной от сервера

procedure ProcessMessage(strMessage: string);

var

strAction: string; //Тип сообщения (префикс сообщения)

len: Integer; //Длина строки strAction

begin

//Определим тип сообщения и выполним соответствующие действия

len := Pos(':', strMessage);

strAction := Copy(strMessage,1,len-1);

Delete(strMessage,1,len);

if (strAction = 'ok') then

begin

//Регистрация пользователя завершена – можно отправлять

//сообщения

Connect;

end

else if (strAction = 'error') then

begin

//Ошибка!!!

frmClient.TCPClient.Disconnect;

Disconnect;

MessageDlg(strMessage, mtError, [mbOK], 0);

end

else if (strAction = 'adduser') then

begin

//К разговору присоединился новый пользователь

frmClient.lstUsers.Items.Add(strMessage);

end

else if (strAction = 'deluser') then

begin

//Какой-то пользователь отсоединился

frmClient.lstUsers.Items.Delete(

frmClient.lstUsers.Items.IndexOf(strMessage));

end

else begin

//Покажем принятое сообщение

frmClient.txtChat.Lines.Add(strMessage);

end;

end;

Далее приводятся обработки событий, на которых, собственно, и основана работа клиентской программы. Обработчик нажатия кнопки cmbConnect, приведенный в листинге 11.25, пытается присоединиться к серверу. Если клиент присоединен к серверу, то эта же кнопка используется для его отсоединения.