«  
  »

Delphi and Indy idTCPServer and idTCPClient

ivan ivan.revelli@synaptica.info 19 April 2011

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.:

  1.  
  2.  
  3. unit Main_Unit_Server;
  4.  
  5. interface
  6.  
  7. uses
  8.  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  9.  Dialogs,IdBaseComponent,IdComponent,IdTCPServer,StdCtrls,Buttons,IdSocketHandle,
  10.  IdServerIOHandler,IdServerIOHandlerSocket,IdUDPBase,IdUDPServer,
  11.  IdAntiFreezeBase,IdAntiFreeze,IdMappedPortTCP,IdThreadMgr,
  12.  IdThreadMgrDefault;
  13.  
  14. type
  15.  TServer_Form = class(TForm)
  16.   TCP_Server:TIdTCPServer;
  17.   ListBox1:TListBox;
  18.   Start_Server_Button:TSpeedButton;
  19.   Stop_Server_Button:TSpeedButton;
  20.   Label1:TLabel;
  21.   Bind_IP:TEdit;
  22.   Bind_Port:TEdit;
  23.   ListBox2:TListBox;
  24.   IdAntiFreeze1:TIdAntiFreeze;
  25.   SpeedButton1:TSpeedButton;
  26.   IdThreadMgrDefault1:TIdThreadMgrDefault;
  27.   ckAutoReply:TCheckBox;
  28.   ckVideoResult:TCheckBox;
  29.   procedure FormCreate(Sender:TObject);
  30.   procedure Start_Server_ButtonClick(Sender:TObject);
  31.   procedure Stop_Server_ButtonClick(Sender:TObject);
  32.   procedure FormClose(Sender:TObject;var Action:TCloseAction);
  33.   procedure TCP_Server__Connect(AThread:TIdPeerThread);
  34.   procedure TCP_ServerExecute(AThread:TIdPeerThread);
  35.   procedure TCP_ServerNoCommandHandler(ASender:TIdTCPServer;
  36.    const AData:String;AThread:TIdPeerThread);
  37.   procedure TCP_ServerConnect(AThread:TIdMappedPortThread);
  38.   procedure SpeedButton1Click(Sender:TObject);
  39.   procedure FormCloseQuery(Sender:TObject;var CanClose:Boolean);
  40.   procedure TCP_ServerDisconnect(AThread:TIdPeerThread);
  41.  private
  42.   procedure ShowClientsConnected;
  43.   function StopTheServer:Boolean;
  44.   {Private declarations }
  45.  public
  46.   {Public declarations }
  47.   ListaClient:TList;
  48.  end;
  49.  
  50. var
  51.  Server_Form:TServer_Form;
  52.  
  53. implementation
  54.  
  55. uses IdTCPConnection;
  56.  
  57. {$R *.dfm}
  58.  
  59. procedure TServer_Form.FormCreate(Sender:TObject);
  60. begin
  61.    Top:=0;
  62.    Left:=0;
  63.    Start_Server_ButtonClick(Nil);
  64.    ListaClient:= TList.Create;
  65. end;
  66.  
  67. procedure TServer_Form.Start_Server_ButtonClick(Sender:TObject);
  68. var Loc_Binding:TIdSocketHandle;
  69. begin
  70.    if TCP_Server.Active then begin
  71.    Exit;
  72.    end;
  73.    try
  74.     TCP_Server.DefaultPort:= 9099;
  75.     TCP_Server.Active:=True;
  76.     if ListBox1.Items.Count>10
  77.     then ListBox1.Items.Delete(0);
  78.     if TCP_Server.Active then
  79.     begin
  80.      ListBox1.Items.Add(‘Server started …. ‘+TCP_Server.Bindings.Items[0].IP+‘:’+IntToStr(TCP_Server.Bindings.Items[0].Port));
  81.     end
  82.     else
  83.     begin
  84.      ListBox1.Items.Add(‘ERROR. Cannot start server …. ‘);
  85.      Exit;
  86.     end;
  87.    except
  88.     ListBox1.Items.Add(‘ERROR. Setting-up server …. ‘);
  89.     Exit;
  90.    end;
  91.    
  92. end;
  93.  
  94.  
  95. procedure TServer_Form.Stop_Server_ButtonClick(Sender:TObject);
  96. begin
  97.    if not TCP_Server.Active then Exit;
  98.    try
  99.     TCP_Server.Active:= False;
  100.    except
  101.    end;
  102.    
  103. end;
  104.  
  105. procedure TServer_Form.FormClose(Sender:TObject;
  106.  var Action:TCloseAction);
  107. begin
  108.    if Action=caFree then begin
  109.    if TCP_Server.Active then begin
  110.     Stop_Server_ButtonClick(Nil);
  111.    end;
  112.    end;
  113. end;
  114.  
  115. procedure TServer_Form.TCP_Server__Connect(AThread:TIdPeerThread);
  116. Var s:String;
  117. begin
  118.    ShowClientsConnected;
  119.    if ListBox2.Items.Count>10
  120.     then ListBox2.Items.Delete(0);
  121.    ListBox2.Items.Add( ‘Client is connected from ‘+
  122.              AThread.Connection.Socket.Binding.IP+‘:’+
  123.              IntToStr(AThread.Connection.Socket.Binding.Port) );
  124.  
  125.    // imposto un buffer piccolo
  126.    AThread.Connection.RecvBufferSize:= 65536 div 4;
  127.    AThread.Connection.SendBufferSize:= 65536 div 4;
  128.  
  129.    ListaClient.Add(AThread);
  130.   
  131. end;
  132.  
  133. // Execute è il metodo principe ,che intercetta le chiamate dei Client
  134.  
  135. procedure TServer_Form.TCP_ServerExecute(AThread:TIdPeerThread);
  136. Var
  137.  S,Resp:String;
  138.  Data:String;
  139.  I    :Integer;
  140.  Ms   :TStringStream;
  141.  
  142. Begin
  143.  Try
  144.  Try
  145.   Data:= ”;
  146.   Ms:= nil;
  147.   Try
  148.    Ms   := TStringStream.Create(”);
  149.    Ms.Position:= 0;
  150.  
  151.    AThread.Connection.ReadStream(Ms);
  152.    Ms.Position:= 0;
  153.    Data:= Ms.DataString;
  154.    if ckVideoResult.Checked then
  155.     ListBox2.Items.Add(AThread.Connection.Socket.Binding.IP+‘–>‘+Data);
  156.   Except
  157.    On E:Exception do
  158.    Begin
  159.     ListBox2.Items.Add(‘Errore [1]:‘ +  E.Message);
  160.    End;
  161.   End;
  162.   
  163.  
  164.   If ckAutoReply.Checked then
  165.   Begin
  166.  
  167.     MS:= TStringStream.Create(‘Giovanni dice:‘ + Data);
  168.     Ms.Position:= 0;
  169.     AThread.Connection.WriteStream(MS,True,True);
  170.     Try Ms.Free;Except End;
  171.   End;
  172.     //Resp:= TClientManager(AThread.Data).CommandParser(Data,True);
  173.  Except
  174.   On E:Exception do
  175.    ListBox2.Items.Add(‘Errore [2]:‘ +  E.Message);
  176.  End;
  177.  Finally
  178.  If ms <>nil then
  179.   Try Ms.Free;Except End;
  180.  End;
  181.   
  182. end;
  183.  
  184.  
  185.  
  186. // Sending a string to all connected clients
  187. procedure TServer_Form.SpeedButton1Click(Sender:TObject);
  188. Var
  189.  i:Integer;
  190.  ms:TStringStream;
  191. begin
  192.  
  193.    try
  194.     TCP_Server.Threads.LockList;
  195.     for i:=0 to  ListaClient.Count-1 do
  196.     Begin
  197.      MS:= TStringStream.Create(‘Invio massivo dati’);
  198.      Ms.Position:= 0;
  199.      TIdPeerThread(ListaClient[i]).Connection.WriteStream(MS,True,True);
  200.      Try Ms.Free;Except End;
  201.     End;
  202.  
  203.    finally
  204.     TCP_Server.Threads.UnlockList;
  205.    end;
  206. end;
  207.  
  208. procedure TServer_Form.FormCloseQuery(Sender:TObject;
  209.  var CanClose:Boolean);
  210. begin
  211.  Try TCP_Server.Active:= False;Except End;
  212.  CanClose:= True;
  213. end;
  214.  
  215. procedure TServer_Form.TCP_ServerDisconnect(AThread:TIdPeerThread);
  216. begin
  217.  ListaClient.Remove(AThread);
  218. end;
  219.  
  220. end.
  221.  
  222.  
  223.  

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:

  1.  
  2. unit Main_Unit_Client;
  3.  
  4. interface
  5.  
  6. uses
  7.  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  8.  Dialogs,IdBaseComponent,IdComponent,IdTCPConnection,IdTCPClient,
  9.  StdCtrls,IdUDPBase,IdUDPClient,ExtCtrls,IdIntercept,IdSocks,
  10.  IdIOHandlerSocket,IdIOHandler,IdIOHandlerStream;
  11.  
  12. type
  13.  TForm1 = class(TForm)
  14.   TCP_Client:TIdTCPClient;
  15.   Label2:TLabel;
  16.   Label3:TLabel;
  17.   Host_Address:TEdit;
  18.   Host_Port:TEdit;
  19.   Connect_Button:TButton;
  20.   btnDisconnect:TButton;
  21.   ListBox1:TListBox;
  22.   Edit1:TEdit;
  23.   Button1:TButton;
  24.   ListBox2:TListBox;
  25.   pnlSemaforo:TPanel;
  26.   btnMultiSend:TButton;
  27.   ckVideoResult:TCheckBox;
  28.   Timer1:TTimer;
  29.   btn_startTimer:TButton;
  30.   procedure Connect_ButtonClick(Sender:TObject);
  31.   procedure FormCreate(Sender:TObject);
  32.   procedure btnDisconnectClick(Sender:TObject);
  33.   procedure Button1Click(Sender:TObject);
  34.   procedure TCP_ClientConnected(Sender:TObject);
  35.   procedure TCP_ClientDisconnected(Sender:TObject);
  36.   procedure btnMultiSendClick(Sender:TObject);
  37.   procedure Timer1Timer(Sender:TObject);
  38.   procedure btn_startTimerClick(Sender:TObject);
  39.  private
  40.   {Private declarations }
  41.  public
  42.   {Public declarations }
  43.  end;
  44.  
  45. var
  46.  Form1:TForm1;
  47.  
  48. implementation
  49.  
  50. {$R *.dfm}
  51. uses DateUtils;
  52.  
  53. procedure TForm1.Connect_ButtonClick(Sender:TObject);
  54. begin
  55.    if TCP_Client.Connected then begin
  56.    TCP_Client.Disconnect;
  57.    Exit;
  58.    end;
  59.    ListBox1.Clear;
  60.    ListBox2.Clear;
  61.    try
  62.     TCP_Client.Host:=Host_Address.Text;
  63.     TCP_Client.Port:=StrToInt(Host_Port.Text);
  64.     TCP_Client.Connect(1000);
  65.     ListBox1.Clear;
  66.    except
  67.     ListBox1.Items.Add(‘ERROR trapped while trying to connect’);
  68.    end;
  69. end;
  70.  
  71. procedure TForm1.FormCreate(Sender:TObject);
  72. begin
  73.    Top:=0;
  74.    Left:=Screen.Width-Width-30;
  75.    Hide;
  76.    //FormStyle:=fsStayOnTop;
  77.    Show;
  78. end;
  79.  
  80. procedure TForm1.btnDisconnectClick(Sender:TObject);
  81. begin
  82.    if TCP_Client.Connected then begin
  83.    TCP_Client.Disconnect;
  84.    end;
  85. end;
  86.  
  87. procedure TForm1.Button1Click(Sender:TObject);
  88. Var
  89.  s:String;
  90.  MS:TStringStream;
  91. begin
  92.  if TCP_Client.Connected then begin
  93.   MS:= TStringStream.Create(Edit1.Text);
  94.   MS.Position:= 0;
  95.   TCP_Client.WriteStream(MS,true,true);
  96.   MS.Position:= 0;
  97.   if ckVideoResult.Checked then
  98.     ListBox1.Items.Add(‘Sent ….:‘ + MS.DataString);
  99.   Try MS.Free;Except End;
  100.  
  101.   MS:= TStringStream.Create(”);
  102.   MS.Position:= 0;
  103.  
  104.   TCP_Client.ReadStream(MS);
  105.   MS.Position:= 0;
  106.   if ckVideoResult.Checked then
  107.    ListBox1.Items.Add(‘Recived ….:‘ + MS.DataString);
  108.   Try MS.Free;Except End;
  109.  
  110.  end;
  111. end;
  112.  
  113. procedure TForm1.TCP_ClientConnected(Sender:TObject);
  114. begin
  115.    ListBox2.Items.Add(‘On Conneted’);
  116.    pnlSemaforo.Color:= clLime;
  117. end;
  118.  
  119. procedure TForm1.TCP_ClientDisconnected(Sender:TObject);
  120. begin
  121.    pnlSemaforo.Color:= clRed;
  122. end;
  123.  
  124. procedure TForm1.btnMultiSendClick(Sender:TObject);
  125. Var
  126.  I,J:Integer;
  127.  N1,N2:TDateTime;
  128. begin
  129.  Try
  130.   I:= StrToInt(InputBox(‘Nr. di comunicazioni:‘,‘Nr. di comunicazioni:‘,’100′));
  131.  Except
  132.   I:= 10;
  133.  End;
  134.  N1:= now;
  135.  For J:=0 to I do
  136.  Button1Click(nil);
  137.  N2:= now;
  138.  
  139.  ShowMessage(‘Millisecondi totali:‘ + IntToStr(DateUtils.MilliSecondsBetween(n1,n2)) + ‘millisecondi per operazione:’ + IntToStr(DateUtils.MilliSecondsBetween(n1,n2) div I));
  140.  
  141.  
  142. end;
  143.  
  144.  
  145. procedure TForm1.Timer1Timer(Sender:TObject);
  146. Var
  147.  s:String;
  148.  MS:TStringStream;
  149. begin
  150.  if TCP_Client.Connected then
  151.  begin
  152.   Try
  153.   MS:= TStringStream.Create(”);
  154.   MS.Position:= 0;
  155.  
  156.   TCP_Client.ReadStream(MS);
  157.   MS.Position:= 0;
  158.   if ckVideoResult.Checked then
  159.    ListBox1.Items.Add(‘Recived ….:‘ + MS.DataString);
  160.   Try MS.Free;Except End;
  161.   Except
  162.   End;
  163.  
  164.  end;
  165. end;
  166.  
  167. procedure TForm1.btn_startTimerClick(Sender:TObject);
  168. begin
  169.  Timer1.Enabled:= True;
  170. end;
  171.  
  172. end.
  173.  
  174.  
GeniusLab Il Gestionale cloud facile e completo. Vai alla pagina
19 April 2011 | Tags:,,,,,, | Category:Delphi w32s,Articles | Leave a comment
«  
  »

Leave a Reply

Connect with Facebook

  

  

  

You can use these HTML tags

<a href=""title=""><abbr title=""><acronym title=""><b><blockquote cite=""><cite><code><del datetime=""><em><i><q cite=""><strike><strong>