[Vertex]

Здравствуйте.

Подскажите пожалуйста, как сделать синхронизацию VCL в Indy10 на сервере(IdTCPServer)?

Принимаю и вывожу данные от клиента на сервере так:

Код:

1 2 3 4 5 6 7

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext); var msg: string; begin   msg:= AContext.Connection.IOHandler.ReadLn(TEncoding.UTF8);   Memo1.Lines.Add(msg); end;

[lmikle]

Серверные компоненты обрабатывают приходящие данные в потоке. Соответсвенно, нужно сделать свой метод, из которого обращаться к VCL (читай, главному потоку приложения) и вызывать его через Synchronize.

[Vertex]

Спасибо, а примерчик если не трудно приведите пожалуйста, в гугле что-то не получается найти ничего внятного по этому вопросу.
В Indy10 идёт TIdContext, в нём нету метода Synchronize.

[lmikle]

Лень писать пример.
Помиотри тут примеры и идеи:
http://codeverge.com/embarcadero.del...a-form/1069509
http://codeverge.com/embarcadero.del...l-form/1062438
http://embarcadero.newsgroups.archiv...103155640.html

[Vertex]

Посмотрел, нормальных примеров не нашел. Понял что надо использовать TIdSync или TIdNotify, вроде как TIdNotify получше.
Если кто-нибудь приведёт пример, буду очень признателен.

Вопрос остаётся пока не решенным.

[Vertex]

Вот есть такой код:

Клиент:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74

unit Unit1;    interface    uses   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent, ShellApi,   IdComponent, IdTCPConnection, IdTCPClient, Vcl.ExtCtrls, IdAntiFreezeBase,   Vcl.IdAntiFreeze;    type   TForm1 = class(TForm)     Memo1: TMemo;     Edit1: TEdit;     Button1: TButton;     IdTCPClient1: TIdTCPClient;     Timer1: TTimer;     IdAntiFreeze1: TIdAntiFreeze;     Edit2: TEdit;     Button2: TButton;     Button3: TButton;     procedure Timer1Timer(Sender: TObject);     procedure FormClose(Sender: TObject; var Action: TCloseAction);     procedure Button2Click(Sender: TObject);     procedure FormCreate(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end;    var   Form1: TForm1;    implementation    {$R *.dfm}    procedure TForm1.Button2Click(Sender: TObject); // Для запуска множества клиентов, указанных в Edit2 var i: integer; begin for i:=0 to StrToInt(Edit2.Text) - 1 do begin ShellExecute(Handle, 'open', PChar(Application.ExeName), nil, nil, SW_SHOW); application.ProcessMessages; sleep(333); end; end;       procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin IdTCPClient1.Disconnect; end;       procedure TForm1.FormCreate(Sender: TObject); // Сразу подключаем клиентов, для тестирования большого кол-ва begin   IdTCPClient1.Port := 8080;   IdTCPClient1.Host := '127.0.0.1';   IdTCPClient1.Connect; end;       procedure TForm1.Timer1Timer(Sender: TObject); begin // Отправка сообщения по таймеру для теста if IdTCPClient1.Connected then IdTCPClient1.IOHandler.WriteLn('Тестирование сервера', TEncoding.UTF8);    end;    end.

Сервер_1 - (через TIdSync) :

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73

unit Unit1;   interface   uses   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdContext, IdCustomTCPServer, IdTCPServer, IdBaseComponent,   IdComponent, IdTCPConnection, IdTCPClient, Vcl.ExtCtrls, IdSync ;   type   TForm1 = class(TForm)     Memo1: TMemo;     IdTCPServer1: TIdTCPServer;     procedure FormCreate(Sender: TObject);     procedure IdTCPServer1Execute(AContext: TIdContext);   private     { Private declarations }   public     { Public declarations }   end;   type    TMySync = class(TIdSync)    protected      FMessage: string;      procedure DoSynchronize; override;    public      class procedure AddLine(const S: String);    end;     var   Form1: TForm1;   implementation   {$R *.dfm} var msg: string;   procedure TMySync.DoSynchronize;  begin    Form1.Memo1.Lines.Add(FMessage);    if Form1.Memo1.Lines.Count > 50 then Form1.Memo1.Clear;  end;   class procedure TMySync.AddLine(const S: String);  var    MySync: TMySync;  begin    MySync := TMySync.Create;    try      MySync.FMessage := S;      MySync.Synchronize;    finally      MySync.Free;    end;  end;   procedure TForm1.FormCreate(Sender: TObject); begin   IdTCPServer1.DefaultPort := 8080;   IdTCPServer1.Active := true; end;   procedure TForm1.IdTCPServer1Execute(AContext: TIdContext); var MySync: TMySync; begin   msg:= AContext.Connection.IOHandler.ReadLn(TEncoding.UTF8);   TMySync.AddLine(msg); end;   end.

Сервер_2 - (через TidNotify) :

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60

unit Unit1;   interface   uses   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdContext, IdCustomTCPServer, IdTCPServer, IdBaseComponent,   IdComponent, IdTCPConnection, IdTCPClient, Vcl.ExtCtrls, IdSync,   IdAntiFreezeBase, Vcl.IdAntiFreeze;   type   TForm1 = class(TForm)     Memo1: TMemo;     IdTCPServer1: TIdTCPServer;     IdAntiFreeze1: TIdAntiFreeze;     procedure FormCreate(Sender: TObject);     procedure IdTCPServer1Execute(AContext: TIdContext);   private     { Private declarations }   public     { Public declarations }   end;   type   TMyNotify = class(TidNotify)   private     FMyData: string;   protected     procedure DoNotify; override;   end;     var   Form1: TForm1;   implementation   {$R *.dfm}   procedure TMyNotify.DoNotify; begin  Form1.Memo1.Lines.Add(FMyData);  if Form1.Memo1.Lines.Count > 50 then Form1.Memo1.Clear; end;   procedure TForm1.FormCreate(Sender: TObject); begin   IdTCPServer1.DefaultPort := 8080;   IdTCPServer1.Active := true; end;   procedure TForm1.IdTCPServer1Execute(AContext: TIdContext); var MyNotify: TMyNotify; begin   MyNotify := TMyNotify.Create;   MyNotify.FMyData:= AContext.Connection.IOHandler.ReadLn(TEncoding.UTF8);   MyNotify.Notify; end;   end.

С клиентов к серверу идут каждые 100мс сообщения. Что первый вариант сервера, что второй их принимает и выводит в Мемо1.
Но если подключить 200 клиентов, то сервер в обоих вариантах - зависает. Так же идёт утечка памяти в обоих вариантах серверов.

Подправьте пожалуйста на этих примерах, чтобы сервер не зависал при множестве клиентов, и устранить утечку памяти.

[Vertex]

Уважаемы профессионалы!

Вы бы хоть сказали, правильно ли сделана синхронизация на сервере_1 и на сервере_2 ?

А то все пробежались мимо, и на этом нерешенный вопрос повис в воздухе.

[Vertex]

Все тормоза и зависание, а отсюда и рост памяти были из-за грёбаного грузного компонента Мемо, ни один стандартный компонент не подошел для вывода разноцветных строк, даже при рисовании на канве зависал сервер при 500 клиентах.
Выручило динамическое создание множества Label и из них сделал лист,
даже на 700 клиентах ничего не зависает и память не растёт.
Сервер через TIdSync.

[lmikle]

Не, нет у тебя там ничего, что тормозило бы. Либо ты не весь код показал. Проблема может быть только одна - отрисовка. Все-таки Memo - оконный компонент. И разные потоки могли тормозиться из-за синхронизации отрисовки.