Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль

Купить рекламу на форуме 15-35 тыс рублей в месяц

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы Поиск в этой теме
Старый 02.09.2011, 22:59   #1
werrey
Форумчанин
 
Регистрация: 01.02.2011
Сообщений: 105
По умолчанию Доработка Client-Server

Здравствуйте.
Помогите пожалуйста доработать.

Решил переделать под себя чей-то пример клиент-сервер приложения.
У меня несколько вопросов:

1. Когда я запускаю несколько клиентов для проверки работы с сервером, то всё нормально вроде, а вот если запустить 42 раза, то почему-то пропадают все 'Ники' во всех клиентах в ListView,(хотя на сервере видны).
В чем ошибка в коде?

2.Как сделать, чтобы было видно последнее сообщение в RichEdit, когда он полностью заполнен? Сейчас сообщение добавляется за пределы нижней части,и видно только, если использовать скролл.

Будет ли такой клиент-сервер нормально работать, без каких либо непредвиденных ошибок?



Код не влезает,вот сам проект:
Вложения
Тип файла: rar C-S.rar (1.13 Мб, 24 просмотров)

Последний раз редактировалось werrey; 02.09.2011 в 23:12.
werrey вне форума Ответить с цитированием
Старый 03.09.2011, 20:46   #2
werrey
Форумчанин
 
Регистрация: 01.02.2011
Сообщений: 105
По умолчанию

Клиент:
Код:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, ImgList, StdCtrls, ComCtrls, Buttons, client, XPMan,
  ExtCtrls, ToolWin, Menus;

type
  TForm2 = class(TForm)
    ImageList1: TImageList;
    ClientSocket2: TClientSocket;
    Button1: TButton;
    SendBitBtn: TBitBtn;
    TextEdit: TEdit;
    Button3: TButton;
    ChatRichEdit: TRichEdit;
    UserListView: TListView;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ClientSocket2Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket2Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket2Read(Sender: TObject; Socket: TCustomWinSocket);

    procedure ShowColorMassage(msg: String; index: Byte);
    procedure Button1Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);
    procedure SendBitBtnClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;



  Type
  TUserList = object
  Status: Byte;    // 1 - сервер, 2 - клиент
  Rec: Boolean;    // отметка записи пользователя в список
  Name: String;    // имя (ник)
  Image: Byte;     // индекс иконки
 end;


var
  Form2: TForm2;
  Nik:string;
  i, j, com, ContList: Byte;
  len, poss, x: Word;
  txt: String;
  UpdDo: Boolean;
  Buf: array[0..3] of Byte;
  UItems: TListItem;
  threadvar
  FontName, FontSize, FontColor: String;


implementation



{$R *.dfm}
werrey вне форума Ответить с цитированием
Старый 03.09.2011, 20:47   #3
werrey
Форумчанин
 
Регистрация: 01.02.2011
Сообщений: 105
По умолчанию

Продолжение клиента:
Код:
procedure TForm2.FormCreate(Sender: TObject);
    begin
      //очистим поля
        TextEdit.Clear;
        ChatRichEdit.Clear;

    end;



procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClientSocket2.Close;

end;

procedure TForm2.SendBitBtnClick(Sender: TObject);

var
    i:integer;
    TabSheet: TTabSheet;
    Memo: TMemo;
    ToolBar: TToolBar;
    iCompCount: Integer;
begin
  if TextEdit.Text<>'' then
    begin
       

          // отправляем сообщение для всех
          ClientSocket2.Socket.SendText('00119'
                                       +FontName
                                       +FontSize
                                       +FontColor
                                       +'['+TimeToStr(Time)
                                       +']  '+Nik
                                       +':  '+TextEdit.Text);
          // отобразим сообщение в ChatRichEdit
          ShowColorMassage('00119'
                           +FontName
                           +FontSize
                           +FontColor
                           +'['+TimeToStr(Time)
                           +']  '+Nik
                           +':  '+TextEdit.Text, 0);

          // очищаем TextEdit
         //  TextEdit.Clear;

    TextEdit.Clear;

 end;
end;



procedure TForm2.ShowColorMassage(msg: String; index: Byte);
begin
// работаем с полем чата
  With ChatRichEdit do
    Begin
// переход на новую строку
      Lines.Add('');
// название шрифта
      SelAttributes.Name:='Tachoma';
// размер шрифта
      SelAttributes.Size:=8;
// цвет текста
      SelAttributes.Color:=clblue;
// условия применения стиля к тексту
      If index = 0 then SelAttributes.Style := [];        // обычный (сообщения)
// добавляем текст сообщение в поле чата, только его содержательную часть
      SelText:=Copy(msg,6,Length(msg)-5);
    end;
end;


procedure TForm2.ClientSocket2Connect(Sender: TObject;
  Socket: TCustomWinSocket);

 Begin
// добавим в ChatRichEdit сообщение о соединении с сервером
  ShowColorMassage('00119['+TimeToStr(Time)+']  К серверу подключен.', 0);
  end;

procedure TForm2.ClientSocket2Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
// добавим в ChatRichEdit сообщение о потере связи
  ShowColorMassage('00119['+TimeToStr(Time)+']  От сервера отключился.', 0);
  UserListView.Clear;
  button1.Enabled:=true;
  button3.Enabled:=false;
  
end;

procedure TForm2.ClientSocket2Read(Sender: TObject; Socket: TCustomWinSocket);

begin
// получим текст, код комманды, длину строки
  txt:=Socket.ReceiveText();
  com:=StrToInt(Copy(txt,1,1));
  len:=Length(txt)-1;

// определение комманд
  Case com of
// добавим в ChatRichEdit сообщение с сервера
    0: ShowColorMassage(txt, 0);
// отошлем свой ник на сервер
    1: ClientSocket2.Socket.SendText('1'+Nik);
// примем строку списка пользователей
    2: Begin
// очищаем список клиентов
         UserListView.Items.Clear;
// добавим ключ конца строки (т.к. вырезка символов с задержкой)
         txt:=txt+Chr(152);
// укажем начальный символ
         poss:=2;
// обнулим счетчик символов
         x:=0;
// пробегаем по длине строки списка
         For j:=2 to len+1 do
           Begin
// записываем в счетчик сдвиг
             x:=x+1;
// если найден ключ (отделение ников в строке)
             If Copy(txt,j,1)= Chr(152) then
               Begin
// добавим в UserListView строку

                 UItems:=UserListView.Items.Add;
                 UItems.Caption:=Copy(txt,poss,x-1);
// укажем соответствующую иконку пользователя
                 If poss>2 then UItems.ImageIndex:=0
                      else
                          UItems.ImageIndex:=1;
// изменим текущую позицию в строке списка
                 poss:=j+1;
// обнулим счетчик символов
                 x:=0;
               end;
               end;
               end;
               end;
               end;


 //Подключаемся к серверу
procedure TForm2.Button1Click(Sender: TObject);
  begin
    //Присваиваем названию формы и нику имя пользователи
      Nik:=Edit1.Text;
      Form2.Caption:=Nik;
    // запишем указанный порт в ClientSocket
     ClientSocket2.Port:=7777;
// запишем хост и адрес (одно значение HostEdit в оба)
     ClientSocket2.Host:='127.0.0.1';
      ClientSocket2.Address:='127.0.0.1';
// запускаем клиента
     ClientSocket2.Active:=True;
      Button1.Enabled:=false;
      Button3.Enabled:=True;
  end;

 //Отключаемся от  сервера
procedure TForm2.Button3Click(Sender: TObject);
  begin
    button3.Enabled:=false;
    ClientSocket2.Active:=False;
    button1.Enabled:=true;
  end;

end.

Последний раз редактировалось werrey; 04.09.2011 в 12:40.
werrey вне форума Ответить с цитированием
Старый 03.09.2011, 20:48   #4
werrey
Форумчанин
 
Регистрация: 01.02.2011
Сообщений: 105
По умолчанию

Сервер:
Код:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMan, StdCtrls, ScktComp, ExtCtrls, ImgList, ComCtrls, Buttons, Menus, ToolWin;

type
  TForm2 = class(TForm)
    SS2: TServerSocket;
    ImageList1: TImageList;
    SpeedButton4: TSpeedButton;
    SendBitBtn: TBitBtn;
    TextEdit: TEdit;
    ChatRichEdit: TRichEdit;
    UserListView: TListView;
    procedure UpdateUserList;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SS2ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure SS2ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);

    procedure SendBitBtnClick(Sender: TObject);
    procedure ShowColorMassage(msg: String; index: Byte);

    procedure FormShow(Sender: TObject);
    procedure UserListViewContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure SS2ClientRead(Sender: TObject; Socket: TCustomWinSocket);


private

    Receive: boolean; // Режим клиента

  public
    { Public declarations }
  end;
type

  TUserList = class(TObject)
  public
    Name: ShortString;    // имя (ник)
    Image: Byte;          // индекс иконки
  end;

var

  Form2: TForm2;
  ContList: Byte;
  len, poss, x: Word;
  PrivateUser: String;
  Buf: array[0..3] of Byte;
  Niks: string;
  threadvar
  FontName, FontSize, FontColor: String;
  NikLS:string;

implementation



{$R *.dfm}
werrey вне форума Ответить с цитированием
Старый 03.09.2011, 20:50   #5
werrey
Форумчанин
 
Регистрация: 01.02.2011
Сообщений: 105
По умолчанию

Продолжение сервера:
Код:
procedure TForm2.FormCreate(Sender: TObject);
begin
// введем ник по-умолчанию, остальные поля просто очистим
      TextEdit.Clear;
  // запишем указанный порт в ServerSocket
       SS2.Port:= 7777;
   // запускаем клиента
      TextEdit.Clear;
      ChatRichEdit.Lines.Clear;
  Receive := false; // Режим приём команд
end;


procedure TForm2.FormShow(Sender: TObject);
var UItems: TListItem;
begin
      Niks:='Сервер';   {присваемый ник сервера по его логину}
      SS2.Port:= 7777;             {запишем указанный порт в ServerSocket}
      SS2.Active:=True;           {запускаем сервер}

// добавим в ChatRichEdit сообщение с временем создания

      ShowColorMassage('00119['+TimeToStr(Time)+']  Сервер создан.', 0);
// изменяем тэг
      SpeedButton4.Tag:=1;
// меняем надпись клавиши
      SpeedButton4.Caption:='Закрыть сервер';

// очищаем список клиентов
  UserListView.Items.Clear;
// очищаем переменную
  UItems:=UserListView.Items.Add;
  UItems.Caption:=Niks;
  UItems.ImageIndex:=1;
end;


procedure TForm2.ShowColorMassage(msg: String; index: Byte);
begin
// работаем с полем чата
  With ChatRichEdit do
    Begin
// переход на новую строку
      Lines.Add('');
// название шрифта
      SelAttributes.Name:='Tachoma';
// размер шрифта
      SelAttributes.Size:=8;
// цвет текста
      SelAttributes.Color:=clblue;
// условия применения стиля к тексту
      If index = 0 then SelAttributes.Style := [];        // обычный (сообщения)

// добавляем текст сообщение в поле чата, только его содержательную часть
      SelText:=Copy(msg,6,Length(msg)-5);
    end;
end;


procedure TForm2.UpdateUserList;
var i:integer;
    UItems: TListItem;
    StrUserList:string;
begin
// очищаем список клиентов
  UserListView.Items.Clear;
// очищаем переменную
  UItems:=UserListView.Items.Add;
  UItems.Caption:=Niks;
  UItems.ImageIndex:=1;
  StrUserList:=Niks+Chr(152);
  For i:=0 to SS2.Socket.ActiveConnections-1 do
  Begin
    if SS2.Socket.Connections[i].data<>nil then
    begin
      UItems:=UserListView.Items.Add;
      UItems.Caption:=TUserList(SS2.Socket.Connections[i].data).Name;
      UItems.ImageIndex:=TUserList(SS2.Socket.Connections[i].data).Image;
      StrUserList:=StrUserList+TUserList(SS2.Socket.Connections[i].data).Name+Chr(152);
    end;
  end;
  For i:=0 to SS2.Socket.ActiveConnections-1 do
  begin
    // отправим строку списка пользователей (код команды - 2)
    SS2.Socket.Connections[i].SendText('2'+StrUserList);
  end;
end;

procedure TForm2.SpeedButton4Click(Sender: TObject);
  begin
    If SpeedButton4.Tag=1 then
      Begin
        // разрешаем обновление
        UpdateUserList;
        // очищаем список клиентов
        UserListView.Items.Clear;
        // закрываем сервер
        SS2.Active:=False;
        // выводим сообщение в ChatRichEdit

        ShowColorMassage('00119['+TimeToStr(Time)+']  Сервер закрыт.', 2);
        // возвращаем тэгу исходное значение
        SpeedButton4.Tag:=0;
        // возвращаем исходную надпись клавиши
        SpeedButton4.Caption:='Включить сервер';
      end
        else
            Begin
              // запишем указанный порт в ServerSocket
              SS2.Port:=7777;
              // запускаем сервер
              SS2.Active:=True;
              // добавим в ChatRichEdit сообщение с временем создания

              ShowColorMassage('00119['+TimeToStr(Time)+']  Сервер создан.', 2);
              // изменяем тэг
              SpeedButton4.Tag:=1;
              // меняем надпись клавиши
              SpeedButton4.Caption:='Закрыть сервер';
              // разрешаем обновление
              UpdateUserList;
            end;
  end;

procedure TForm2.SS2ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
  var
    d:TUserList;
  begin
    // добавим в ChatRichEdit сообщение с временем подключения клиента

        ShowColorMassage('00119['+TimeToStr(Time)+']  Подключился клиент.', 2);
    // разрешаем обновление
        d:=TUserList.Create;
        d.Name:='';
        d.Image:=0;
        Socket.Data:=TObject(d);
        Socket.SendText('1');
    end;

procedure TForm2.SS2ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
    var
      j,ind:integer;
    begin
    // добавим в ChatRichEdit сообщение с временем отключения клиента

      ShowColorMassage('00119['+TimeToStr(Time)+']  Клиент отключился.', 2);
      ChatRichEdit.Lines.Add('Пользователь: ' + TUserList(Socket.Data).Name + '. Host: ' + Socket.RemoteHost + '. IP: ' +Socket.RemoteAddress);
    // разрешаем обновление
      ind:=-1;
      For j:=0 to SS2.Socket.ActiveConnections-1 do
          Begin
              if Socket=SS2.Socket.Connections[j]
              then
                ind:=j;
          end;

        TUserList(Socket.Data).Free;
        Socket.Data:=nil;
        UpdateUserList;

  end;
werrey вне форума Ответить с цитированием
Старый 03.09.2011, 20:51   #6
werrey
Форумчанин
 
Регистрация: 01.02.2011
Сообщений: 105
По умолчанию

Продолжение сервера:
Код:
procedure TForm2.UserListViewContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
var liSelected: TListItem;
begin
  liSelected := UserListView.GetItemAt(MousePos.X, MousePos.Y);
  if (liSelected=nil) or (liSelected.Caption = Niks) then
    begin
      Handled := true;
    end;
end;


procedure TForm2.SendBitBtnClick(Sender: TObject);
var i: integer;
    TabSheet: TTabSheet;
    Memo: TMemo;
    ToolBar: TToolBar;
    iCompCount: Integer;
begin
  if TextEdit.Text<>'' then
    begin
        // отправляем сообщение с сервера всем пользователям
          For i:=0 to SS2.Socket.ActiveConnections-1 do
            Begin
              SS2.Socket.Connections[i].SendText('00119'+FontName  // 1 байт - шрифт
                                                    +FontSize  // 1 байт - размер
                                                    +FontColor // 2 байта - цвет
                                                    +'['+TimeToStr(Time)
                                                    +']  '+Niks
                                                    +':  '+TextEdit.Text);
                                                   end;
              // отобразим сообщение в ChatRichEdit
              ShowColorMassage('00119'
                               +FontName
                               +FontSize
                               +FontColor
                               +'['+TimeToStr(Time)
                               +']  '+Niks
                               +':  '+TextEdit.Text, 0);
              TextEdit.Clear;


      end;
  end;



procedure TForm2.SS2ClientRead(Sender: TObject; Socket: TCustomWinSocket);

    var
      count,b,j:integer;
      com:Byte;
      txt:string;

      iCount, iCompCount: Integer;

  begin
    Application.ProcessMessages;
    txt:=Socket.ReceiveText();

                If txt<>'' then                  // условие, что пакет не пуст
            Begin
              com:=StrToInt(Copy(txt,1,1));      // получим код комманды
              len:=Length(txt)-1;                // получим длину строки

              Case com of                        // определение комманд
// код приема сообщения --------------------------------------------------------
                0: Begin
// добавим в ChatRichEdit сообщение клиента
                     ShowColorMassage(txt, 0);
// разошлем сообщение пользователям (кроме того, кто прислал)
                     For j:=0 to SS2.Socket.ActiveConnections-1 do
                       Begin
                         if Socket<>SS2.Socket.Connections[j] then
                            SS2.Socket.Connections[j].SendText(txt);
                       end;
                   end;
// -----------------------------------------------------------------------------
// код приема ника клиента -----------------------------------------------------
                1: Begin
                     TUserList(Socket.Data).Name:=Copy(txt,2,len);    // запишем в массив полученный ник
                     ChatRichEdit.Lines.Add('Пользователь: ' + TUserList(Socket.Data).Name + '. Host: ' + Socket.RemoteHost + '. IP: ' +Socket.RemoteAddress);
                     TUserList(Socket.Data).Image:=0;                 // Присвоим картинку для клиента в
                     UpdateUserList;                                  // обновляем список
                   end;
             end;
        end;
  end;


end.

Помогите пожалуйста доработать приложение.

Последний раз редактировалось werrey; 03.09.2011 в 20:53.
werrey вне форума Ответить с цитированием
Ответ
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Server-Client приложения Яшар Общие вопросы Delphi 4 20.06.2011 12:10
[c++] Client-Server: GET request refused by the server Pumych Помощь студентам 2 22.08.2010 23:36
Client-Server на 500+ пользователей. Mixasik Работа с сетью в Delphi 8 22.08.2008 12:01
Помогите разобраться с client-server fLytarget Работа с сетью в Delphi 2 11.08.2008 16:00
Client и Server Роман Радер Работа с сетью в Delphi 11 10.07.2008 15:24