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