Delphi – Indy idTCPServer e idTCPClient

Semplice esempio per utilizzare i componenti di Indy Nevrona in Delphi per creare una mini applicazione Client/Server su protocollo TCP. Per fare un semplice esempio possiamo pensare ad un applicazione client che invia una stringa ad un applicazione Server la quale torna a sua volta la stringa al client. Per complicarci un attimo la vita al posto di classiche stringhe utilizzeremo degli Stream (almeno nel caso si volesse fare un trasferimento di files si potrebbe già utilizzare l’esempio).
Nell’esempio per facilitarci la vita utilizzeremo la classe TStringStream che è un discendente della classe TStream che permette facilmente di gestire il contenuto dello stream come fosse una stringa.

Partiamo con l’applicazione Server , per crearla potremmo semplicemente creare una nuova applicazione con Delphi e trascinarci su il componente TidTCPServer , decidiamo che porta TCP occupare con il ns servizio , nel ns caso la 9099 , ora il sorgente della ns. form , per comodità metteremo un paio di listbox sul form per i messaggi:

 
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.

L’applicazione client sarà adirittura più semplice, allo stesso modo creiamo con il ns ambiente un’altra applicazione , ci trasciniamo il componente TidTCPClient al quale assegneremo alla proprietà “hosts” l’indirizzo ip (o dns) del ns server ed alla proprietà “port” lo stesso valore del server (nel ns caso 9099) :

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.