Indy Client / Server 程序示例
by Mats Asplund 翻译：菩提葡萄
re-printed with permission of the author
original source from http://go.to/masdp
简介
这是一个使用Indy控件实现的Client/Server应用示例，分为客户/服务器两个程序。
当一个客户端连接到服务端程序时，服务端程序将返回一个0－9的标识符给客户端，并用一个小方块表示客户端程序的工作状态，而客户端程序每5秒钟改变一次工作状态（”工作/空闲“"working / idle"）。当客户端断开时相应的方块将不可见，它的ID号也将释放并会分配给下一个连接上来的客户端程序。如果连接的客户端超过十个，服务器将返回一个”Full“标识给新连接上来的客户端。
Indy 组件是一套开放源代码的Blocking模式Socket组件，可以从这里免费下载：
www.nevrona.com/indy.
本示例程序可在这里下载
{----------------------------------------------------------------------
Unit Name: sUnit
Author: Mats Asplund, 2001-11-09
Purpose: Indy client/server示例, 服务器部分
----------------------------------------------------------------------}
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
// 读信息
ClientMsg := ReadLn(´´, -2);
// 如果客户端断开连接，则从ClintList中删除之
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
// 否则按客户端状态更新图块
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
// 取第一个空闲的标识
if (ClientList.IndexOf(IntToStr(n)) = -1) then
begin
ClientList.Add(IntToStr(n));
// 将标识返回到客户端
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
// 建立十个不可见的块图
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示例, 客户端部分
----------------------------------------------------------------------}
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;
// 连接到服务器
with IdTCPClient1 do
begin
Host:= Edit1.Text;
Connect;
// 读服务器返回的标识
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.