[Статья] Чат с помощью ucoz

FarmHitman1 · 20.04.2012, 19:26

Доброго времени суток... Я не знаю нужен кому чат с помощью ucoz или нет, но для освоение сойдет

1. Берем компоненты: Memo, Edit, Button, IdHTTP, idFTP, Timer и Label.

2. Для чего все надо: Memo, Edit и Button - думаю с этим все понятно. IdHTTP и Timer нужны для чтения чата с сервера ucoz, idFTP для отправки сообщений, в Label будем выводить сам чат (Visible должно быть False, чтобы пользователь не видел лишнего текста)
Если кто знает как выводить сразу в Memo, а не в Label то можете переделать))

3. Собственно сам код:

Код:

procedure TForm1.Timer1Timer(Sender: TObject);
var
HTTP:TIdHTTP;
s:string;
begin
HTTP:=TIdHTTP.Create(nil);
s:=HTTP.Get('http://site.ucoz.ru/Chat.txt');
Memo1.Clear;
Memo1.Lines[0] := s;
   end;

Код:

procedure TForm1.Button9Click(Sender: TObject);
var
S: TStringList;
begin
S:=TStringList.Create;
S.Text:=Edit1.Text;
S.SaveToFile('Chat.txt');
Edit1.Clear;

IdFTP1.Username:= 'Login FTP';
IdFTP1.Password:= 'Pass FTP';
IdFTP1.Host:= 'Host FTP';
IdFTP1.Passive:= True;
if IdFTP1.Connected then
IdFTP1.Disconnect
else
try
IdFTP1.Connect(True);
except
on E : Exception do
ShowMessage('Îê: '+E.Message);
end;
if IdFTP1.Connected then
try
IdFTP1.Put('Chat.txt', 'Chat.txt', True);
except
on E : Exception do
ShowMessage('Íåà: '+E.Message);
end;
DeleteFile('Chat.txt');
IdFTP1.Disconnect;
end;

Вот в принципе и все, небольшие задержки только при отправке сообщений 1-2сек.

FarmHitman1 · 21.04.2012, 13:27

Ну интервал 1000 норм в принципе =)

FarmHitman1 · 21.04.2012, 15:40

Проверял? Норм работает?

FarmHitman1 · 21.04.2012, 17:21

Проверил, в Form.Create

Код:

WebBrowser1.Navigate('http://site.ucoz.ru/Chat.txt');

Refresh в таймере работает... НО... после того как он делает обновление таргет с Edit слетает

Есть ли код для выбора в таргет Edit ?

Добавлено через 2 минуты
А не, все норм, главное на браузер не нажимать, но тут проблема в другом... Он русский язык не читает

там шифровка не понятная на ucoze с русским языком

Добавлено через 4 минуты
Если руками вводить в чат по русски (файл на сервере) то он читает, а если отправлять сообщение то нет...

~~Skrillex3~~ · 21.04.2012, 17:38

включи поток и не будет виснуть форма ,правда не факт что фтп будет работать ,сокет в поток не пашит(((

FarmHitman1 · 22.04.2012, 12:50

Цитата:

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


	Спасибо вам что исправили меня, просто нужно было бежать.. А теперь по теми. На юкоз шифруетца только когда загружаеш файл на хост, если уже потом его редоктировать то будет все ок. Я проверял вводил и все норм было, вводил текст он там появлялся.. Это даже чатом не назвать, просто так пишеш посты, и даже не видно кто пишет(т.е. ник неймы)

Правда чтоли?

[Ссылки могут видеть только зарегистрированные пользователи. ]

Код:

begin
S:=TStringList.Create;
Edit1.text := Edit2.text + ': ' + Edit1.text;
S.Text:=Edit1.Text;
S.SaveToFile('Chat.txt');
Edit1.Clear;

Добавляем строчку и проблема решена

sasha- · 23.04.2012, 03:25

в мемо сразу вроде так memo1.Lines.LoadFromFile(IdHTTP1.Get('http://site.ucoz.ru/Chat.txt'))
ну а если не можешь зачем создавать лейбл если можно создать переменную типа string и сунуть туда
var
blabla:string
...
Memo1.Lines[0] := blabla;
...

FarmHitman1 · 25.04.2012, 18:13

Код:

procedure TForm1.Timer1Timer(Sender: TObject);
var
HTTP:TIdHTTP;
s:string;
begin
HTTP:=TIdHTTP.Create(nil);
s:=HTTP.Get('http://site.ucoz.ru/Chat.txt');
Memo1.Clear;
Memo1.Lines[0] := s;
   end;

Вот так пашет

Поправил 1 пост

Добавлено через 2 часа 31 минуту
Возникла проблемка...
Вот окно чата
[Ссылки могут видеть только зарегистрированные пользователи. ]

После того, как чат заполнится более 13 строк, то он полностью все стирает.. файл на сервере тоже чистит

Добавлено через 2 часа 33 минуты
А, не не после заполнения... По неизвестным причинам стер)

sasha- · 25.04.2012, 21:17

попробуй так

Код:

procedure TForm1.Timer1Timer(Sender: TObject);
var
HTTP:TIdHTTP;
s:string;
begin
HTTP:=TIdHTTP.Create(nil);
s:=HTTP.Get('http://site.ucoz.ru/Chat.txt');
Memo1.Clear;
memo1.Lines.Add(s);
   end;

еще может стирать из за "частых запросах get система защиты расценивает это как ддос" по идее стирается по таймеру:
memo1.clear; а запрос не идет...

FarmHitman1 · 26.04.2012, 20:54

Нашел небольшую ошибку, из-за которой сообщения отправляются 1 из 2...

Код:

procedure TForm1.Button9Click(Sender: TObject);
var
S: TStringList;
begin
S:=TStringList.Create;
S.Text:=Edit1.Text;
S.SaveToFile('Chat.txt');
Edit1.Clear;

IdFTP1.Username:= 'Login FTP';
IdFTP1.Password:= 'Pass FTP';
IdFTP1.Host:= 'Host FTP';
IdFTP1.Passive:= True;
if IdFTP1.Connected then
IdFTP1.Disconnect
else
try
IdFTP1.Connect(True);
except
on E : Exception do
ShowMessage('Îê: '+E.Message);
end;
if IdFTP1.Connected then
try
IdFTP1.Put('Chat.txt', 'Chat.txt', True);
except
on E : Exception do
ShowMessage('Íåà: '+E.Message);
end;
DeleteFile('Chat.txt');
IdFTP1.Disconnect
end;

Необходимо добавить данную строку, чтобы не было такой проблемы...

sasha- · 28.04.2012, 17:34

я вот только не пойму зачем разрывать соеденение а потом опять устанавливать? можно просто тупо сделать проверку на осуществление подключения

Код:

procedure TForm1.Button9Click(Sender: TObject);
var
S: TStringList;
begin
S:=TStringList.Create;
S.Text:=Edit1.Text;
S.SaveToFile('Chat.txt');
Edit1.Clear;
IdFTP1.Username:= 'Login FTP';
IdFTP1.Password:= 'Pass FTP';
IdFTP1.Host:= 'Host FTP';
IdFTP1.Passive:= True;
if IdFTP1.Connected then
begin
try
IdFTP1.Put('Chat.txt', 'Chat.txt', True);
except E : Exception do ShowMessage('Îê: '+E.Message);
IdFTP1.Disconnect;
end;
end
else
begin
IdFTP1.Connect(True);
try
IdFTP1.Put('Chat.txt', 'Chat.txt', True);
except
on E : Exception do
ShowMessage('Íåà: '+E.Message);
IdFTP1.Disconnect;
end;
end;
DeleteFile('Chat.txt');
end;

FarmHitman1 · 29.04.2012, 17:34

Цитата:

Сообщение от sasha-

я вот только не пойму зачем разрывать соеденение а потом опять устанавливать? можно просто тупо сделать проверку на осуществление подключения

Код:

procedure TForm1.Button9Click(Sender: TObject); var S: TStringList; begin S:=TStringList.Create; S.Text:=Edit1.Text; S.SaveToFile('Chat.txt'); Edit1.Clear; IdFTP1.Username:= 'Login FTP'; IdFTP1.Password:= 'Pass FTP'; IdFTP1.Host:= 'Host FTP'; IdFTP1.Passive:= True; if IdFTP1.Connected then begin try IdFTP1.Put('Chat.txt', 'Chat.txt', True); except E : Exception do ShowMessage('Îê: '+E.Message); IdFTP1.Disconnect; end; end else begin IdFTP1.Connect(True); try IdFTP1.Put('Chat.txt', 'Chat.txt', True); except on E : Exception do ShowMessage('Íåà: '+E.Message); IdFTP1.Disconnect; end; end; DeleteFile('Chat.txt'); end;

Так отправляет быстрее, но на IdFTP1.Disconnect; ругается везде) Я просто стер, пока что не знаю че получится)

sasha- · 01.05.2012, 22:05

Цитата:

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


	Так отправляет быстрее, но на IdFTP1.Disconnect; ругается везде) Я просто стер, пока что не знаю че получится)

да по идее без idftp1.disconnect работать если только нет лимита (сколько юзеров могут одновременно подключены к фтп

)

FarmHitman1 · 02.05.2012, 12:55

Цитата:

Сообщение от sasha-


	да по идее без idftp1.disconnect работать если только нет лимита (сколько юзеров могут одновременно подключены к фтп)

Ну не знаю.. У меня вроде все норм пашет без DC

~~Naik1998~~ · 03.05.2012, 08:11

Интервал 1000? можно увеличить на какие допустимые параметры?