var Form1: TForm1; i, j, com, ContList: Byte; len, pos, x: Word; text, StrUserList: String; UpdDo: Boolean; Buf: array[0..3] of Byte; UserMas: array[0..255] of TUserList; //массив объектов UItems: TListItem;

Опишем процедуру OnCreate формы:

procedure TForm1.FormCreate(Sender: TObject); begin // заголовок формы Caption:='Многопользовательский чат'; Application.Title:=Caption; // предложенное значения порта PortEdit.Text:=' Порт сервера'; // адрес при проверке программы на одном ПК ("сам на себя") HostEdit.Text:=' Адрес сервера '; // введем ник по-умолчанию, остальные поля просто очистим NikEdit.Text:='Ананим'; TextEdit.Clear; ChatMemo.Lines.Clear; end;

Процедура “прослушивания” открытых каналов сервером, выглядит так: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.ReceiveText(); // условие, что пакет не пуст if text<>” then begin // получим код команды, длину строки com:=StrToInt(Copy(text,1,1)); len:=Length(text)-1; // определение команд case com of // код приема сообщения 0: begin // добавим в ChatMemo сообщение клиента ChatMemo.Lines.Add(Copy(text,2,len)); // разошлем сообщение пользователям (кроме того, кто прислал) for j:=0 to ServerSocket.Socket.ActiveConnections-1 do begin if (j+1)<>i then ServerSocket.Socket.Connections[j].SendText('0?+Copy(text,2,len)); end; end; // код приема ника клиента 1: begin // запишем в массив полученный ник UserMas.Name:=Copy(text,2,len); // отметим, что пользователь записан в список UserMas.Rec:=True; // обновляем список UpdateUserList; end; end; end; end; end; // разрешение на выполнение процедур обновления if UpdDo=True then begin // обновляем массив пользователей UpdateUserMas; // обновляем список пользователей UpdateUserList; // блокируем разрешение UpdDo:=False; end; end;

Перевод программы в режим сервера осуществляется клавишей “Создать сервер” (ServerBtn). Вот так выглядит процедура на нажатие клавиши ServerBtn (OnClick):

procedure TForm1.ServerBtnClick(Sender: TObject); begin if ServerBtn.Tag=0 then begin // клавишу ClientBtn и поля HostEdit, PortEdit, NikEdit заблокируем ClientBtn.Enabled:=False; HostEdit.Enabled:=False; PortEdit.Enabled:=False; NikEdit.Enabled:=False; // запишем указанный порт в ServerSocket ServerSocket.Port:=StrToInt(PortEdit.Text); // запускаем сервер ServerSocket.Active:=True; // добавим в ChatMemo сообщение с временем создания ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Сервер создан.'); // изменяем тэг ServerBtn.Tag:=1; // меняем надпись клавиши ServerBtn.Caption:='Закрыть сервер'; // включаем таймер сервера ServerTimer.Enabled:=True; // вписываем параметры сервера UserMas[0].Status:=1; UserMas[0].Rec:=True; UserMas[0].Name:=NikEdit.Text; UserMas[0].Image:=1; // разрешаем обновление UpdDo:=True; end else begin // выключаем таймер сервера ServerTimer.Enabled:=False; // стираем параметры сервера UserMas[0].Status:=0; UserMas[0].Rec:=False; UserMas[0].Name:='Неизвестный'; UserMas[0].Image:=0; // разрешаем обновление UpdDo:=True; // очищаем список клиентов UserListView.Items.Clear; // клавишу ClientBtn и поля HostEdit, PortEdit, NikEdit разблокируем ClientBtn.Enabled:=True; HostEdit.Enabled:=True; PortEdit.Enabled:=True; NikEdit.Enabled:=True; // закрываем сервер ServerSocket.Active:=False; // выводим сообщение в ChatMemo ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Сервер закрыт.'); // возвращаем тэгу исходное значение ServerBtn.Tag:=0; // возвращаем исходную надпись клавиши ServerBtn.Caption:='Создать сервер'; end; end;

Далее идут события, которые должны происходить при определенном состоянии ServerSocket'а. Напишем процедуру, когда клиент подсоединился к серверу (OnClientConnect):

procedure TForm1.ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket); begin // добавим в ChatMemo сообщение с временем подключения клиента ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Подключился клиент.'); // разрешаем обновление UpdDo:=True; end;

Напишем процедуру, когда клиент отключается (OnClientDisconnect):

procedure TForm1.ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin // добавим в ChatMemo сообщение с временем отключения клиента ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Клиент отключился.'); // разрешаем обновление UpdDo:=True; end;

Отправка сообщений. Она осуществляется нажатием клавиши “Отправить” (SendBtn), но необходима проверка режима программы сервер или клиент. Напишем ее процедуру (OnClick):

procedure TForm1.SendBtnClick(Sender: TObject); begin // проверка, в каком режиме находится программа if ServerSocket.Active=True then // отправляем сообщение с сервера всем пользователям for i:=0 to ServerSocket.Socket.ActiveConnections-1 do ServerSocket.Socket.Connections.SendText('0['+TimeToStr(Time)+'] `+NikEdit.Text+': `+TextEdit.Text) else // отправляем сообщение с клиента ClientSocket.Socket.SendText('0['+TimeToStr(Time)+'] `+NikEdit.Text+': `+TextEdit.Text); // отобразим сообщение в ChatMemo ChatMemo.Lines.Add('['+TimeToStr(Time)+'] `+NikEdit.Text+': `+TextEdit.Text); // очищаем TextEdit TextEdit.Clear; end;

Режим клиента. При нажатии клавиши “Подключиться” (ClientBtn), блокируется ServerBtn и активируется ClientSocket. Вот процедура ClientBtn (OnClick):

procedure TForm1.ClientBtnClick(Sender: TObject); begin if ClientBtn.Tag=0 then begin // клавишу ServerBtn и поля HostEdit, PortEdit заблокируем ServerBtn.Enabled:=False; HostEdit.Enabled:=False; PortEdit.Enabled:=False; // запишем указанный порт в ClientSocket ClientSocket.Port:=StrToInt(PortEdit.Text); // запишем хост и адрес (одно значение HostEdit в оба) ClientSocket.Host:=HostEdit.Text; ClientSocket.Address:=HostEdit.Text; // запускаем клиента ClientSocket.Active:=True; // изменяем тэг ClientBtn.Tag:=1; // меняем надпись клавиши ClientBtn.Caption:='Отключиться'; end else begin // клавишу ServerBtn и поля HostEdit, PortEdit разблокируем ServerBtn.Enabled:=True; HostEdit.Enabled:=True; PortEdit.Enabled:=True; // закрываем клиента ClientSocket.Active:=False; // очищаем список клиентов UserListView.Items.Clear; // выводим сообщение в ChatMemo ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Сессия закрыта.'); // возвращаем тэгу исходное значение ClientBtn.Tag:=0; // возвращаем исходную надпись клавиши ClientBtn.Caption:='Подключиться'; end; end;

Процедуры на OnConnect, OnDisconnect, OnRead клиента ClientSocket. Сначала на чтение сообщения с сервера (OnRead):

procedure TForm1.ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket); begin // получим текст, код комманды, длину строки text:=Socket.ReceiveText(); com:=StrToInt(Copy(text,1,1)); len:=Length(text)-1; // определение комманд case com of // добавим в ChatMemo сообщение с сервера 0: ChatMemo.Lines.Add(Copy(text,2,len)); // отошлем свой ник на сервер 1: ClientSocket.Socket.SendText('1'+NikEdit.Text); // примем строку списка пользователей 2: begin // очищаем список клиентов UserListView.Items.Clear; // добавим ключ конца строки (т.к. вырезка символов с задержкой) text:=text+Chr(152); // укажем начальный символ pos:=2; // обнулим счетчик символов x:=0; // пробегаем по длине строки списка for j:=2 to len+1 do begin // записываем в счетчик сдвиг x:=x+1; // если найден ключ (отделение ников в строке) if Copy(text,j,1)=Chr(152) then begin // добавим в UserListView строку UItems:=UserListView.Items.Add; UItems.Caption:=Copy(text,pos,x-1); // укажем соответствующую иконку пользователя if pos>2 then UItems.ImageIndex:=0 else UItems.ImageIndex:=1; // изменим текущую позицию в строке списка pos:=j+1; // обнулим счетчик символов x:=0; end; end; end; end; end;

Дальше обычное добавление в ChatMemo определенного сообщения:

procedure TForm1.ClientSocketConnect(Sender: TObject; Socket: TCustomWinSocket); begin // добавим в ChatMemo сообщение о соединении с сервером ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Подключение к серверу.'); end;

procedure TForm1.ClientSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin // добавим в ChatMemo сообщение о потере связи ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Сервер не найден.'); end;

Хранителем информации о пользователях у нас выступает массив, процедура его заполнения и обновления выглядит так:

procedure TForm1.UpdateUserMas; begin // очищаем массив с информацией for i:=1 to 255 do begin UserMas.Status:=0; UserMas.Rec:=False; UserMas.Name:='Неизвестный'; UserMas.Image:=0; end; // заполняем данные пользователей if ServerSocket.Socket.ActiveConnections<>0 then begin for i:=1 to ServerSocket.Socket.ActiveConnections do begin UserMas.Status:=2; UserMas.Name:='Неизвестный'; UserMas.Image:=0; // запрашиваем имя (ник) пользователя по его каналу (код команды - 1) ServerSocket.Socket.Connections.SendText('1?); end; end; end;

Список UserListView обновляется в следующей процедуре:

procedure TForm1.UpdateUserList; begin // очищаем список клиентов UserListView.Items.Clear; // очищаем переменную StrUserList:=''; // обнуляем пометку записи ContList:=0; // пробегаем по диапазону каналов for i:=0 to 255 do begin // если запись не пустая if UserMas.Status<>0 then begin // добавим в UserListView строку UItems:=UserListView.Items.Add; UItems.Caption:=UserMas.Name; UItems.ImageIndex:=UserMas.Image; // если пользователь не записан if UserMas.Rec=False then ContList:=1; // составляем строку пользователей StrUserList:=StrUserList+UserMas.Name+Chr(152); end; end; // если все пользователи отметились, и есть хоть один канал if (ContList=0) and (ServerSocket.Socket.ActiveConnections<>0) then begin // пробегаем по всем открытым каналам for i:=0 to ServerSocket.Socket.ActiveConnections-1 do begin // отправим строку списка пользователей (код команды - 2) ServerSocket.Socket.Connections.SendText('2?+StrUserList); end; end; end;

Листинг программы

unit MainUnit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ScktComp, ExtCtrls, ImgList, ComCtrls, jpeg;

type

TForm1 = class(TForm)

ServerSocket: TServerSocket;

ClientSocket: TClientSocket;

PortEdit: TEdit;

NikEdit: TEdit;

TextEdit: TEdit;

ChatMemo: TMemo;

HostEdit: TEdit;

ServerBtn: TButton;

ClientBtn: TButton;

SendBtn: TButton;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

UserListView: TListView;

Label6: TLabel;

ImageList: TImageList;

ServerTimer: TTimer;

Image1: TImage;

procedure FormCreate(Sender: TObject);

procedure UpdateUserList;

procedure UpdateUserMas;

procedure ServerBtnClick(Sender: TObject);

procedure ClientBtnClick(Sender: TObject);

procedure ServerSocketClientConnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ServerSocketClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure SendBtnClick(Sender: TObject);

procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);

procedure ClientSocketDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ClientSocketConnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ServerTimerTimer(Sender: TObject);

procedure TextEditKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

private

{ Private declarations }

public

{ Public declarations }

end;

Type

TUserList = object

Status: Byte;

Rec: Boolean;

Name: String;

Image: Byte;

end;

var

Form1: TForm1;

i, j, com, ContList: Byte;

len, pos, x: Word;

text, StrUserList: String;

UpdDo: Boolean;

Buf: array[0..3] of Byte;

UserMas: array[0..255] of TUserList;

UItems: TListItem;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

Caption:='Многопользовательский чат';

Application.Title:=Caption;

PortEdit.Text:='Порт сервера';

HostEdit.Text:='Адрес сервера';

NikEdit.Text:='Ананим';

TextEdit.Clear;

ChatMemo.Lines.Clear;

end;

procedure TForm1.UpdateUserList;

begin

UserListView.Items.Clear;

StrUserList:='';

ContList:=0;

For i:=0 to 255 do

Begin

If UserMas[i].Status<>0 then

Begin

UItems:=UserListView.Items.Add;

UItems.Caption:=UserMas[i].Name;

UItems.ImageIndex:=UserMas[i].Image;

If UserMas[i].Rec=False then ContList:=1;

StrUserList:=StrUserList+UserMas[i].Name+Chr(152);

end;

end;

If (ContList=0) And (ServerSocket.Socket.ActiveConnections<>0) then

Begin

For i:=0 to ServerSocket.Socket.ActiveConnections-1 do

Begin

ServerSocket.Socket.Connections[i].SendText('2'+StrUserList);

end;

end;

end;

procedure TForm1.UpdateUserMas;

begin

For i:=1 to 255 do

Begin

UserMas[i].Status:=0;

UserMas[i].Rec:=False;

UserMas[i].Name:='Неизвестный';

UserMas[i].Image:=0;

end;

If ServerSocket.Socket.ActiveConnections<>0 then

Begin

For i:=1 to ServerSocket.Socket.ActiveConnections do

Begin

UserMas[i].Status:=2;

UserMas[i].Name:='Неизвестный';

UserMas[i].Image:=0;

ServerSocket.Socket.Connections[i-1].SendText('1');

end;

end;

end;

procedure TForm1.ServerBtnClick(Sender: TObject);

begin

If ServerBtn.Tag=0 then

Begin

ClientBtn.Enabled:=False;

HostEdit.Enabled:=False;

PortEdit.Enabled:=False;

NikEdit.Enabled:=False;

ServerSocket.Port:=StrToInt(PortEdit.Text);

ServerSocket.Active:=True;

ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Сервер создан.');

ServerBtn.Tag:=1;

ServerBtn.Caption:='Закрыть сервер';

ServerTimer.Enabled:=True;

UserMas[0].Status:=1;

UserMas[0].Rec:=True;

UserMas[0].Name:=NikEdit.Text;

UserMas[0].Image:=1;

UpdDo:=True;

end

else

Begin

ServerTimer.Enabled:=False;

UserMas[0].Status:=0;

UserMas[0].Rec:=False;

UserMas[0].Name:='Неизвестный';

UserMas[0].Image:=0;

UpdDo:=True;

UserListView.Items.Clear;

ClientBtn.Enabled:=True;

HostEdit.Enabled:=True;

PortEdit.Enabled:=True;

NikEdit.Enabled:=True;

ServerSocket.Active:=False;

ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Сервер закрыт.');

ServerBtn.Tag:=0;

ServerBtn.Caption:='Создать сервер';

end;

end;

procedure TForm1.ClientBtnClick(Sender: TObject);

begin

If ClientBtn.Tag=0 then

Begin

ServerBtn.Enabled:=False;

HostEdit.Enabled:=False;

PortEdit.Enabled:=False;

ClientSocket.Port:=StrToInt(PortEdit.Text);

ClientSocket.Host:=HostEdit.Text;

ClientSocket.Address:=HostEdit.Text;

ClientSocket.Active:=True;

ClientBtn.Tag:=1;

ClientBtn.Caption:='Отключиться';

end

else

Begin

ServerBtn.Enabled:=True;

HostEdit.Enabled:=True;

PortEdit.Enabled:=True;

ClientSocket.Active:=False;

UserListView.Items.Clear;

ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Сессия закрыта.');

ClientBtn.Tag:=0;

ClientBtn.Caption:='Подключиться';

end;

end;

procedure TForm1.ServerSocketClientConnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Подключился клиент.');

UpdDo:=True;

end;

procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Клиент отключился.');

UpdDo:=True;

end;

procedure TForm1.SendBtnClick(Sender: TObject);

begin

If ServerSocket.Active=True then

For i:=0 to ServerSocket.Socket.ActiveConnections-1 do

ServerSocket.Socket.Connections[i].SendText('0['+TimeToStr(Time)+'] '+NikEdit.Text+': '+TextEdit.Text)

else

ClientSocket.Socket.SendText('0['+TimeToStr(Time)+'] '+NikEdit.Text+': '+TextEdit.Text);

ChatMemo.Lines.Add('['+TimeToStr(Time)+'] '+NikEdit.Text+': '+TextEdit.Text);

TextEdit.Clear;

end;

procedure TForm1.ClientSocketRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

text:=Socket.ReceiveText();

com:=StrToInt(Copy(text,1,1));

len:=Length(text)-1;

Case com of

0: ChatMemo.Lines.Add(Copy(text,2,len));

1: ClientSocket.Socket.SendText('1'+NikEdit.Text);

2: Begin

UserListView.Items.Clear;

text:=text+Chr(152);

pos:=2;

x:=0;

For j:=2 to len+1 do

Begin

x:=x+1;

If Copy(text,j,1)=Chr(152) then

Begin

UItems:=UserListView.Items.Add;

UItems.Caption:=Copy(text,pos,x-1);

If pos>2 then UItems.ImageIndex:=0 else UItems.ImageIndex:=1;

pos:=j+1;

x:=0;

end;

end;

end;

end;

end;

procedure TForm1.ClientSocketConnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Подключение к серверу.');

end;

procedure TForm1.ClientSocketDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ChatMemo.Lines.Add('['+TimeToStr(Time)+'] Сервер не найден.');

end;

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();

If text<>'' then

Begin

com:=StrToInt(Copy(text,1,1));

len:=Length(text)-1;

Case com of

0: Begin

ChatMemo.Lines.Add(Copy(text,2,len));

For j:=0 to ServerSocket.Socket.ActiveConnections-1 do

Begin

If (j+1)<>i then ServerSocket.Socket.Connections[j].SendText('0'+Copy(text,2,len));

end;

end;

1: Begin

UserMas[i].Name:=Copy(text,2,len);

UserMas[i].Rec:=True;

UpdateUserList;

end;

end;

end;

end;

end;

If UpdDo=True then

Begin

UpdateUserMas;

UpdateUserList;

UpdDo:=False;

end;

end;

procedure TForm1.TextEditKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

If Key=VK_RETURN then SendBtn.Click;

end;

end.

Заключение

В моей курсовой работе я достиг, поставленных перед собою целей реализовав программный продукт онлайн общения - чат. Данный проект может быть развит в перспективе до более высокого уровня, добавив некоторые новые функциональных возможностей.

В данный момент, в связи с бурным развитием WEB технологий, нет смысла создавать собственную программу чата. Так как в более удобно взять уже готовый, полностью завершенный чат.

Приложение

Запущенный сервер:

При подключение к серверу (у сервера):

При подключении к серверу (у клиента):

Отправка сообщений (у сервера и клиента):

Страницы: 1, 2