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