Home arrow Delphi-Kylix arrow Page 4 - A Real World Client Server Application in Delphi
DELPHI-KYLIX

A Real World Client Server Application in Delphi


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.

Author Info:
By: Leidago
Rating: 5 stars5 stars5 stars5 stars5 stars / 17
December 26, 2006
TABLE OF CONTENTS:
  1. · A Real World Client Server Application in Delphi
  2. · The Client
  3. · The Server
  4. · The Complete Server Code

print this article
SEARCH DEVARTICLES

TOOLS YOU CAN USE

advertisement
A Real World Client Server Application in Delphi - The Complete Server Code
(Page 4 of 4 )

The entire server code should now look something like this:

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.


DISCLAIMER: The content provided in this article is not warranted or guaranteed by Developer Shed, Inc. The content provided is intended for entertainment and/or educational purposes in order to introduce to the reader key ideas, concepts, and/or product reviews. As such it is incumbent upon the reader to employ real-world tactics for security and implementation of best practices. We are not liable for any negative consequences that may result from implementing any information covered in our articles or tutorials. If this is a hardware review, it is not recommended to open and/or modify your hardware.

blog comments powered by Disqus
DELPHI-KYLIX ARTICLES

- Loading an XML Document into the DOM
- Delphi Wrapper Classes and XML
- Delphi and the DOM
- Delphi and XML
- Internet Access: Client Service
- Finishing the Client for an Internet Access ...
- The Client for an Internet Access Control Ap...
- User Management for an Internet Access Contr...
- Important Procedures for an Internet Access ...
- Server Code for an Internet Access Control A...
- Constructing the Interface for an Internet A...
- Building a Server Application for an Interne...
- Building an Internet Access Control Applicat...
- Client Dataset: Working with Data Packets an...
- Using the Client Dataset in an N-Tiered Appl...

Dev Articles Forums 
 RSS  Articles
 RSS  Forums
 RSS  All Feeds
Weekly Newsletter
 
Developer Updates  
Free Website Content 
Contact Us 
Site Map 
Privacy Policy 
Support 



© 2003-2012 by Developer Shed. All rights reserved. DS Cluster 2 - Follow our Sitemap
Popular Web Development Topics
All Web Development Tutorials