Показать сообщение отдельно
  #6  
Старый 13.04.2015, 16:35
Vertex Vertex вне форума
Прохожий
 
Регистрация: 12.04.2015
Сообщения: 6
Версия Delphi: Delphi XE2
Репутация: 10
По умолчанию

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

Клиент:
Код:
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) :
Код:
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) :
Код:
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 клиентов, то сервер в обоих вариантах - зависает. Так же идёт утечка памяти в обоих вариантах серверов.

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