Помогите доделать чат

zibazon · #1 03.12.2012, 16:07

http://www.fayloobmennik.net/2412630 - исходники

Сервер

Код:

unit srvmain;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ScktComp;
 
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    ServerSocket1: TServerSocket;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.Button1Click(Sender: TObject);
 var s: string;
begin
  {Çàïðàøèâàåì ïîðò}
  s := InputBox('Start chat server','Enter port:','1001');
  if s = '' then
   Exit;
  {×èñòèì þçåð ëèñò}
  ListBox1.Items.Clear;
  {Óñòàíàâëèâàåì ïîðò}
  ServerSocket1.Port := StrToInt(s);
  {Çàïóñêàåì ñåðâåð}
  try
  ServerSocket1.Open;
  except ShowMessage('Error!');
  end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  {×èñòèì þçåð ëèñò è îñòàíàâëèâàåì ñåðâåð}
  ListBox1.Items.Clear;
  if ServerSocket1.Active then
   ServerSocket1.Close;
end;
 
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
 var s: string;
     i: Integer;
begin
  {ñîõðàíÿåì â s ïðèñëàííóþ íàì ñòðîêó}
  s := Socket.ReceiveText;
  {Åñëè êòî-òî ïðèñëàë íàì ñâîå èìÿ}
  if Copy(s,1,2) = '#N' then begin
   Delete(s,1,2);
   {Äîáàâëÿåì åãî â þçåð ëèñò}
   ListBox1.Items.Add(s);
   {Çàïèñûâàåì â s êîìàíäó äëÿ ïîñûëêè íîâîãî ñïèñêà þçåðîâ}
   s := '#U';
   for i := 0 to ListBox1.Items.Count-1 do
    s := s+ListBox1.Items[i]+';';
   {...è ðàññûëàåì ýòîò ñïèñîê âñåì êëèåíòàì}
   for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
    ServerSocket1.Socket.Connections[i].SendText(s);
   Exit;
  end;
  {Åñëè êòî-òî êèíóë ñîîáùåíèå - ðàññûëàåì åãî âñåì êëèåíòàì}
  if (Copy(s,1,2) = '#M')or(Copy(s,1,2) = '#P') then begin
   for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
    ServerSocket1.Socket.Connections[i].SendText(s);
   Exit;
  end;
end;
 
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
 var i: Integer;
begin
  {Êòî-òî ïðèñîåäèíèëñÿ èëè îòñîåäèíèëñÿ? Íåò ïðîáëåì! Çàïðàøèâàåì ó âñåõ
   þçåðîâ èõ èìåíà}
  ListBox1.Items.Clear;
  for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
   ServerSocket1.Socket.Connections[i].SendText('#N');
end;
 
end.

Клиент - 1 окно

Код:

unit main;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ScktComp;
 
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Button1: TButton;
    Edit1: TEdit;
    Panel3: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    CheckBox1: TCheckBox;
    Memo1: TMemo;
    ClientSocket1: TClientSocket;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Lookup(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  nickname: string;
 
implementation
 
uses conn;
 
{$R *.DFM}
 
procedure TForm1.Button2Click(Sender: TObject);
 var do_connect: Boolean;
     host,port: string;
begin
  {Ïîêàçûâàåì îêíî óñòàíîâêè ñîåäèíåíèÿ ñ ñåðâåðîì}
  Form2 := TForm2.Create(Application);
  {do_connect = True, åñëè áûëà íàæàòà êíîïêà Connect}
  do_connect := (Form2.ShowModal = mrOk);
  {çàïîëíåíèå ïåðåìåííûõ äî òîãî, êàê ìû óíè÷òîæèì ôîðìó}
  host := Form2.Edit1.Text;
  port := Form2.Edit2.Text;
  nickname := Form2.Edit3.Text;
  {Óíè÷òîæàåì ôîðìó}
  Form2.Free;
  {Åñëè áûëà íàæàòà êíîïêà Cancel, òî óõîäèì îòñþäà}
  if not do_connect then
   Exit;
  {Åñëè ñîåäèíåíèå óæå óñòàíîâëåíî, òî îáðûâàåì åãî}
  if ClientSocket1.Active then
   ClientSocket1.Close;
  {Óñòàíàâëèâàåì ñâîéñòâà Host è Port}
  ClientSocket1.Host := host;
  ClientSocket1.Port := StrToInt(port);
  {Ïûòàåìñÿ ñîåäèíèòüñÿ}
  ClientSocket1.Open;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  {Çàêðûâàåì ñîåäèíåíèå (åñëè îíî óñòàíîâëåíî)}
  if ClientSocket1.Active then
   ClientSocket1.Close;
end;
 
procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  {Åñëè ïðîèçîøëà îøèáêà, âûâîäèì åå êîä â Memo1}
  {Insert âñòàâëÿåò ñòðîêó â óêàçàííóþ ïîçèöèþ (â äàííîì ñëó÷àå - 0 - â íà÷àëî)}
  Memo1.Lines.Insert(0,'Socket error ('+IntToStr(ErrorCode)+')');
end;
 
procedure TForm1.ClientSocket1Lookup(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  {Ñîîáùàåì î òîì, ÷òî èäåò ïîèñê õîñòà}
  Memo1.Lines.Insert(0,'Looking up for server...');
end;
 
procedure TForm1.ClientSocket1Connecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  {ñîåäèíÿåìñÿ...}
  Memo1.Lines.Insert(0,'connecting...');
end;
 
procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  {ñîåäèíèëèñü!}
  Memo1.Lines.Insert(0,'connected!');
end;
 
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  {îòñîåäèíèëèñü :(}
  Memo1.Lines.Insert(0,'disconnected');
end;
 
procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
 var s,from_,to_: string;
begin
  {ïðèñâàèâàåì s ïîëó÷åííóþ îò ñåðâåðà ñòðîêó}
  s := Socket.ReceiveText;
  {Åñëè ñåðâåð ïîñûëàåò íàì User List}
  if Copy(s,1,2) = '#U' then begin
   Delete(s,1,2);
   {×èñòèì ListBox1}
   ListBox1.Items.Clear;
   {Äîáàâëÿåì ïî îäíîìó þçåðó â ñïèñîê. Èìåíà þçåðîâ ðàçäåëåíû çíàêîì ";"}
   while Pos(';',s) > 0 do begin
    ListBox1.Items.Add(Copy(s,1,Pos(';',s)-1));
    Delete(s,1,Pos(';',s));
   end;
   Exit;
  end;
  {Åñëè íàì ïðèñëàëè îáùåå ñîîáùåíèå (âèäèìîå äëÿ âñåõ þçåðîâ)}
  if Copy(s,1,2) = '#M' then begin
   Delete(s,1,2);
   {Äîáàâëÿåì åãî â Memo1}
   Memo1.Lines.Insert(0,Copy(s,1,Pos(';',s)-1)+'> '+
                        Copy(s,Pos(';',s)+1,Length(s)-Pos(';',s)));
   Exit;
  end;
  {Åñëè íàì ïðèñëàëè çàïðîñ íà íàøå èìÿ þçåðà}
  if Copy(s,1,2) = '#N' then begin
   {Ïîñûëàåì îòâåò}
   Socket.SendText('#N'+nickname);
   Exit;
  end;
  {Åñëè íàì ïðèñëàëè ïðèâàòíîå ñîîáùåíèå (èëè íå íàì :) )}
  if Copy(s,1,2) = '#P' then begin
   Delete(s,1,2);
   {Âûäåëÿåì â to_ - êîìó îíî ïðåäíàçíà÷åíî}
   to_ := Copy(s,1,Pos(';',s)-1);
   Delete(s,1,Pos(';',s));
   {Âûäåëÿåì â from_ - êåì îòïðàâëåíî}
   from_ := Copy(s,1,Pos(';',s)-1);
   Delete(s,1,Pos(';',s));
   {Åñëè îíî äëÿ íàñ, èëè íàïèñàíî íàìè - äîáàâëÿåì â Memo1
    (èíîãäà ïîëåçíî óáðàòü ýòîò îïåðàòîð if :) )}
   if (to_ = nickname)or(from_ = nickname) then
    Memo1.Lines.Insert(0,from_+' (private) > '+s);
   Exit;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
 var s: string;
begin
  {Åñëè ìû õîòèì ïîñëàòü ïðèâàòíîå ñîîáùåíèå, íî íå âûáðàëè àäðåñàòà -
   íàñ ïîêàðàþò çàìå÷àíèåì :) è âûãîíÿò èç îáðàáîò÷èêà}
  if (CheckBox1.Checked)and(ListBox1.ItemIndex < 0) then begin
   ShowMessage('At first you should select the user in the User List!');
   Exit;
  end;
  {Åñëè ýòî ïðèâàòíîå ñîîáùåíèå}
  if CheckBox1.Checked then
   s := '#P'+ListBox1.Items[ListBox1.ItemIndex]+';' {äîáàâëÿåì ñïåö.êîìàíäó è àäðåñàò}
  else {À åñëè íå î÷åíü ïðèâàòíîå?}
   s := '#M'; {Ïðîñòî ñïåö.êîìàíäó}
  {Äîáàâëÿåì íàøå èìÿ (îò êîãî) è ñàìî ñîîáùåíèå}
  s := s+nickname+';'+Edit1.Text;
  {Ïîñûëàåì âñå ýòî äîáðî ïî ñîêåòó}
  ClientSocket1.Socket.SendText(s);
  {È ñíîâà æäåì ââîäà â óæå ÷èñòîì TEdit-å}
  Edit1.Text := '';
  ActiveControl := Edit1;
end;
 
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  {Åñëè áûëà íàæàòà Enter (äëÿ òåõ, êòî ñ ìûøàìè íå äðóæèò) - òîæå íå
   îòêàçûâàåìñÿ ïîñëàòü ñîîáùåíèå}
  if Key = VK_RETURN then
   Button1.Click;
end;
 
end.

Помогите сделать так:
1. что бы в чате отображалось время отправки сообщений,
2. уникальность порта, что б не повторялись ( я это сделал, но как то криво работает),
3. уникальность имен пользователей чата
4. что бы в поле "Мемо" клиентской части текст шел от низа к верху, а не наоборот.
5. и не отсылались пустые сообщения.
Буду примного благодарен.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты