Чтение онлайн

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

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;

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

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. Удаление информации о клиенте

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;

Посылка списка всех присоединенных клиентов

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;

Закрытие соединения с клиентом (при возникновении ошибки)

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;

Регистрация нового клиента

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;

Определение имени клиента по его соединению с сервером

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;

Обработка сообщения от клиента

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;

type

client = record

fUsed: Boolean; {Ячейка занята}

fNamed: Boolean; {Клиент сообщил свое имя}

strName: string; {Имя пользователя}

strIP: string; {IP-адрес клиента}

Connection: TIdTCPServerConnection; {Соединение клиента с сервером}

end;