23.03.2013, 16:48
|
Прохожий
|
|
Регистрация: 19.05.2009
Сообщения: 7
Репутация: 10
|
|
посылка сообщения по UDPSocket
Гуру помогите плиз понять в чем проблема. Впервые работаю с сокетами в принципе и пытаюсь соорентироваться что к чем.
Суть: Хочу написать чат. На форме листбокс со списком пользователей(lstUsr) и ПейджКонтрол(pgcChat) для чата, далее будет понятней по коду (надеюсь )
Код:
//Создаю сервер
ss := TUdpSocket.Create(fmChat);
ss.LocalHost := ip;
if length(uid) = 1 then uid := '0'+uid;
ss.LocalPort := '27'+uid; //порт генерится по id пользователя в базеы
ss.OnReceive := fmChat.ssReceive; //ТУТ ОСНОВНАЯ ПРОБЛЕММА=((
ss.Open;
//При 2х клике в списке пользователей
procedure TfmChat.lstUsrDblClick(Sender: TObject);
var page: TTabSheet;
mm,mm1: TRichEdit;
pnl, pnl1, pnl2 : TPanel;
sp: TSplitter;
btn : TButton;
begin
if lstUsr.ItemIndex <> -1 then
Begin
//Создаем страницу
page := TTabSheet.Create(pgcChat);
page.Caption := lstUsr.Items[lstUsr.ItemIndex];
page.Name := 'sh'+ (fmAdmin.lstLogId[lstUsr.ItemIndex]); //fmAdmin.lstLogId[lstUsr.ItemIndex]-ЭТО id ПОЛЬЗОВАТЕЛЯ В БАЗЕ ДАЛЕЕ ЧАСТО ЮЗАЕТСЯ
page.PageControl := pgcChat;
//Создаем основную панель
pnl := TPanel.Create(page);
pnl.Align := alClient;
pnl.Name := 'pnlcl'+ (fmAdmin.lstLogId[lstUsr.ItemIndex]);
pnl.Caption := '';
pnl.Parent := page;
//Создаем панель для чата
pnl1 := TPanel.Create(pnl);
pnl1.Align := alClient;
pnl1.Name := 'pnlchat'+ (fmAdmin.lstLogId[lstUsr.ItemIndex]);
pnl1.Caption := '';
pnl1.Parent := pnl;
//Создаем панель для отправки сообщений
pnl2 := TPanel.Create(pnl);
pnl2.Align := alBottom;
pnl2.Name := 'pnlmsg'+ (fmAdmin.lstLogId[lstUsr.ItemIndex]);
pnl2.Caption := '';
pnl2.Height := 200;
pnl2.Parent := pnl;
//Создаем сплиттер
sp := TSplitter.Create(pnl);
sp.Name := 'spl'+ (fmAdmin.lstLogId[lstUsr.ItemIndex]);
sp.Align := alBottom;
sp.Parent := pnl;
//Создаем чат
mm := TRichEdit.Create(pgcChat);
mm.Name := 'rd'+ (fmAdmin.lstLogId[lstUsr.ItemIndex]);
mm.Align := alClient;
mm.ScrollBars := ssVertical;
mm.WordWrap := True;
mm.Parent := pnl1;
mm.ReadOnly := True;
mm.Clear;
//Создаем сообщения
mm1 := TRichEdit.Create(pgcChat);
mm1.Name := 'rdc'+ (fmAdmin.lstLogId[lstUsr.ItemIndex]);
mm1.Anchors := [akLeft,akTop,akRight,akBottom];
mm1.Height := pnl2.Height - 32;
mm1.Width := pnl2.Width -2;
mm1.ScrollBars := ssVertical;
mm1.WordWrap := True;
mm1.Parent := pnl2;
mm1.Clear;
//Создаем кнопку
btn := TButton.Create(pnl2);
btn.Width := 80;
btn.Height := 22;
btn.Caption := 'Отправить';
btn.Left := pnl2.Width - 90;
btn.Tag := strtoint(fmAdmin.lstLogId[lstUsr.ItemIndex]);
btn.Top := mm1.Top + mm1.Height + 5;
btn.Anchors := [akRight,akBottom];
fmMain.zqry1.SQL.Text := 'SELECT id, ip FROM users WHERE name="'+lstUsr.Items[lstUsr.ItemIndex]+'"';
fmMain.zqry1.Open;
if Length(fmMain.ds1.DataSet.FieldByName('id').AsString) = 1 then
btn.Hint := fmMain.ds1.DataSet.FieldByName('ip').AsString+':'+'270'+fmMain.ds1.DataSet.FieldByName('id').AsString
else
btn.Hint := fmMain.ds1.DataSet.FieldByName('ip').AsString+':'+'27'+fmMain.ds1.DataSet.FieldByName('id').AsString;
btn.ShowHint := True;
btn.OnClick := SendClick;
btn.Parent := pnl2;
end;
end;
//Событие при клике
procedure TfmChat.SendClick(Sender: TObject);
var p: TRichEdit;
ms: TStrings;
cs: TUdpSocket;
ip,port: string;
begin
p := pgcChat.FindComponent('rdc'+IntToStr(TButton(Sender).tag)) as TRichEdit;
if Assigned(p) then
begin
// ms.Clear;
ms := p.Lines;
p := TRichEdit(pgcChat.FindComponent('rd'+IntToStr(TButton(Sender).tag)));
if Assigned(p) then
begin
AddColoredLine(p,'('+DateTimeToStr(Now)+')',clRed);
P.SelStart := Length(p.Text);
P.SelAttributes.Color := clBlack;
p.Lines.AddStrings(ms);
if pos(':',TButton(Sender).hint) <> 1 then
Begin
ip := copy(TButton(Sender).hint,1,pos(':',TButton(Sender).hint)-1);
port := copy(TButton(Sender).hint,pos(':',TButton(Sender).hint)+1,length(TButton(Sender).hint)-pos(':',TButton(Sender).hint));
cs := TUdpSocket.Create(pgcChat);
cs.RemoteHost := ip;
cs.RemotePort := port;
cs.Name := 'sck'+IntToStr(TButton(Sender).tag);
try
if cs.Connect then
begin
case Length(IntToStr(TButton(Sender).tag)) of
1 :cs.Sendln('00'+IntToStr(TButton(Sender).tag)+ms.Text);
2 :cs.Sendln('0'+IntToStr(TButton(Sender).tag)+ms.Text);
3 :cs.Sendln(IntToStr(TButton(Sender).tag)+ms.Text);
end;
end;
finally
cs.Disconnect;
end;
end;
ScrollToEnd(p);
end;
end;
end;
//И САМОЕ ГЛАВНОЕ СОБЫТИЕ НА ПОЛУЧЕНИЕ СООБЩЕНИЯ КОТОРОЕ НЕ СРАБАТЫВАЕТ
procedure TfmChat.ssReceive(Sender: TObject;Buf: PAnsiChar;var DataLen: Integer);
var id: String;
p: TRichEdit;
ms: TStrings;
begin
id := IntToStr(StrToInt(Copy(Buf,1,3)));
ShowMessage(Buf);
p := pgcChat.FindComponent('rd'+(id)) as TRichEdit;
if Assigned(p) then
begin
ShowMessage(p.name);
AddColoredLine(p,lstUsr.Items[fmAdmin.lstLogId.IndexOf(id)]+'('+DateTimeToStr(Now)+')',clRed);
P.SelStart := Length(p.Text);
P.SelAttributes.Color := clBlack;
ms.Text := copy(Buf,4,DataLen);
p.Lines.AddStrings(ms);
ScrollToEnd(p);
end;
end;
Вопрос почему и как реализовать срабатывание сообщения на получение пакета((
|