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.
本文地址：http://com.8s8s.com/it/it5510.htm