Excel. Трюки и эффекты
Шрифт:
Листинг 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.
В
Соответственно, 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, пытается присоединиться к серверу. Если клиент присоединен к серверу, то эта же кнопка используется для его отсоединения.
Листинг 11.25.
Присоединение/отсоединение от сервера
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 (листинг 11.26) отправляет сообщение, которое могут прочесть все пользователи, присоединенные к серверу.
Листинг 11.26.
Отправка сообщения всем собеседникам
procedure TfrmClient.cmbSendClick(Sender: TObject);
begin
if (txtMessage.Text <> \'\') then
begin
//Отправка сообщения всем собеседникам
TCPClient.WriteLn(\'text:\' + txtMessage.Text);
txtMessage.Text := \'\
txtMessage.SetFocus;
end;
end;
При двойном щелчке кнопкой мыши на имени в списке пользователей отправляется сообщение, которое получает только выделенный в списке пользователь (листинг 11.27).
Листинг 11.27.
Отправка сообщения заданному собеседнику
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;
Сразу после соединения с сервером, тоесть в обработчикеTfrmClient. TCPClient-Connected, приведенном в листинге 11.28, клиентская программа отправляет имя пользователя серверу. При отсоединении от сервера (тот же листинг 11.28) происходит соответствующее оформление внешнего вида формы frmClient.
Листинг 11.28.
Обработка присоединения/отсоединения от сервера
procedure TfrmClient.TCPClientConnected(Sender: TObject);
begin
//Отправляем на сервер имя пользователя
TCPClient.WriteLn(\'name:\' + txtUser.Text);
end;
procedure TfrmClient.TCPClientDisconnected(Sender: TObject);
begin
//Оформим форму для отсоединенного от сервера состояния
Disconnect;
end;
Ключевой обработчик (именно по таймеру проверяется факт прихода сообщения от сервера) приведен в листинге 11.29. Для элемента управления TCPClient значение тайм-аута установлено для того, чтобы при отсутствии принятых данных клиентская программа не переходила надолго в состояние ожидания, а генерировалось исключение, по которому и можно судить, что данных еще нет (см. блок try в этом обработчике).
Листинг 11.29.
Проверка, есть ли данные от сервера
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;
end.