Delphi – Indy idTCPServer and idTCPClient

This is a simple example for usign Nevrona Indy components in Delphi to create a small server application using TCP/IP protocol. TO simplify we can build an example where there is a Server Application that recive a string from a Client App. and then return that string to the Client , but we use streams to do that because the example can be reused to trasmit anithing else via stream.
In this example we use the TStringStream class that have TStream as ancestor and is very simple to use with strings.

Start with Delphi and create a simple form application , now we drag the TidTCPServer component on the main form , now we need to decide wich free TCP port for this service , in this app we use 9099 port. , here the simple source of Server App.:

 
unit Main_Unit_Server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, StdCtrls, Buttons, IdSocketHandle,
  IdServerIOHandler, IdServerIOHandlerSocket, IdUDPBase, IdUDPServer,
  IdAntiFreezeBase, IdAntiFreeze, IdMappedPortTCP, IdThreadMgr,
  IdThreadMgrDefault;

type
  TServer_Form = class(TForm)
    TCP_Server: TIdTCPServer;
    ListBox1: TListBox;
    Start_Server_Button: TSpeedButton;
    Stop_Server_Button: TSpeedButton;
    Label1: TLabel;
    Bind_IP: TEdit;
    Bind_Port: TEdit;
    ListBox2: TListBox;
    IdAntiFreeze1: TIdAntiFreeze;
    SpeedButton1: TSpeedButton;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    ckAutoReply: TCheckBox;
    ckVideoResult: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Start_Server_ButtonClick(Sender: TObject);
    procedure Stop_Server_ButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TCP_Server__Connect(AThread: TIdPeerThread);
    procedure TCP_ServerExecute(AThread: TIdPeerThread);
    procedure TCP_ServerNoCommandHandler(ASender: TIdTCPServer;
      const AData: String; AThread: TIdPeerThread);
    procedure TCP_ServerConnect(AThread: TIdMappedPortThread);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TCP_ServerDisconnect(AThread: TIdPeerThread);
  private
    procedure ShowClientsConnected;
    function StopTheServer: Boolean;
    { Private declarations }
  public
    { Public declarations }
    ListaClient : TList;
  end;

var
  Server_Form: TServer_Form;

implementation

uses IdTCPConnection;

{$R *.dfm}

procedure TServer_Form.FormCreate(Sender: TObject);
begin
     Top:=0;
     Left:=0;
     Start_Server_ButtonClick(Nil);
     ListaClient := TList.Create;
end;

procedure TServer_Form.Start_Server_ButtonClick(Sender: TObject);
var Loc_Binding : TIdSocketHandle;
begin
     if TCP_Server.Active then begin
      Exit;
     end;
     try
       TCP_Server.DefaultPort := 9099;
       TCP_Server.Active:=True; 
       if ListBox1.Items.Count>10
        then ListBox1.Items.Delete(0);
       if TCP_Server.Active then 
        begin
         ListBox1.Items.Add('Server started .... '+TCP_Server.Bindings.Items[0].IP+':'+IntToStr(TCP_Server.Bindings.Items[0].Port));
        end 
       else
       begin
         ListBox1.Items.Add('ERROR. Cannot start server .... ');
         Exit;
       end;
      except
       ListBox1.Items.Add('ERROR. Setting-up server .... ');
       Exit;
     end;
     
end;


procedure TServer_Form.Stop_Server_ButtonClick(Sender: TObject);
begin
     if not TCP_Server.Active then Exit;
     try
        TCP_Server.Active := False; 
     except 
     end;
     
end;

procedure TServer_Form.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
     if Action=caFree then begin
      if TCP_Server.Active then begin
       Stop_Server_ButtonClick(Nil);
      end;
     end;
end;

procedure TServer_Form.TCP_Server__Connect(AThread: TIdPeerThread);
Var s : String;
begin
     ShowClientsConnected;
     if ListBox2.Items.Count>10 
       then ListBox2.Items.Delete(0);
     ListBox2.Items.Add( 'Client is connected from '+
                         AThread.Connection.Socket.Binding.IP+':'+
                         IntToStr(AThread.Connection.Socket.Binding.Port) );

     // imposto un buffer piccolo
     AThread.Connection.RecvBufferSize := 65536 div 4;
     AThread.Connection.SendBufferSize := 65536 div 4;

     ListaClient.Add(AThread);
    
end;

// Execute è il metodo principe , che intercetta le chiamate dei Client

procedure TServer_Form.TCP_ServerExecute(AThread: TIdPeerThread);
Var
 S,Resp : String;
 Data : String;
 I      : Integer;
 Ms     : TStringStream;

Begin
 Try
  Try
   Data := '';
   Ms := nil;
   Try
     Ms     := TStringStream.Create('');
     Ms.Position := 0;

     AThread.Connection.ReadStream(Ms);
     Ms.Position := 0;
     Data := Ms.DataString;
     if ckVideoResult.Checked then
        ListBox2.Items.Add(AThread.Connection.Socket.Binding.IP+' --> '+Data);
   Except
     On E:Exception do
      Begin
       ListBox2.Items.Add('Errore [1]: ' +  E.Message);
      End;
   End;
   

   If ckAutoReply.Checked then
    Begin

        MS := TStringStream.Create('Giovanni dice : ' + Data);
        Ms.Position := 0;
        AThread.Connection.WriteStream(MS,True,True);
        Try Ms.Free; Except End;
    End;
        //Resp := TClientManager(AThread.Data).CommandParser(Data,True);
  Except
   On E:Exception do
     ListBox2.Items.Add('Errore [2]: ' +  E.Message);
  End;
 Finally
  If ms <> nil then
    Try Ms.Free; Except End;
 End;
   
end;



// Sending a string to all connected clients
procedure TServer_Form.SpeedButton1Click(Sender: TObject);
Var
  i:Integer;
  ms : TStringStream;
begin

     try
       TCP_Server.Threads.LockList;
       for i:=0 to  ListaClient.Count-1 do
        Begin
         MS := TStringStream.Create('Invio massivo dati');
         Ms.Position := 0;
         TIdPeerThread(ListaClient[i]).Connection.WriteStream(MS,True,True);
         Try Ms.Free; Except End;
        End;

      finally
       TCP_Server.Threads.UnlockList;
     end;
end;

procedure TServer_Form.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
 Try TCP_Server.Active := False; Except End;
 CanClose := True;
end;

procedure TServer_Form.TCP_ServerDisconnect(AThread: TIdPeerThread);
begin
 ListaClient.Remove(AThread);
end;

end.

The Client application is simple too, we create another app with delphi and drag the TidTCPClient specifing the same TCP port of the server and the addrres of the server :

unit Main_Unit_Client;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls, IdUDPBase, IdUDPClient, ExtCtrls, IdIntercept, IdSocks,
  IdIOHandlerSocket, IdIOHandler, IdIOHandlerStream;

type
  TForm1 = class(TForm)
    TCP_Client: TIdTCPClient;
    Label2: TLabel;
    Label3: TLabel;
    Host_Address: TEdit;
    Host_Port: TEdit;
    Connect_Button: TButton;
    btnDisconnect: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    Button1: TButton;
    ListBox2: TListBox;
    pnlSemaforo: TPanel;
    btnMultiSend: TButton;
    ckVideoResult: TCheckBox;
    Timer1: TTimer;
    btn_startTimer: TButton;
    procedure Connect_ButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnDisconnectClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TCP_ClientConnected(Sender: TObject);
    procedure TCP_ClientDisconnected(Sender: TObject);
    procedure btnMultiSendClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btn_startTimerClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses DateUtils;

procedure TForm1.Connect_ButtonClick(Sender: TObject);
begin
     if TCP_Client.Connected then begin
      TCP_Client.Disconnect;
      Exit;
     end;
     ListBox1.Clear;
     ListBox2.Clear;
     try
        TCP_Client.Host :=Host_Address.Text;
        TCP_Client.Port :=StrToInt(Host_Port.Text);
        TCP_Client.Connect(1000);
        ListBox1.Clear;
      except
        ListBox1.Items.Add('ERROR trapped while trying to connect'); 
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Top:=0;
     Left:=Screen.Width-Width-30;
     Hide;
     //FormStyle:=fsStayOnTop;
     Show;
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
     if TCP_Client.Connected then begin
      TCP_Client.Disconnect;
     end;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
  s:String;
  MS : TStringStream;
begin
 if TCP_Client.Connected then begin
    MS := TStringStream.Create(Edit1.Text);
    MS.Position := 0;
    TCP_Client.WriteStream(MS,true,true);
    MS.Position := 0;
    if ckVideoResult.Checked then
       ListBox1.Items.Add('Sent ....: ' + MS.DataString);
    Try MS.Free; Except End;

    MS := TStringStream.Create('');
    MS.Position := 0;

    TCP_Client.ReadStream(MS);
    MS.Position := 0;
    if ckVideoResult.Checked then
      ListBox1.Items.Add('Recived ....: ' + MS.DataString);
    Try MS.Free; Except End;

 end;
end;

procedure TForm1.TCP_ClientConnected(Sender: TObject);
begin
     ListBox2.Items.Add('On Conneted');
     pnlSemaforo.Color := clLime;
end;

procedure TForm1.TCP_ClientDisconnected(Sender: TObject);
begin
     pnlSemaforo.Color := clRed;
end;

procedure TForm1.btnMultiSendClick(Sender: TObject);
Var
 I,J : Integer;
 N1,N2 : TDateTime;
begin
 Try
   I := StrToInt(InputBox('Nr. di comunicazioni : ', 'Nr. di comunicazioni : ', '100'));
 Except
   I := 10;
 End;
 N1 := now;
 For J:=0 to I do
  Button1Click(nil);
 N2 := now;

 ShowMessage('Millisecondi totali: ' + IntToStr(DateUtils.MilliSecondsBetween(n1,n2)) + ' millisecondi per operazione:' + IntToStr(DateUtils.MilliSecondsBetween(n1,n2) div I));


end;


procedure TForm1.Timer1Timer(Sender: TObject);
Var
  s:String;
  MS : TStringStream;
begin
 if TCP_Client.Connected then
  begin
   Try
    MS := TStringStream.Create('');
    MS.Position := 0;

    TCP_Client.ReadStream(MS);
    MS.Position := 0;
    if ckVideoResult.Checked then
      ListBox1.Items.Add('Recived ....: ' + MS.DataString);
    Try MS.Free; Except End;
   Except
   End;

 end;
end;

procedure TForm1.btn_startTimerClick(Sender: TObject);
begin
 Timer1.Enabled := True;
end;

end.