Delphi: сетевое программирование
КОМПЬЮТЕРНЫЕ КУРСЫ "ПОИСК"
[Главная страница] [Delphi] [Контакты]
Многопользовательский разговорник (IdTCPServer, IdTCPClient)
На основе компонентов IdTCPClient и IdTCPServer для организации сетевого взаимодействия рассмотрим создание полноценного клиент-серверного приложения — многопользовательского разговорника. Как можно догадаться из названия, это приложение будет позволять обмениваться сообщениями большому количеству пользователей (наподобие чата).
Рассмотрим подробно основные этапы его проектирования, разработки и реализации (начиная с требований и поведения клиента и сервера и заканчивая нюансами реализации приложений).
Требования к клиентскому и серверному приложениям
Пользователи при работе с клиентскими приложениями должны иметь следующие возможности:
- видеть полный текст разговора с момента их подключения к серверу;
- отсылать сообщения как всем, так и только определенным пользователям;
- видеть список пользователей, участвующих в разговоре (при этом список должен автоматически обновляться при отключении или присоединении новых пользователей);
- получать уведомления об отключении или присоединении новых пользователей (прямо в тексте разговора).
Серверное приложение, кроме управления подключением, отключением пользователей, а также доставки сообщений, должно обеспечивать протоколирование событий (подключение, отключение пользователей, от кого и кому послано то или иное сообщение).
При реализации серверного приложения нужно преодолеть некоторые сложности, связанные с тем, что к серверу будут постоянно подключены сразу несколько пользователей, причем информация о каждом пользователе будет постоянно храниться и использоваться сервером. Нужно также обеспечить надежную работу клиентского, а главное — серверного приложения при проблемах, связанных с неисправностями сети.
И, наконец, нужно обеспечить автоматическую рассылку клиентским приложениям следующей информации (клиенты эту информацию специально с сервера не запрашивают):
- текста сообщений;
- уведомлений о присоединении или отсоединении пользователей.
Формат сообщений клиента и сервера
Клиент и сервер обмениваются только текстовыми сообщениями (не путать с сообщениями, которыми обмениваются пользователи в ходе разговора). Строка любого сообщения состоит из двух частей: префикса и текста сообщения. Префикс отделяется от текста сообщения символом : (двоеточие). По префиксу можно определить, что делать с полученным сообщением.
Возможны следующие сообщения от клиента серверу:
- name:имя пользователя — при помощи этого сообщения клиентская программа сообщает серверу, под каким именем зарегистрировать пользователя (это имя будут видеть другие пользователи);
- text:текст — при получении этого сообщения сервер должен разослать текст всем участникам разговора (включая отправителя);
- имя_адресата:текст — при получении этого сообщения сервер должен отправить текст только заданному префиксом пользователю имя_адресата, а также должен отправить копию автору сообщения.
К сообщениям третьего типа относятся все сообщения, принимаемые сервером и не начинающиеся с text: или name:.
В свою очередь, сервер может посылать клиентской программе сообщения следующего вида:
- ok: — означает, что пользователь зарегистрирован и может вступать в разговор;
- error:сообщение_об_ошибке — означает, что по каким-то причинам пользователь не может участвовать в разговоре. При получении этого сообщения клиентская программа должна показать окно с текстом сообщение_об_ошибке и разорвать соединение с сервером;
- adduser: имя_пользователя — при получении такого сообщения клиентская программа должна добавить строку имя_пользователя в список участников разговора;
- deluser:имя_пользователя — при получении такого сообщения клиентская программа должна удалить строку имяполь зова теля из списка участников разговора;
- text:текст — клиентская программа должна добавить текст к тексту разговора.
Перед рассмотрением реализации клиентской и серверной частей скажем несколько слов об использовании специальных сообщений клиента (name:имя_пользователя) и сервера (ок: и error:сообщение_об_ошибке). Дело в том,что в предлагаемой реализации сервера присоединение нового пользователя к разговору происходит следующим образом.
- Клиентское приложение присоединяется к серверу (количество пользователей ограничено, поэтому сервер может послать лишнему пользователю сообщение error: с соответствующим текстом, описывающим ошибку, и тут же разорвать установленное соединение).
- Клиентское приложение посылает серверу сообщение с именем пользователя (префикс name:).
- Если имя, под которым хочет зарегистрироваться новый пользователь, используется, то клиентскому приложению отправляется сообщение error: с пояснением ошибки.
- Если имя свободно, то сервер сохраняет его (и рассылает его всем остальным клиентским приложениям), а также посылает приложению присоединенного пользователя список всех остальных пользователей, и только после этого дает новому пользователю возможность участвовать в разговоре (сообщение ok:).
Остальные нюансы будут рассмотрены при описании исходного кода клиентского и серверного приложений.
Реализация сервера
Рис. 1.
Форма сервера сообщений
Элемент управления ListBox (имя lstEvents), который можно увидеть на форме, предназначен для вывода списка событий (присоединение, отсоединение клиентов, передача сообщений). Список помещается в рамку GroupBox1. Для списка и рамки задано значение свойства align = client.
Кроме перечисленных элементов управления, на форму также помещены компоненты IdTCPServer (имя TCPServer) и Timer (имя Timer1). Для таймера задаются значения свойств Enabled = True и Intervel = 50. Компонент TCPServer настраиваем на прослушивание порта 12345, а также устанавливаем значение свойства Active = True.
При реализации сервера основной программный код помещен в файле формы (Unit1.pas). Этот модуль условно можно разделить на две части: в первой реализованы специальные функции и процедуры (регистрации пользователей, пересылки текстовых сообщений между пользователями и т. д,), во второй части следуют процедуры-обработчики событий (методы класса TfrmServer).
Сначала рассмотрим процедуры обработки событий, так как они значительно проще, чем остальные функции и процедуры, и их рассмотрение вначале позволит лучше представить функционирование приложения (листинг 1).
Листинг 1. Процедуры обработки событий серверного приложения (Unit1.pas)
procedure TfrmServer.Timer1Timer(Sender: TObject);
begin
//Если нужно, то скроем окно сервера
if (not SERVERVISIBLE) then
begin
frmServer.Visible := False;
ShowWindow(Application.Handle, SW_HIDE);
end;
//Таймер больше не нужен
Timer1.Enabled := False;
end;
procedure TfrmServer.TCPServerExecute(AThread: TIdPeerThread);
begin
//Обработаем сообщение, пришедшее от клиента
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;
Первая и последняя из приведенных в листинге 1 процедур не имеют непосредственного отношения к работе TCP-сервера. Процедура TfrmServer. Timer1Timer вызывается только один раз при первом срабатывании таймера Timer1. В ней, исходя из заданного значения глобальной переменной SERVERVISIBLE, происходит (или не происходит) скрытие окна сервера. Значение глобальной переменной SERVERVISIBLE (и переменной REPORT) определяется в момент запуска сервера.
Процедура TfrmServer.FormCreate создает объект синхронизации, используемый остальными функциями и процедурами для предотвращения одновременного доступа к общим данным нескольких потоков (ведь сервер-то у нас многопоточный).
Остальные три процедуры используются непосредственно для организации взаимодействия сервера с клиентами. Как было сказано ранее, сервер хранит информацию о присоединенных к нему клиентах. Хранилищем этой информации является массив структур (подробно он будет рассмотрен немного ниже). Здесь же необходимо сказать, что при присоединении к серверу нового клиента (процедура TfrmServer.TCPServerConnect) предпринимается попытка найти для информации о новом пользователе место в указанном массиве (вызов функции AddClient). Если место нашлось, то функция AddClient возвращает True, и сервер переходит в режим регистрации пользователя. Для регистрации клиентская программа должна передать серверу имя пользователя (сообщение с префиксом name:).
Особенностью реакции сервера на отключение клиентской программы (процедура TfrmServer.TCPServerDisconnect) является то, что, помимо удаления информации об отсоединившемся клиенте (вызов функции DeleteClient), все остальные пользователи уведомляются об отсоединении собеседника (вызовы функции SendAll).
При получении сообщения от клиента (процедура TfrmServer.Execute) происходит всего лишь передача полученной строки функции ProcessMessage, которая и занимается анализом текста сообщения и определением действий, которые сервер должен выполнять.
Теперь рассмотрим функции и процедуры, которые прямо или косвенно используются описанными выше обработчиками событий и на которых по большей части и основывается работа серверного приложения. Часть файла Unit1.pas, содержащая объявление типов данных, переменных и подключения модулей (добавленные вручную), которые нужны для работы сервера, приведена в листинге 2.
Листинг 2. Типы данных и переменные серверного приложения (Unit1.pas)
unit Unit1;
interface
uses
..., SyncObjs;
type
TfrmServer = class(TForm)
lstEvents: TListBox;
...
end;
var
frmServer: TfrmServer;
REPORT: Boolean; //Если = True, то все события
//записываются в ListBox
//окна сервера
SERVERVISIBLE: Boolean; //Если = True, то показывается
//на экране и приложение есть
//на Панели задач
implementation
{$R *.dfm}
//Следующая структура используется для хранения информации
//о пользователе, подключившись к серверу
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 на форме сервера), приведена в листинге 3.
Листинг 3. Добавление события в журнал
procedure AddEvent(strEvent: string); begin section.Enter; frmServer.lstEvents.Items.Append(strEvent); section.Leave; end;
В листинге 4 приводится процедура, рассылающая текстовое сообщение всем присоединенным к серверу клиентам.
Листинг 4. Рассылка сообщения всем клиентам
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;
Далее, в листинге 5, приведена процедура, посылающая текстовое сообщение strMessage клиенту с заданным именем strName.
Листинг 5. Посылка сообщения клиенту с заданным номером
procedure SendTo(strMessage: string; strName: string);
var
i: Integer;
begin
if (clients[i].fNamed) then
if (clients[i].strName = strName) then
//Нашли клиента с заданным именем
try
clients[i].Connection.WriteLn(strMessage);
except
//При возникновении ошибки отключим клиента
//и продолжим рассылку
ErrorCloseConnection(clients[i].Connection);
end;
end;
Процедура, приведенная в листинге 6, находит и помечает как занятую для нового пользователя запись в массиве clients. Если свободных записей в массиве не осталось, то достигнуто максимальное количество пользователей.
Листинг 6. Добавление информации о новом клиенте
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, приведенная в листинге 7, освобождает запись заданного пользователя в массиве clients.
Листинг 7. Удаление информации о клиенте
function DeleteClient(Connection: TIdTCPServerConnection): client;
var
i: Integer;
begin
section.Enter;
for i := 1 to MAX_CLIENT do
begin
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;
end;
Процедура SendClientList, приведенная в листинге 8, отправляет клиентской программе заданного пользователя (только что зарегистрировавшегося) сообщения addclient: с именем каждого зарегистрированного ранее пользователя.
Листинг 8. Посылка списка всех присоединенных клиентов
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;
Процедура ЕrrorCloseConnect ion (листинг 9) вызывается при ошибке отправки сообщений пользователям (например, при нарушении сетевого соединения). Она отключает пользователя, соединение с которым работает с ошибками, и сообщает об этом другим пользователям.
Листинг 9. Закрытие соединения с клиентом (при возникновении ошибки)
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, приведенная в листинге 10, регистрирует пользователя под указанным в сообщении name: именем (ранее выполнялась функция AddClient, которая нашла для записи этого пользователя место в массиве clients). Если имя, под которым хочет зарегистрироваться пользователь, уже используется , то клиентской программе посылается соответствующее уведомление, после чего соединение разрывается.
Листинг 10. Регистрация нового клиента
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 приведена служебная функция, возвращающая имя пользователя по ссылке на объект TIdTCPServerConnection, соответствующий этому клиенту.
Листинг 11. Определение имени клиента по его соединению с сервером
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;
И, наконец, в листинге 12 приводится главная процедура серверного приложения, обрабатывающая сообщения, полученные от клиентов.
Листинг 12. Обработка сообщения от клиента
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) и определяет максимальное количество пользователей — участников разговора. Так как используется массив с постоянным количеством элементов, то можно применять специальный флаг (поле fUsed) для индикации того, что ячейка массива занята (значение Тrue) или свободна (значение False). Поле fName структуры client используется для фиксации факта сообщения клиентской программой имени пользователя (клиентские программы незарегистрированных пользователей сообщения не получают). Изначально значение поля fNamed равно False и устанавливается в True, только если имя пользователя сообщено серверу и не используется одним из участников разговора.
Одним из самых сложных моментов работы рассматриваемого сервера является обеспечение синхронизации доступа к массиву clients. Для этого используется критическая секция. Она также применяется для синхронизации добавления событий в список lstEvents сервера.
И, наконец, последний момент в реализации сервера. Чтобы сервер можно было запускать с отключенным протоколированием событий, а также чтобы окно сервера не мешало пользователю, можно хранить значения переменных REPORT и SERVERVISIBLE в INI-файле. Так, собственно, и сделано: значения этих переменных хранятся в секции [Common] файла Server.ini. Для считывания значений из INI-файла при запуске сервера код в модуле Server (файл Server.dpr) изменен следующим образом (листинг 13).
Листинг 13. Изменения в модуле Server
program server;
uses
Forms,
Unit1 in 'Unit1.pas',
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. Внешний вид формы клиентского приложения во время его работы представлен на рис. 2.
Рис. 2
Приведенная на рис. 2 форма имеет имя frmClient. Свойства (только существенные для работы приложения) основных элементов управления, помещенных на форму, приведены в табл. 1.
Таблица 1.Свойства элементов управления формы frmClient
| Название (свойство Name) | Описание | Измененные свойства и их новые значения |
|---|---|---|
| TCPClient | Элемент управления IdTCPClient | MaxLineAction = msSplit Port = 12345 ReadTimeout = 1 |
| Timer1 | Таймер (Timer) - используется для проверки прихода уведомления от сервера | Enabled = True Interval = 50 |
| lstUsers | Список участников разговора (ListBox) в левой части формы | Enabled = False Sorted = False |
| txtChat | Элемент Memo с текстом разговора | Enabled = False ReadOnly = True ScrollBars = ssVertical |
| txtMessage | Текстовое поле (Edit) для ввода и редактирования сообщений внизу формы | Enabled = False |
| cmbSend | Кнопка (Button) отправки сообщения, введенного в текстовое поле txtMessage | Caption = >> Default = True Enabled = False Font.Style = [fsBold] |
| txtServer | Текстовое поле (Edit) для указания имени или IP-адреса сервера | Отсутствует |
| txtUser | Текстовое поле (Edit) для указания имени пользователя | Отсутствует |
| cmbConnect | Кнопка (Button) подключения к указанному в txtServer серверу | Caption = Подключиться |
Далее приведены функции и процедуры, не являющиеся обработчиками событий, но имеющие большое значение для работы клиентского приложения.
Приведенная в листинге 14 процедура обновляет форму при удачном подключении к серверу.
Листинг 14. Обновление формы при присоединении к серверу
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, приведенная в листинге 15, обновляет форму при отключении от сервера (в таком виде форма frmClient предстает первоначально).
Листинг 15. Обновление формы при отсоединении от сервера
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 (листинг 16) обрабатывает сообщение, полученное от сервера, аналогично такой же процедуре в серверном приложении (естественно, сообщения и реакция на них отличны от серверных).
Листинг 16. Обработка строки полученной от сервера
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, приведенный в листинге 17, пытается присоединиться к серверу. Если клиент присоединен к серверу, то эта же кнопка используется для его отсоединения.
Листинг 17. Присоединение/отсоединение от сервера
procedure TfrmClient.cmbConnectClick(Sender: TObject);
begin
if (cmbConnect.Caption = 'Подключиться') then
begin
//Проверим, чтобы были введены имя сервера
//и имя пользователя
if (txtServer.Text = '') then
begin
MessageDlg('Введите имя сервера в текстовом поле.', mtInformation,
[mbOK], 0);
Exit;
end
else if (txtUser.Text = '') then
begin
MessageDlg('Введите имя пользователя в текстовом поле.', mtInformation,
[mbOK], 0);
Exit;
end;
//Пытаемся подключиться к серверу
try
TCPClient.Host := txtServer.Text;
TCPClient.Connect;
except
MessageDlg('Не удается соединиться с сервером', mtError, [mbOK], 0);
end;
end
else
//Отключаемся от сервера
TCPClient.Disconnect;
end;
Обработчик нажатия кнопки cmbSend (листинг 18) отправляет сообщение, которое могут прочесть все пользователи, присоединенные к серверу.
Листинг 18. Отправка сообщения всем собеседникам
procedure TfrmClient.cmbSendClick(Sender: TObject);
begin
if (txtMessage.Text <> '') then
begin
//Тправка сообщения всем собеседникам
TCPClient.WriteLn('text:' + txtMessage.Text);
txtMessage.Text := '';
txtMessage.SetFocus;
end;
end;
При двойном щелчке кнопкой мыши на имени в списке пользователей отправляется сообщение, которое получает только выделенный в списке пользователь (листинг 19).
Листинг 19. Отправка сообщения заданному собеседнику
procedure TfrmClient.lstUsersDblClick(Sender: TObject);
begin
if ((lstUsers.ItemIndex >= 0) and (txtMessage.Text <> '')) then
begin
//Отправим сообщение только для выбранного собеседника
//(сообщение вида "имя_собеседника:текст_сообщения")
TCPClient.WriteLn(lstUsers.Items.Strings[lstUsers.ItemIndex] +
'+' + txtMessage.Text);
txtMessage.SetFocus;
end;
end;
Сразу после соединения с сервером, тоесть в обработчикеТfrmClient.ТСPClientConnected, приведенном в листинге 20, клиентская программа отправляет имя пользователя серверу. При отсоединении от сервера (тот же листинг 20) происходит соответствующее оформление внешнего вида формы frmClient.
Листинг 20. Обработка присоединения/отсоединения от сервера
procedure TfrmClient.TCPClientConnected(Sender: TObject);
begin
//Отправляем на сервер имя пользователя
TCPClient.WriteLn('name:' + txtUser.Text);
end;
procedure TfrmClient.TCPClientDisconnected(Sender: TObject);
begin
//Оформим форму для отсоединения от сервера состояния
Disconnect;
end;
Ключевой обработчик (именно по таймеру проверяется факт прихода сообщения от сервера) приведен в листинге 21. Для элемента управления TCPClient значение тайм-аута установлено для того, чтобы при отсутствии принятых данных клиентская программа не переходила надолго в состояние ожидания, а генерировалось исключение, по которому и можно судить, что данных еще нет (см. блок try в этом обработчике).
Листинг 21. Проверка, есть ли данные от сервера
procedure TfrmClient.Timer1Timer(Sender: TObject);
var
strMessage: String;
begin
//Проверим, нет ли для нас сообщения
if (TCPClient.Connected) then
begin
try
strMessage := TCPClient.ReadLn;
if (strMessage <> '') then
ProcessMessage(strMessage);
except
on EIdReadTimeOut do; //Ошибки тайм-аута игнорируем
else
//При остальных ошибках отсоединяемся от сервера
TCPClient.Disconnect;
end;
end;
end;
 |
Примечание Чтобы при запуске клиентского приложения из среды Delphi постоянно не появлялись сообщения об исключениях (возникают при истечении тайм-аута в TfrmClient.Timer1Timer), снимите флажок Stop on Delphi Exceptions на вкладке Language Exceptions диалогового окна Debugger Options (меню Tools > Debugger Options). |
Исходный код здесь. Выполнен на Delphi 7.