Wednesday, September 17, 2008

A Real World Client Server Application in Delphi

Original Source click here

The example we used in the previous article is fine, but it can never be a real world application. It is not thread safe, and it does not identify all connected clients clearly enough. In this final part of the series, we will modify the application we have created in the earlier parts so that it can be used in the real world.
A downloadable zip file is available for this article.

So what do we mean by thread safe?

Delphi components by their very nature are not thread safe. It is therefore not advisable to try to access them from a thread-based application. For instance, a TMemo component cannot be referenced directly from an idHTTPServer objects' methods such as Get, Post or Command Other; if this is done an exception is generated and the program appears to hang.

We know from our previous discussions that all indy components are thread-based, since indy was designed around threads. So how do we make an application thread safe? Below is an example of code (from our client application) that is not thread safe:

procedureTForm1.Button1Click(Sender: TObject);

begin

 IdTCPClient1.SendCmd(edit1.text);

 memo1.Clear;

 memo1.lines.add(idtcpclient1.Socket.ReadLn);

end; 

We make our application thread safe by using thread safe classes such as the VCL's TThread class that passes information from a secondary thread to the main thread. The main thread in this case is your application.

Windows designates a thread every time you start an application. You can verify this by starting an application, for example notepad.exe, then opening up the task manager (Ctrl+Alt+Del). You will see notepad.exe on the list under processes.

In our client application, we have a tmemo component that we use to display quotes and dates in. This component is owned by the "main" thread, therefore it has direct access to this component. So there is no question of it not being thread safe.

The moment a secondary thread is introduced into this equation, and that secondary thread wants to access components owned by the main thread, you have to find a way to enable that access. Before we move on to discuss how to enable that communication between main and secondary threads, let's define what a secondary thread is. A secondary thread is any thread that runs within the main thread. So in our case, indy components, such as the idTCPServer component, will start secondary threads within our application. 

So any thread that is not the main thread is a secondary thread. Now that we got that out of the way, let's get back to what methods are used to enable the passing of information between the main and secondary threads. The VCL's TThread class contains a method called Synchronize that enables the passing of information between the main and secondary threads. We will use this method when we rewrite our previous example in a moment.

Identifying Connected Clients

Identifying connected clients might not be a big deal in most implementations of a client server application, because each client that connects to a server will have an IP address and that is all that is needed to respond to a client's request. But in other situations you will need an IP address and something else to differentiate between clients. For example, in a chat application scenario you would want to identify clients by their nicknames and not by their IP addresses, because two (or more) clients can connect from the same computer and if you do not have anything else to differentiate between them, the server application is going to send the message to both of them, instead of to just one of them.

So what can we do to remedy this situation? Well, for starters, we know that when a client connects to an indy server, the server spawns a new thread for it, and then services it within its own context. Indy has a class called "Context" that enables us to collect information about a client. What we will do then is derive a new class from the Context class that will hold information about the client for us:

Tclientinfo= class(TIdContext)

        public

            IP: String;

            name: String;

end;

This way whenever a client connects, we will collect this information and use it to identify the client. So let's rewrite our previous example and make it a robust client server application.


The Client

To make our client truly thread safe we need to solve the following two problems:

  1. Reading and processing the response from server.
  2. Displaying that information in a thread safe manner.

Currently, to read a response from the server, the client does this:

procedureTForm1.Button1Click(Sender: TObject);

begin

 IdTCPClient1.SendCmd(edit1.text);

 memo1.Clear;

 memo1.lines.add(idtcpclient1.Socket.ReadLn);

end; 

which as we've stated earlier is not thread safe.  So, to read the responses from the server we will create a thread that reads those responses. That will be its sole purpose.  It will be derived from the VCL's TThread  class:

TReadResponse= class(TThread)

        protected

            FConn: TIdTCPConnection;

            procedure Execute; override;

        public

            constructor Create(AConn: TIdTCPConnection);
reintroduce;

        end;

         TWriteResponse = class(TIdSync)

        protected

            FMsg: String;

            procedure DoSynchronize; override;

        public

            constructor Create(const AResponse: String);

            class procedure AddResponse(const AResponse: String);

        end;

There are two classes here, TReadResponse and TWriteResponse. TReadResponse contains one method and a variable. The variable will hold the connection status of the client, and the execute method is used to do the actual reading:

        while not Terminated and FConn.Connected do

        begin

            TWriteResponse.AddResponse (FConn.IOHandler.ReadLn);

        end;

You always override the execute method when you use the VCL's TThread class. This enables you to make it do whatever you want it to do. In our case, we want it to read the response from the  server.

The TWriteResponse class is primarily responsible for writing the response that the client gets from the server to the Delphi component, which in this case is the memo component:

procedure TWriteResponse.DoSynchronize;

     begin

form1. memo1.Lines.Add(FMsg);

end;

The FMsg variable is used to store the response from the server. And the DoSyncronize method is then responsible for writing that response to the memo component. The class itself is derived from the TIdSync class. TIdSync allows for synchronizations with the ability to pass parameters to the synchronized methods as well. TIdSync also allows for return values to be returned from the main thread.

Before writing the implementations of these methods, add the following to your form's variable section:

rr: TReadResponse = nil;

Your complete client code should look something like this:

unit client;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,

  IdTCPClient,IdException,idContext,idSync;

type

  TReadResponse = class(TThread)

        protected

            FConn: TIdTCPConnection;

            procedure Execute; override;

        public

            constructor Create(AConn: TIdTCPConnection); reintroduce;

        end;

  TWriteResponse = class(TIdSync)

        protected

            FMsg: String;

            procedure DoSynchronize; override;

        public

            constructor Create(const AResponse: String);

            class procedure AddResponse(const AResponse: String);

        end;

  TForm1 = class(TForm)

    IdTCPClient1: TIdTCPClient;

    Edit1: TEdit;

    Label1: TLabel;

    Memo1: TMemo;

    Button1: TButton;

    Label2: TLabel;

    Button2: TButton;

    Button3: TButton;

    Memo2: TMemo;

    Label3: TLabel;

    cname: TEdit;

    Label4: TLabel;

    procedure Button3Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure IdTCPClient1Status(ASender: TObject;

      const AStatus: TIdStatus; const AStatusText: String);

    procedure IdTCPClient1Connected(Sender: TObject);

    procedure IdTCPClient1Disconnected(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

  rr: TReadResponse = nil;

implementation

{$R *.dfm}

constructor TWriteResponse.Create(const AResponse: String);

    begin

        FMsg := AResponse;

        inherited Create;

    end;

procedure TWriteResponse.DoSynchronize;

     begin

     form1.memo1.Clear;

     form1.memo1.Lines.Add(FMsg);

end;

    class procedure TWriteResponse.AddResponse (const AResponse: String);

    begin

        with Create(AResponse) do try

            Synchronize;

        finally

            Free;

        end;

    end;

 constructor TReadResponse.Create(AConn: TIdTCPConnection);

    begin

        FConn := AConn;

        inherited Create(False);

    end;

    procedure TReadResponse.Execute;

   

    begin

        while not Terminated and FConn.Connected do

        begin

            TWriteResponse.AddResponse(FConn.IOHandler.ReadLn);

        end;

    end;

    procedure TForm1.Button3Click(Sender: TObject);

begin

close;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

 E: Exception;

begin

IdTCPClient1.Host:='localhost';

IdTCPClient1.Port:=6000;

IdTCPClient1.Connect;

try

IdTCPClient1.Socket.WriteLn(cname.Text);

except

on E: EIdException do begin

ShowMessage('Indy Exception: ' + E.Message);

end else begin

ShowMessage('VCL Exception: ' + E.Message);

end;

end;

button2.Enabled:=false;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 IdTCPClient1.IOHandler.WriteLn(edit1.text+'@'+cname.Text+';');

 end;

procedure TForm1.IdTCPClient1Status(ASender: TObject;

  const AStatus: TIdStatus; const AStatusText: String);

begin

memo2.Lines.Add(Astatustext)

end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);

begin

  rr:= TReadResponse.Create(IdTCPClient1);

end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);

begin

if rr <> nil then

        begin

            rr.Terminate;

            rr.WaitFor;

            FreeAndNil(rr);

        end;

end;

end. 


On the server side of things, we are not going to use the server application that we created earlier. Instead we are going to create a new  application that will use a different TCP/IP component. I want a new application because I want us to use the OnExecute method to power the server. You will recall from previous articles that there are two methods of programming an indy server, Command Handlers and OnExecute methods.

In our previous example we saw how to create and implement  a server application using the Command Handler method. So create a new  application and drop a idTCPServer component from the Indy Servers tab. Also drop a memo component.

First, we need to write a class that will collect client information as they connect and use that information when writing to the client:

public

            IP: String;

            cname: String;

            procedure SendResponse(const Clientname: String;
const AResponse: String);

        end;

This gives us two levels of differentiating between clients, the IP address and the client's nickname. So, if you are running a chat or IRC server, and need to ban a user, you will have two avenues in which to do it.

Next, we need to use another class to write thread safe messages. We will use the TWriteResponse class that we created earlier in the client section of the article. You already know what that class does, so I will not be explaining it here.

The next thing we need to do is make the methods of the context class available to the ClientInfo class that we created earlier. This makes it possible to (for example) add all connected clients to a context list, among other things.  So add this line to the TForm1 class definition:

constructor Create(AOwner: TComponent);override;

Then in the implementation section of the form add the following:

constructor TForm1.Create(AOwner: TComponent);

    begin

        inherited Create(AOwner);

        idTCPServer1.ContextClass := TClientinfo;

    end;

This code basically transfers all the procedures and methods of the Context class to our newly created ClientInfo class. Next, we need to fill the two variables contained within the ClientInfo class. This is done when the client connects. So click on the OnConnect event of the idtcpserver component and add the following code:

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);

begin

with TClientinfo(AContext) do

        begin

            if (Connection.Socket <> nil) then

            IP :=Connection.Socket.Binding.PeerIP;

            cname := Connection.IOHandler.ReadLn;

            if cname <> ''then

            begin

            connection.IOHandler.WriteLn('Welcome '+ cname);

            end

            else

            //Client did not send a name...

            begin           

            connection.IOHandler.WriteLn('You did not send a
name. Please send a name next time you try to connect!');

            connection.Disconnect;

            end;

end;        end;

All that happens here is that the server takes the client's IP address:

            IP :=Connection.Socket.Binding.PeerIP;

and the client's name:

            cname := Connection.IOHandler.ReadLn;

If the client does not send a name, it sends a message to the client and disconnects it:

            if cname <> ''then

            begin

            connection.IOHandler.WriteLn('Welcome '+ cname);

            end

            else

            //Client did not send a name...

            begin           

            connection.IOHandler.WriteLn('You did not send a
name. Please send a name next time you try to connect!');

            connection.Disconnect;

            end;

Now let's get down to the meat of the server program. We are still using the custom protocol that we discussed in the previous article. The protocol contains three commands, Aquote, Adate and Quit. So in order for the client to get a response from the server it will need to send one of these commands. We are going to set the OnExecute method to handle the client request. So double click on the OnExecute event of the server component and add the following code:

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);

var

thedate,request,cmd,response,AFormat,sentfrom:string;

i,j:integer;

arr:Array[1..6] of String;

begin

A

//the request from the client is received in the request var

request:=acontext.Connection.IOHandler.ReadLn;

B

// we need to break the request up into command(cmd) and sender
(sentfrom)

i:=pos('@',request);

j:=pos(';',request);

cmd:= Copy(request,1,i-1);

sentfrom := Copy(request,i+1,j-i-1);

C

  //Check which command the client sent

 if cmd='aquote' then begin

 Randomize;

  arr[1]:='I still miss my ex, but my aim is improving';

  arr[2]:='Last night I was looking up at the stars and I was
wondering, where the heck is my ceiling?';

  arr[3]:='Do Roman paramedics refer to IVs as fours?';

  arr[4]:='I can resist everything except temptation.';

  arr[5]:='There is one thing I would break up over and that is
if she caught me with another woman. I wouldn''t stand for
that.';

  arr[6]:='I''ve often thought that the process of aging could be
slowed down if it had to go through Congress.';

  i:=1+ Random(6);

 //Send the response to the client...

TClientinfo(AContext).SendResponse(sentfrom,arr[i]);

    End

D

    else

    if cmd='adate' then begin

    AFormat := 'yyyy-mm-dd hh:nn:ss';

    thedate:=FormatDateTime(AFormat, Now);

    TClientinfo(AContext).SendResponse(sentfrom,thedate);

    End

E

    else

    if cmd='quit' then begin

    TClientinfo(AContext).Connection.Disconnect;

    end

    else

F

    begin

    TClientinfo(AContext).SendResponse(sentfrom,'Unknown
Command');

    end;

end;

I've divided the code up into alphabetical sections for easy reference. Part A basically receives the request from the client. The request comes in the form

cmd@fromname;

So for example a client requesting a quote will sent a request like so:

aquote@joeblogg;

We need the name of the sender because we will sent the quote back to him or her at some stage. Section B is responsible for breaking up that request into command and sender's name. It does that by using Delphi's pos() and copy() functions:

i:=pos('@',request);

j:=pos(';',request);

cmd:= Copy(request,1,i-1);

sentfrom := Copy(request,i+1,j-i-1);

Now we have a command and a sender's name in separate variables. Now all we need to do is check which command the client sent and then respond to the client using the SendResponse() procedure. This is what sections C through E will do:

  //Check which command the client sent

 if cmd='aquote' then begin

 Randomize;

  arr[1]:='I still miss my ex, but my aim is improving';

  arr[2]:='Last night I was looking up at the stars and I was
wondering, where the heck is my ceiling?';

<snip>

 //Send the response to the client...

TClientinfo(AContext).SendResponse(sentfrom,arr[i]);

End

    if cmd='adate' then begin

    AFormat := 'yyyy-mm-dd hh:nn:ss';

    thedate:=FormatDateTime(AFormat, Now);

    TClientinfo(AContext).SendResponse(sentfrom,thedate);

    <snip>

    else

    if cmd='quit' then begin

    TClientinfo(AContext).Connection.Disconnect;

    end

When a client sends a command that is not part of our protocol it gets the following response as written in section F:

    begin

    TClientinfo(AContext).SendResponse(sentfrom,'Unknown
Command');

    end;

Throughout the response you must have noticed the

TClientinfo(AContext).SendResponse();

The SendResponse procedure has the following code:

procedure TClientInfo.SendResponse(const Clientname: String;
const AResponse: String);

    var

        List: TList;

        Context: TClientInfo;

        I: Integer;

    begin

       // FContextList is inherited from TIdContext

        List := FContextList.LockList;

        try

            for I := 0 to List.Count-1 do

            begin

                Context := TClientInfo(List[I]);

                if Context.cname = clientname then

                begin

                    try

        Context.Connection.IOHandler.WriteLn(AResponse);

  except

                    end;

                    Exit;

                end;

            end;

        finally

            FContextList.UnlockList;

        end;

        Self.Connection.IOHandler.WriteLn('this server cannot
find the client you sent the message to.');

    end;

All that this procedure does is compare the client name with the names on the internal list of the ClientInfo class. The list is contained by the Context class whose methods we have transferred to our ClientInfo class. So in effect, the ClientInfo object is now maintaining it. So all we need to do is search for the client name  on the list, and if we find it, we send the response to the client  

List := FContextList.LockList;

        try

            for I := 0 to List.Count-1 do

            begin

                Context := TClientInfo(List[I]);

                if Context.cname = clientname then

                begin

                    try

        Context.Connection.IOHandler.WriteLn(AResponse);

  except

otherwise we send an error message back to the client:

Self.Connection.IOHandler.WriteLn('this server cannot find the
client you sent the message to.');

And that is all it takes to write a fully functional, and more importantly thread safe, client server application.


The entire server code should now look something like this:


The Complete Server Code

unit ServU;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdTCPServer,

  StdCtrls,idContext, IdIntercept, IdServerInterceptLogBase,

  IdServerInterceptLogFile,idSync;

type

 TClientinfo = class(TIdContext)

        public

            IP: String;

            cname: String;

            procedure SendResponse(const Clientname: String;
const AResponse: String);

        end;

           TWriteResponse = class(TIdSync)

        protected

            FMsg: String;

            procedure DoSynchronize; override;

        public

            constructor Create(const AResponse: String);

            class procedure AddResponse(const AResponse: String);

        end;

  TForm1 = class(TForm)

    Memo1: TMemo;

    IdTCPServer1: TIdTCPServer;

    IdServerInterceptLogFile1: TIdServerInterceptLogFile;

    procedure IdTCPServer1Connect(AContext: TIdContext);

    procedure IdTCPServer1Disconnect(AContext: TIdContext);

    procedure IdTCPServer1Execute(AContext: TIdContext);

    constructor Create(AOwner: TComponent);override;

    procedure FormClose(Sender: TObject; var Action:
TCloseAction);

    procedure FormCloseQuery(Sender: TObject; var CanClose:
Boolean);

    procedure FormShow(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);

begin

with TClientinfo(AContext) do

        begin

            if (Connection.Socket <> nil) then

            IP :=Connection.Socket.Binding.PeerIP;

            cname := Connection.IOHandler.ReadLn;

            if cname <> ''then

            begin

            connection.IOHandler.WriteLn('Welcome '+ cname);

            end

            else

            //Client did not send a name...

            begin

            connection.IOHandler.WriteLn('You did not send a
name. Please send a name next time you try to connect!');

            connection.Disconnect;

            end;

end;        end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);

begin

TWriteResponse.AddResponse(TClientinfo(AContext).cname + '
Disconnected');

end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);

var

thedate,request,cmd,response,AFormat,sentfrom:string;

i,j:integer;

arr:Array[1..6] of String;

begin

//the request from the client is received in the request var

request:=acontext.Connection.IOHandler.ReadLn;

// we need to break the request up into command(cmd) and sender
(sentfrom)

//showmessage(request);

i:=pos('@',request);

j:=pos(';',request);

cmd:= Copy(request,1,i-1);

sentfrom := Copy(request,i+1,j-i-1);

//showmessage(cmd+'===>'+sentfrom);

  //Check which command the client sent

 if cmd='aquote' then begin

 Randomize;

  arr[1]:='I still miss my ex, but my aim is improving';

  arr[2]:='Last night I was looking up at the stars and I was
wondering, where the heck is my ceiling?';

  arr[3]:='Do Roman paramedics refer to IVs are fours?';

  arr[4]:='I can resist everything except temptation.';

  arr[5]:='There is one thing I would break up over and that is
if she caught me with another woman. I wouldn''t stand for
that.';

  arr[6]:='I''ve often thought that the process of aging could be
slowed down if it had to go through Congress.';

  i:=1+ Random(6);

 //Send the response to the client...

TClientinfo(AContext).SendResponse(sentfrom,arr[i]);

    end

    else

    if cmd='adate' then begin

    AFormat := 'yyyy-mm-dd hh:nn:ss';

    thedate:=FormatDateTime(AFormat, Now);

    TClientinfo(AContext).SendResponse(sentfrom,thedate);

    end

    else

    if cmd='quit' then begin

    TClientinfo(AContext).Connection.Disconnect;

    end

    else

    begin

    TClientinfo(AContext).SendResponse(sentfrom,'Unknown
Command');

    end;

end;

procedure TClientInfo.SendResponse(const Clientname: String;
const AResponse: String);

    var

        List: TList;

        Context: TClientInfo;

        I: Integer;

    begin

       // FContextList is inherited from TIdContext

        List := FContextList.LockList;

        try

            for I := 0 to List.Count-1 do

            begin

                Context := TClientInfo(List[I]);

                if Context.cname = clientname then

                begin

                    try

        Context.Connection.IOHandler.WriteLn(AResponse);

  except

                    end;

                    Exit;

                end;

            end;

        finally

            FContextList.UnlockList;

        end;

        Self.Connection.IOHandler.WriteLn('this server cannot
find the client you sent the message to.');

    end;

constructor TWriteResponse.Create(const AResponse: String);

    begin

        FMsg := AResponse;

        inherited Create;

    end;

procedure TWriteResponse.DoSynchronize;

     begin

form1.memo1.Lines.Add(FMsg);

end;

class procedure TWriteResponse.AddResponse (const AResponse:
String);

  begin

    with Create(AResponse) do try

            Synchronize;

        finally

            Free;

        end;

    end;

   constructor TForm1.Create(AOwner: TComponent);

    begin

        inherited Create(AOwner);

        idTCPServer1.ContextClass := TClientinfo;

    end;

procedure TForm1.FormClose(Sender: TObject; var Action:
TCloseAction);

begin

//idtcpserver1.Active:=false;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose:
Boolean);

begin

idtcpserver1.Active:=false;

end;

procedure TForm1.FormShow(Sender: TObject);

begin

idtcpserver1.Active:=true;

end;

end.

Conclusion

The code I use here is generic and can be applied to any client server scenario that meets the inherent requirements of a client server environment. So please use it as a template when implementing your own client server applications. I must once again thank the users at the Delphi newsgroups and also the writers of Indy in Depth who made some excellent reference material available.


0 Comments: