Mega Code Archive
Indy client - server 2
<![CDATA[
Another Client/Server-application with Indy.
When a client connects, the server will send back an identity number 0-9 to the client, and show a shape which will indicate the clients condition. The client simulates a state change: "working / idle" every 5 secs. When a client disconnects the associated shape will turn invisible, and the ID-No will be free to use with another client connection. If more than ten client tries to connect, the server will send back a message that it's full, which is also presented at the client side.
Indy components are open-source and can be downloaded freely from: www.nevrona.com/indy.
If you wan't the project-files, they're here:
{-----------------------------------------------------------------------------
Unit Name: sUnit
Author: Mats Asplund, 2001-11-09
Purpose: Indy client/server demo, server-part
-----------------------------------------------------------------------------}
unit sUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPServer, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
Timer1: TTimer;
Memo1: TMemo;
Label2: TLabel;
Edit1: TEdit;
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure FormActivate(Sender: TObject);
private
ClientList: TStringList;
ClientStatus: array[0..9] of TShape;
procedure ShowClientStatus;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses IdTCPConnection;
{$R *.dfm}
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
ClientMsg: string;
begin
with AThread.Connection do
begin
// Read message
ClientMsg := ReadLn('', -2);
// If client disconnected, delete from ClientList
if Pos('disconnecting...', ClientMsg) > 1 then
begin
ClientList.Delete(ClientList.IndexOf(Copy(ClientMsg, 7, 1)));
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := false;
end
else
// else update Shape associated with client.
if Pos('working', ClientMsg) > 1 then
begin
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := true;
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Brush.Color := clLime;
end
else
begin
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := true;
ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Brush.Color := clRed;
end;
Edit1.Text := ClientMsg;
end;
ShowClientStatus;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ClientList := TStringList.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
n: integer;
begin
ClientList.Free;
for n := 0 to 9 do
ClientStatus[n].Free;
end;
procedure TForm1.ShowClientStatus;
begin
Memo1.Lines.Text := ClientList.Text;
end;
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
n: integer;
Full: boolean;
begin
with AThread.Connection do
begin
Full:= true;
for n := 0 to 9 do
// Look for first free ID-no
if (ClientList.IndexOf(IntToStr(n)) = -1) then
begin
ClientList.Add(IntToStr(n));
// Write ID-no back to Client
WriteLn(IntToStr(n));
Full:= false;
Break;
end;
if Full then WriteLn('Server full');
end;
ShowClientStatus;
end;
procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
ShowClientStatus;
end;
procedure TForm1.FormActivate(Sender: TObject);
var
n: integer;
begin
// Create ten invisible shapes
for n := 0 to 9 do
begin
ClientStatus[n] := TShape.Create(Self);
ClientStatus[n].Parent := Form1;
ClientStatus[n].Height := 10;
ClientStatus[n].Width := 10;
ClientStatus[n].Shape := stRectangle;
ClientStatus[n].Top := 35;
ClientStatus[n].Left := 8 + (15 * n);
ClientStatus[n].Visible := false;
end;
end;
end.
{-----------------------------------------------------------------------------
Unit Name: cUnit
Author: Mats Asplund, 2001-11-09
Purpose: Indy client/server demo, client-part
-----------------------------------------------------------------------------}
unit cUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
IdTCPClient1: TIdTCPClient;
Label1: TLabel;
Shape1: TShape;
Edit1: TEdit;
Label2: TLabel;
Button1: TButton;
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
ServerDown, Idle: Boolean;
ClientNo: string;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
with IdTCPClient1 do
begin
Timer1.Interval:= 5000;
// Turn off timer in case of server going down.
Timer1.Enabled:= false;
Idle:= not Idle;
if Idle then
begin
Writeln('Client' + ClientNo + ' idle...');
Shape1.Brush.Color:= clRed;
// Turn it on again
Timer1.Enabled:= true;
end
else
begin
Writeln('Client' + ClientNo + ' working...');
Shape1.Brush.Color:= clLime;
// Turn it on again
Timer1.Enabled:= true;
end;
end;
except
on E: Exception do
begin
MessageDlg('The server is down.' + #13#10 +
'Restart the client some other time.', mtError, [mbOK], 0);
LAbel1.Caption:= 'No contact with server..';
ServerDown:= true;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not ServerDown then
with IdTCPClient1 do
begin
Writeln('Client' + ClientNo + ' disconnecting...');
Disconnect;
end;
Action:= caFree;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
try
Timer1.Interval:= 1000;
Timer1.Enabled:= true;
// Connect to server
with IdTCPClient1 do
begin
Host:= Edit1.Text;
Connect;
// Read ID-no
ClientNo:= Readln('', 5000); // Timeout 5 secs
if ClientNo = 'Server full' then
begin
MessageDlg('There''s already ten clients connected. ' + #13#10 +
'Try connecting some other time !', mtWarning, [mbOK], 0);
end
else
if ClientNo = '' then
begin
Label1.Caption:= 'Client' + ClientNo + ' connection refused...';
end
else
begin
// Connection accepted by server.
ServerDown:= false;
Caption:= 'Client' + ClientNo;
Button1.Enabled:= false;
Label1.Caption:= 'Client' + ClientNo + ' connection accepted...';
end;
end;
except
on E: Exception do
begin
Label1.Caption:= 'Client' + ClientNo + ' connection refused...';
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerDown:= true;
end;
end.
]]>