Валерий Борисок - Delphi. Трюки и эффекты
- Название:Delphi. Трюки и эффекты
- Автор:
- Жанр:
- Издательство:неизвестно
- Год:неизвестен
- ISBN:нет данных
- Рейтинг:
- Избранное:Добавить в избранное
-
Отзывы:
-
Ваша оценка:
Валерий Борисок - Delphi. Трюки и эффекты краткое содержание
«Delphi. Трюки и эффекты», как и все издания данной серии, адресована тем, кто хочет научиться делать с помощью уже знакомых программных пакетов новые, интересные вещи. В первой части книги многое говорится о среде разработки Delphi (самых последних версий) и программировании на языке Object Pascal. Благодаря этому издание подходит и новичкам, и начинающим программистам. Вторая (основная) часть книги описывает удивительные возможности, скрытые в языке, и на примерах учит читателя программистским фокусам – от «мышек-невидимок» и «непослушных окон» до воспроизведения МРЗ и управления офисными программами Word и Excel из приложений Delphi. Купив эту книгу, вы пройдете непростой путь к вершинам программистского мастерства весело и интересно.
Delphi. Трюки и эффекты - читать онлайн бесплатно ознакомительный отрывок
Интервал:
Закладка:
Листинг 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;
Процедура ErrorCloseConnection (листинг 11.17) вызывается при ошибке отправки сообщений пользователям (например, при нарушении сетевого соединения). Она отключает пользователя, соединение с которым работает с ошибками, и сообщает об этом другим пользователям.
Листинг 11.17.
Закрытие соединения с клиентом (при возникновении ошибки)
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, приведенная в листинге 11.18, регистрирует пользователя под указанным в сообщении name: именем (ранее выполнялась функция AddClient, которая нашла для записи этого пользователя место в MaccHBeclients). Если имя, под которым хочет зарегистрироваться пользователь, уже используется, то клиентской программе посылается соответствующее уведомление, после чего соединение разрывается.
Листинг 11.18.
Регистрация нового клиента
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;
Интервал:
Закладка:
