Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.04.2017, 15:07   #1
ИнгаМ
Новичок
Джуниор
 
Регистрация: 26.10.2015
Сообщений: 2
По умолчанию Уведомление о входящем сообщении в локальном чате Delphi

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

Код "Запросить"
Код:
begin
if (Edit1.Text = '') or (memo1.Text = '') then
begin
MessageBox (Handle, 'Заполните все поля!', 'Ошибка', 0);
end
else begin
DataModule1.ADOTable2.Insert;
Datamodule1.ADOtable2.FieldByName('data').AsDateTime:=date();
Datamodule1.ADOtable2.FieldByName('opis').AsString:=Memo1.Text;
Datamodule1.ADOtable2.FieldByName('log').AsString:=Datamodule1.ADOtable1.FieldByName('login').AsString ;
Datamodule1.ADOtable2.FieldByName('par').AsString:=Datamodule1.ADOtable1.FieldByName('parol').AsString ;
Datamodule1.ADOtable2.FieldByName('srok').AsInteger:=strtoint(Edit1.text);
DataModule1.ADOTable2.Post;
MessageDLG('Спасибо! Ваш запрос принят',mtInformation,[mbOK],0);
Form14.show;
form4.Close;
DataModule1.ADOTable2.Requery;
end;
Код формы "сервера"
Код:
procedure TForm8.FormCreate(Sender: TObject);
begin
TextEdit.Clear;
ChatRichEdit.Lines.Clear;
PrivateEdit.Text:='Всем';
Receive := false; 
end;
procedure TForm8.FormShow(Sender: TObject);
var UItems: TListItem;
begin
Niks:=Form2.NikEdit.Text; {присваемый ник сервера по его логину}
SS2.Port:=1313; {запишем указанный порт в ServerSocket}
SS2.Active:=True; {запускаем сервер}
ShowColorMassage('00119['+TimeToStr(Time)+'] Сервер создан.', 2); {}
SpeedButton4.Tag:=1;{}
SpeedButton4.Caption:='Закрыть сервер';
UserListView.Items.Clear;
UItems:=UserListView.Items.Add;
UItems.Caption:=Niks;
UItems.ImageIndex:=1;end;
procedure TForm8.SendBitBtnClick(Sender: TObject);
var
i:integer;
begin
If PrivateEdit.Text='Всем'
then
Begin
// отправляем сообщение с сервера всем пользователям
For i:=0 to SS2.Socket.ActiveConnections-1 do
Begin
SS2.Socket.Connections[i].SendText('0'+FontName // 1 байт - шрифт
+FontSize // 1 байт - размер
+FontColor // 2 байта - цвет
+'['+TimeToStr(Time)
+'] '+Niks
+': '+TextEdit.Text);
end;
ShowColorMassage('0'
+FontName
+FontSize
+FontColor
+'['+TimeToStr(Time)
+'] '+Niks
+': '+TextEdit.Text, 0);
TextEdit.Clear;
end
else
Begin
If PrivateEdit.Text<>Niks
then
Begin
For i:=0 to SS2.Socket.ActiveConnections-1 do
Begin
If TUserList(SS2.Socket.Connections[i].Data).Name=PrivateEdit.Text
then
Begin
SS2.Socket.Connections[i].SendText('3'
+FontName
+FontSize
+FontColor
+PrivateEdit.Text+Chr(152)
+'>> ['+TimeToStr(Time)
+'] '+Niks
+': '+TextEdit.Text);
TextEdit.Clear;
break;
end;end;end;end;
procedure TForm8.SpeedButton3Click(Sender: TObject);
begin
PrivateEdit.Text:='Всем';
end;
procedure TForm8.SpeedButton4Click(Sender: TObject);
begin
If SpeedButton4.Tag=1 then
Begin
UpdateUserList;
UserListView.Items.Clear;
// закрываем сервер
SS2.Active:=False;
ShowColorMassage('00119['+TimeToStr(Time)+'] Сервер закрыт.', 2);
SpeedButton4.Tag:=0;
SpeedButton4.Caption:='Включить сервер';
end
else
Begin
SS2.Port:=1313;
SS2.Active:=True;
ShowColorMassage('00119['+TimeToStr(Time)+'] Сервер создан.', 2);
SpeedButton4.Tag:=1;
SpeedButton4.Caption:='Закрыть сервер';
UpdateUserList;
end
end;
procedure TForm8.SpeedButton5Click(Sender: TObject);
begin
ChatRichEdit.Clear;
end;
procedure TForm8.SS2ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
var
d:TUserList;
begin 
ShowColorMassage('00119['+TimeToStr(Time)+'] Подключился клиент.', 2); 
d:=TUserList.Create;
d.Name:='';
d.Image:=0;
Socket.Data:=TObject(d);
Socket.SendText('1');
end;
procedure TForm8.SS2ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
var
j,ind:integer;
begin
// добавим в ChatRichEdit сообщение с временем отключения клиента
// сразу зададим параметры шрифта (Arial, 8, красный, курсив)
ShowColorMassage('00119['+TimeToStr(Time)+'] Клиент отключился.', 2);
// разрешаем обновление
ind:=-1;
For j:=0 to SS2.Socket.ActiveConnections-1 do
Begin
if Socket=SS2.Socket.Connections[j]
then
ind:=j;
end;
TUserList(Socket.Data).Free;
Socket.Data:=nil;
UpdateUserList;
end;
procedure TForm8.SS2ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
count,i,b,j,ind,z,sz:integer;
com:Byte;
FS:TFileStream;
buf: Pointer;
tmp,txt:string;
begin
Application.ProcessMessages;
txt:=Socket.ReceiveText();
if Receive
then // Если клиент в режиме приёма файла, то...
Writing(Socket,txt) // Записываем данные в буфер
else // Если клиент не в режиме приёма файла, то...
begin
If txt<>'' then // условие, что пакет не пуст
Begin
com:=StrToInt(Copy(txt,1,1)); // получим код комманды
len:=Length(txt)-1; // получим длину строки
Case com of // определение комманд
// код приема сообщения --------------------------------------------------------
0: Begin
// добавим в ChatRichEdit сообщение клиента
ShowColorMassage(txt, 0);
// разошлем сообщение пользователям (кроме того, кто прислал)
For j:=0 to SS2.Socket.ActiveConnections-1 do
Begin
if Socket<>SS2.Socket.Connections[j] then
SS2.Socket.Connections[j].SendText(txt);
end;
end;
// -----------------------------------------------------------------------------
// код приема ника клиента -----------------------------------------------------
1: Begin
// запишем в массив полученный ник
TUserList(Socket.Data).Name:=Copy(txt,2,len);
// отметим, что пользователь записан в список
TUserList(Socket.Data).Image:=0;
// обновляем список
UpdateUserList;
end;
3: Begin
poss:=6;
x:=0;
For j:=6 to len+1 do
Begin
x:=x+1;
If Copy(txt,j,1)=Chr(152) then
Begin
PrivateUser:=Copy(txt,poss,x-1);
end;
end;
If PrivateUser=Niks then
Begin
ShowColorMassage(Copy(txt,1,5)+Copy(txt,7+Length(PrivateUser),len-Length(PrivateUser)-1), 1);
end
else
Begin
For b:=0 to SS2.Socket.ActiveConnections-1 do
Begin
If TUserList(SS2.Socket.Connections[b].Data).Name=PrivateUser then
Begin
SS2.Socket.Connections[b].SendText(txt);
break;
end;
end;
end;
end;
4: Begin
try
MS := TMemoryStream.Create; // Создаём буфер для файла
Delete(txt, 1, Pos('#', txt)); // Определяем имя файла
FName := Copy(txt, 0, Pos('#', txt) -1); // Определяем имя файла
Delete(txt, 1, Pos('#', txt)); // Определяем размер файла
FSize := StrToInt(Copy(txt, 0, Pos('#', txt) -1)); // Определяем размер файла
Delete(txt, 1, Pos('#', txt)); // Удаляем последний разделитель
Receive := true; // Переводим сервер в режим приёма файла
Writing(Socket,txt); // Записываем данные в буфер
except
end;end;
end;еnd;end;end;
procedure TForm8.TextEditKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#13 then SendBitBtn.Click;
end;
procedure TForm8.UpdateUserList;
var i:integer;
UItems: TListItem;
StrUserList:string;
begin
UserListView.Items.Clear;
UItems:=UserListView.Items.Add;
UItems.Caption:=Niks;
UItems.ImageIndex:=1;
StrUserList:=Niks+Chr(152);
For i:=0 to SS2.Socket.ActiveConnections-1 do
Begin
if SS2.Socket.Connections[i].data<>nil then
begin
UItems:=UserListView.Items.Add;
UItems.Caption:=TUserList(SS2.Socket.Connections[i].data).Name;
UItems.ImageIndex:=TUserList(SS2.Socket.Connections[i].data).Image;
StrUserList:=StrUserList+TUserList(SS2.Socket.Connections[i].data).Name+Chr(152);
end;
end;
For i:=0 to SS2.Socket.ActiveConnections-1 do
begin 
SS2.Socket.Connections[i].SendText('2'+StrUserList);
end;
end;
Объясните как реализовать, куда вставить какой код, можно скинуть примеры. Уведомление должно быть текстовым, типа "вам пришел новый запрос"

Последний раз редактировалось Аватар; 18.04.2017 в 15:11.
ИнгаМ вне форума Ответить с цитированием
Старый 28.04.2017, 11:50   #2
Arigato
Высокая репутация
СуперМодератор
 
Аватар для Arigato
 
Регистрация: 27.07.2008
Сообщений: 16,219
По умолчанию

Вы так и писали код без отступов? Такое же читать невозможно.
Arigato вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
уведомление на почту xswe Microsoft Office Excel 19 09.02.2015 09:45
уведомление zaq2000 Microsoft Office Excel 18 01.02.2015 12:43
Передача файлов по сети (оповещение о входящем файле) Makar_79 Работа с сетью в Delphi 2 17.05.2013 16:39
Угар в чате, как бот с искуственным интеллектом разводит лохов (исходник на Delphi) xzxz Общие вопросы Delphi 0 16.01.2012 07:20
Авторизация + уведомление о сообщении -=L.Morgan=- Общие вопросы Delphi 8 12.08.2009 23:33