unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, ExtCtrls, IdException;

type
  TfrmClient = class(TForm)
    GroupBox1: TGroupBox;
    txtChat: TMemo;
    txtMessage: TEdit;
    cmbSend: TButton;
    lstUsers: TListBox;
    GroupBox2: TGroupBox;
    txtServer: TEdit;
    Label1: TLabel;
    cmbConnect: TButton;
    txtUser: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    TCPClient: TIdTCPClient;
    Timer1: TTimer;
    procedure cmbConnectClick(Sender: TObject);
    procedure cmbSendClick(Sender: TObject);
    procedure lstUsersDblClick(Sender: TObject);
    procedure TCPClientConnected(Sender: TObject);
    procedure TCPClientDisconnected(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmClient: TfrmClient;

implementation

{Процедура осуществляет манипулиции при подключении к серверу}
procedure Connect();
begin
  with frmClient do
  begin
    cmbConnect.Caption := 'Отключиться';
    txtUser.Enabled := False;
    txtServer.Enabled := False;

    Caption := 'Разговорник [' + txtUser.Text + ' подключен к '
     + txtServer.Text + ']';

    lstUsers.Enabled := True;
    cmbSend.Enabled := True;
    txtMessage.Enabled := True;
  end;
end;

{Процедура осуществляет манипуляции при отключении отсервера}
procedure Disconnect();
begin
  with frmClient do
  begin
    cmbConnect.Caption := 'Подключиться';
    txtUser.Enabled := True;
    txtServer.Enabled := True;

    Caption := 'Разговорник';

    lstUsers.Enabled := False;
    lstUsers.Clear;
    cmbSend.Enabled := False;
    txtMessage.Enabled := False;
  end;
end;

{Процедура обрабатывает сообщение от севера}
procedure ProcessMessage(strMessage: string);
var
  strAction: string;  //Тип сообщения (префикс сообщения)
  len: Integer;       //Длина строки strAction
begin
  //Определим тип сообщения и выполним соответствующие действия
  len := Pos(':', strMessage);
  strAction := Copy(strMessage,1,len-1);
  Delete(strMessage,1,len);
  if (strAction = 'ok') then
  begin
    //Регистрация пользователя завершена - можно отправлять сообщения
    Connect;
  end
  else if (strAction = 'error') then
  begin
    //Ошибка!!!
    frmClient.TCPClient.Disconnect;
    Disconnect;
    MessageDlg(strMessage, mtError, [mbOK], 0);
  end
  else if (strAction = 'adduser') then
  begin
    //К разговору присоединился новый пользователь
    frmClient.lstUsers.Items.Add(strMessage);
  end
  else if (strAction = 'deluser') then
  begin
    //Какой-то пользователь отсоединился
    frmClient.lstUsers.Items.Delete(
    frmClient.lstUsers.Items.IndexOf(strMessage));
  end
  else begin
    //Покажем принятое сообщение
    frmClient.txtChat.Lines.Add(strMessage);
  end;
end;

{
 ******************************************************************************
 * Далее идут процедуры обработки сообщений                                   *
 ******************************************************************************
}

{$R *.dfm}

procedure TfrmClient.cmbConnectClick(Sender: TObject);
begin
  if (cmbConnect.Caption = 'Подключиться') then
  begin
    //Проверим, чтобы были введены имя сервера и имя пользователя
    if (txtServer.Text = '')then
    begin
      MessageDlg('Введите имя сервера в текстовое поле.',
       mtInformation, [mbOK], 0);
      Exit;
    end
    else if (txtUser.Text = '')then
    begin
      MessageDlg('Введите имя пользователя в текстовое поле.',
       mtInformation, [mbOK], 0);
      Exit;
    end;

    //Пытаемся подключиться к серверу
    try
      TCPClient.Host := txtServer.Text;
      TCPClient.Connect;
    except
      MessageDlg('Не удается соединиться с сервером',mtError, [mbOK], 0);
    end;
  end
  else
    //Отключаемся от сервера
    TCPClient.Disconnect;
end;

procedure TfrmClient.cmbSendClick(Sender: TObject);
begin
  if (txtMessage.Text <> '') then
  begin
    //Отправка сообщения всем собеседникам
    TCPClient.WriteLn('text:' + txtMessage.Text);
    txtMessage.Text := '';
    txtMessage.SetFocus;
  end;
end;

procedure TfrmClient.lstUsersDblClick(Sender: TObject);
begin
  if ((lstUsers.ItemIndex >= 0) and (txtMessage.Text <> '')) then
  begin
    //Отправим сообщение только для выбранного собеседника
    //(сообщение вида "имя_собеседника:текст_сообщения")
    TCPClient.WriteLn(lstUsers.Items.Strings[lstUsers.ItemIndex] +
     ':' + txtMessage.Text);
    txtMessage.SetFocus;
  end;
end;

procedure TfrmClient.TCPClientConnected(Sender: TObject);
begin
  //Отправляем на сервер имя пользователя
  TCPClient.WriteLn('name:' + txtUser.Text);
end;

procedure TfrmClient.TCPClientDisconnected(Sender: TObject);
begin
  //Оформим форму для отсоединенного от сервера состояния
  Disconnect;
end;

procedure TfrmClient.Timer1Timer(Sender: TObject);
var strMessage: string;
begin
  //Проверим, нет ли для нас сообщения
  if (TCPClient.Connected)then
  begin
    try
      strMessage := TCPClient.ReadLn;
      if (strMessage <> '')then
        ProcessMessage(strMessage);
    except
      on EIdReadTimeout do ; //Ошибки таймаута игнорируем
      else
        //При остальных ошибках отсоединяемся от сервера
        TCPClient.Disconnect;
    end;
  end;
end;

end.
