Delphi – Indy idTCPServer and idTCPClient

by Ivan Revelli
in Delphi, Posts
on April 19, 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.:

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&gt;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&gt;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+' --&gt; '+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 &lt;&gt; 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.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

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;

procedure TServer_Form.Stop_Server_ButtonClick(Sender: TObject);

begin

if not TCP_Server.Active then Exit;

try

TCP_Server.Active := False;

except

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;

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

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;

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;

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.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

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;

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;

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;

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;

procedure TForm1.btn_startTimerClick(Sender: TObject);

begin

Timer1.Enabled := True;

end;

end.

You must be logged in to post a comment.

Delphi – Indy idTCPServer and idTCPClient

Delphi – Indy idTCPServer and idTCPClient

Leave a Reply

Ricerca Articolo

Categorie

Synaptica srl