обновление в блоге - Создание многопользовательского чата

[Beermonza]

Обратите внимание на процедуру procedure TForm1.ServerTimerTimer(Sender: TObject); ...в коде за номер канала отвечает переменная i. Если вы хотите чтобы сервер "общался" с клиентами тет-а-тет, то перестройте кейс. Вот так сейчас сервер принимает сообщение и отправляет всем:

// код приема сообщения -------------------------------------------
                0: Begin
// добавим в ChatRichEdit сообщение клиента
                     ShowColorMassage(text, 0);
// разошлем сообщение пользователям (кроме того, кто прислал)
                     For j:=0 to ServerSocket.Socket.ActiveConnections-1 do
                       Begin
                         If (j+1)<>i then ServerSocket.Socket.Connections[j].SendText(text);
                       end;
                   end;
// ------------------------------------------------------------------------

Перепишите код так:

// код приема сообщения -------------------------------------------
                0: Begin
// добавим в ChatRichEdit сообщение клиента
                     ShowColorMassage(text, 0);
// приготовим содержимое переменной text нужным образом и отправим этому же клиенту
                     ServerSocket.Socket.Connections[i-1].SendText(text);
                   end;
// ------------------------------------------------------------------------

Разумеется, нужно учитывать правила создания пакета с сообщением, иначе клиент ничего не получит.

[Beermonza]

Обнаружилась ошибка в версии 2.0, поэтому тем, кто скачал ее с поста #56 нужно внести исправления. Вот так вкратце выглядит обработка пакетов сервером:

procedure TForm1.ServerTimerTimer(Sender: TObject);
begin
// условие на наличие установленных каналов
  If ServerSocket.Socket.ActiveConnections<>0 then
    Begin
// цикл по существующим каналам
      For i:=1 to ServerSocket.Socket.ActiveConnections do
        Begin
// сохраним пакет (если ничего не прислали, по пакет пустой)
          text:=ServerSocket.Socket.Connections[i-1].ReceiveText();
// условие, что пакет не пуст

...

// код приема приватного сообщения ---------------------------------------------
                3: Begin
// укажем начальный символ

...


// создаем цикл перебора пользователей
                         For i:=0 to ServerSocket.Socket.ActiveConnections-1 do
                           Begin
// если пользователь найден
                             If UserMas[i+1].Name=PrivateUser then
                               Begin
// отсылаем сообщение в канал приватного пользователя
                                 ServerSocket.Socket.Connections[i].SendText(text);
// сбрасываем цикл
                                 break;
                               end;
                           end;

...

Видно что глобальный цикл использует переменную i для определения каналов, и кейс на приватные сообщения, под кодом 3, тоже использует эту же переменную, но для своих целей. К чему это приводит? Если приватных сообщений на сервер в один и тот же момент (очень близко) поступило несколько, то сработает только первое, остальные будут проигнорированы.

Что нужно сделать

1) Заведите еще одну переменную типа Byte в глобальной секции Var:

var
  Form1: TForm1;
  i, j, k, com, ContList: Byte;
  len, pos, x: Word;
  ...

2) Замените переменную i в цикле в обработке приватных сообщений на k. Вот так:

// создаем цикл перебора пользователей
                         For k:=0 to ServerSocket.Socket.ActiveConnections-1 do
                           Begin
// если пользователь найден
                             If UserMas[k+1].Name=PrivateUser then
                               Begin
// отсылаем сообщение в канал приватного пользователя
                                 ServerSocket.Socket.Connections[k].SendText(text);
// сбрасываем цикл
                                 break;
                               end;
                           end;

[GIGOMAUNT]

Ну вот собственно реши проблему с дисконектом и всё что я хотел если есть способ по проще давайте в студию!

procedure TForm1.ServerSocket1ClientRead(Send er: TObject;
Socket: TCustomWinSocket);
var s: string;
v: string;
i: Integer;
begin
s := Socket.ReceiveText;
memo1.Lines.Add(S);
IF copy (s,1,5)='USER ' then
begin
v:=s;
delete (v,1,5);
i:=ServerSocket1.Socket.ActiveConne ctions-1;
user.Items.Add(v);
host.Items.Add(ServerSocket1.Socket .Connections[i].RemoteHost + ' : ' + IntToStr(ServerSocket1.Socket.Conne ctions[i].RemotePort));
Exit;
end;
end;

procedure TForm1.ServerSocket1ClientDisconnec t(Sender: TObject;
Socket: TCustomWinSocket);
Var
d:integer;
s:string;
begin
d:=host.Items.IndexOf(socket.Remote Host+ ' : ' + IntToStr (Socket.RemotePort));
memo1.Lines.Add(inttostr(d));
user.Items.Delete(d);
host.Items.Delete(d);
end;
end.

[Beermonza]

Чегой-то не понял ни разу предыдущий пост. Задача решена уже? ...может буква потерялась "собственно решил проблему", иначе звучит как повеление. Исходники программы есть, скачивайте и пользуйтесь. Обсуждение именно этих исходников, программы чата, и дальнейшая модернизация силами пользователей, и мои пояснения по этому поводу.

[GIGOMAUNT]

Ой извеняюсь потерялась! Просто мне нужен многокомнатный чат на 1 порте и надо определять что, кто, какой клиент отправил и каким это доставить. Других способов не нашел да видно и нет. Может к этому приклеете. Можно оргонизовать авто бан без ошибочно распозновая кто прислал данное сообщение и банить по IP. Всёже понять когда написал ктото другой сложнее от сюда и глюки чата, но это только моё мнение (Мне интереснее с нуля, либо полностью переписать под себя)! И не передовайте имя юзера как индификатор по каналу это критическая дыра (Можно будет писать от другова юзера даже если он подключён)!

[Beermonza]

Замечания по защите информации в данном случае не уместны, ...в статье я пояснил, что только лишь показываю "дверь" и чуть приоткрываю ее, пройти же через нее вам нужно самим, и если необходимо забарикадировать. Достаточно применить механизм шифрования пакетов, и все проблемы, о которых вы говорите, улетучатся сами собой. Так что извиняйте если что не так, ...это всего лишь простой пример для развития мышления.
На счет "бана по IP" - это известная песня, мы устраняем хулигана, а за одно с ним и всю подсеть, ...ведь чат для сети Интернет.

[parinoff]

Спасибо огромное за понятное объяснение принципов работы с сокетами!
Вот что у меня получилось.
Сюда выложить не получилось поэтому выкинул на свой сайт -
http://my.nexe.ru/2009/04/16/nibbleprice/
1) Зайдите в настройки, укажите IP и Port своего сервака и нажмите сохранить
2) введите ник и нажмите подклучиться.
3) Исходники такой штуки я выкладывать уже не буду, но если у вас будут вопросы я с удовольствием отвечу

Глюков конечно пока море, но я дорабатываю))
Главное движок работает!)))

Огромнейшее спасибо Beermonza
Я тебя впишу в отдельную благодарность!!))

[BiT]

// добавим в ChatRichEdit приватное сообщение с сервера
    3:Begin ShowColorMassage(Copy(text,1,5)+Copy(text,7+Length(NikEdit.Text),len-Length(NikEdit.Text)-1), 1);
     PlaySound('sound\sndSrvMsg.wav',0,SND_ASYNC);

У меня возникла Проблема со звуковым сообщением приватного сообщения.
Клиенты оповещаются звуком, когда приходит приват сообщения, а сервер нет.

[parinoff]

Сообщение от BiT

// добавим в ChatRichEdit приватное сообщение с сервера
    3:Begin ShowColorMassage(Copy(text,1,5)+Copy(text,7+Length(NikEdit.Text),len-Length(NikEdit.Text)-1), 1);
     PlaySound('sound\sndSrvMsg.wav',0,SND_ASYNC);

У меня возникла Проблема со звуковым сообщением приватного сообщения.
Клиенты оповещаются звуком, когда приходит приват сообщения, а сервер нет.

Звук не выводится потому-что условие стоит. 3 - это как раз приват. вот он в привате и пищит=)
пропиши PlaySound('sound\sndSrvMsg.wav',0,S ND_ASYNC); в 2-ке и будет пищать отовсех.

[BiT]

parinoff поделись пожалуйста своим чатом исходником)