Валерий Борисок - 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; //Критическая секция для синхронизации потоков

Листинг 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.

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

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.

Добавление информации о новом клиенте

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;

Листинг 11.15. Удаление информации о клиенте