[zibazon]

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. и не отсылались пустые сообщения.
Буду примного благодарен.

[zibazon]

В Дэлфи практически не шарю, препод задал просто чат сделать с кучей требований.
вот я так понял код для Мемо с пункта 4

Код:

function MyGetStringFromMemo(Memo: TMemo; Index: Integer): String;
begin
  with Memo do
  Result := Lines[Prev(Lines.Count) - Index];
end;

а вот куда его вставить - хз.

http://www.delphimaster.ru/articles/sockadv/index.html

- сайт, по которому чат сделан