Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
IdTCPServer Freeze on Delphi
#1
Hello,
I did a test for IdTCPServer and Client.
The results differed slightly and were interesting.

TCPServer test on Delphi, after 1500+ client connected then freeze,
But lazarus is works fine

Same code same component(Indy10), different result!!!

Test PC Windows 10 64 Bit
Delphi 10.3 Community vs Lazarus 2.0.8 (fpc 3.0.4)
And Delphi 7 same result freeze(Thread creation error)

   

Code:
//Server side code
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  IdContext, IdTCPServer, IdCustomTCPServer;

type

  { TForm1 }

  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  List : TIdContextList;
begin
  ListBox1.Items.BeginUpdate;
  try
    ListBox1.Items.Add(AContext.Binding.PeerIP +':'+ AContext.Binding.PeerPort.ToString);
  finally
    ListBox1.Items.EndUpdate;
  end;

  if IdTCPServer1.Active then
  begin
    List := IdTCPServer1.Contexts.LockList;
    try
      Form1.Caption := 'Server - Client : '  +  List.Count.ToString;
    finally
      IdTCPServer1.Contexts.UnlockList;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.Active := True;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  n1: Integer;
begin
  n1 := ListBox1.Items.IndexOf(AContext.Binding.PeerIP +':'+ AContext.Binding.PeerPort.ToString);
  if n1 > -1 then
    ListBox1.Items.Delete(n1);
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  data: string;
begin
  data := AContext.Connection.IOHandler.ReadLn;

  if data= 'E' then
    AContext.Connection.Disconnect;
end;

end.
Code:
//Client side code
unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    edtIP: TEdit;
    edtPort: TEdit;
    Button1: TButton;
    Button2: TButton;
    edtClient: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    a: Array[1..10000] Of TIdTCPClient;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var
  I:integer;
begin
  for  I := 1 to StrToInt(edtClient.Text) do
  begin
    try
      a[I] := nil;

      a[I]:= TIdTCPClient.Create( NIL );
      a[I].Host := edtIP.Text;
      a[I].Port := StrToInt(edtPort.Text);
      a[I].Connect;
      a[I].IOHandler.WriteLn( 'main|ADDNEW|1234abcd|' + IntToStr(i) + ' |t2|t3|t4|t5|t6|t7|t8|NEW' );
      Self.Caption:= 'Clients  : ' + IntToStr(i);
      Sleep(10);
      Application.ProcessMessages;
    except

    end;
  end;
end;

end.
Reply


Messages In This Thread
IdTCPServer Freeze on Delphi - by 3ddark - 04-18-2020, 08:30 PM
RE: IdTCPServer Freeze on Delphi - by rlebeau - 04-18-2020, 09:37 PM
RE: IdTCPServer Freeze on Delphi - by 3ddark - 04-19-2020, 11:48 AM
RE: IdTCPServer Freeze on Delphi - by rlebeau - 04-20-2020, 07:11 PM
RE: IdTCPServer Freeze on Delphi - by TangoEcho - 01-28-2022, 02:24 PM
RE: IdTCPServer Freeze on Delphi - by 3ddark - 04-21-2020, 08:39 AM
RE: IdTCPServer Freeze on Delphi - by rlebeau - 04-21-2020, 06:05 PM
RE: IdTCPServer Freeze on Delphi - by 3ddark - 04-22-2020, 05:59 AM
RE: IdTCPServer Freeze on Delphi - by 3ddark - 04-23-2020, 01:57 PM
RE: IdTCPServer Freeze on Delphi - by rlebeau - 04-23-2020, 04:48 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)