Socket通讯使用IdTCPServer

Indy的全名是Internet Direct（也叫Winshoes），它是一套开放源代码的Internet控件集，它支持大部分流行的Internet协议。 IdTCPServer 在开始工作后，首先会自动建立一个侦听线程TidListenerThread,该线程负责侦听客户端的连接请求，并对每一个服务器已接受的连接创建一个TidPeerThread线程。每个连接通过运行各自所属的TidPeerThread来实现与服务器的数据交互。IdTCPServer 该控件包含一个完整的、多线程TCP服务器。该控件使用一个或者多个线程监听（listen）客户机连接，使用时与TIdThreadMgr联合使用，将每个线程分配给与客户机连接的连接上。

//////////////////////////////////////////////////////////

Indy 是一个多线程控件，在 Server 连接的时候，针对每客户会创建一个线程,
只要有客户发送数据，就会激活 Srever 的 OnExecute 事件。 由于数据的接收是在各个为连接所建的线程中并发进行的。需要做的，就是在 OnExecute
中识别是哪个客户（也即线程）发来的请求，针对这个客户的 socket 连接返回服务就可以
了。
Server 端首先是响应客户的 Connect 事件，一旦连接了，就自动在服务端建立了一个连接
线程。而这个连接线程是需要 Server 维护的，indy 的最大连接线程数不会大于 600 个，
有 600 个线程你还不够用的话，基本上就不能使用 indy 控件了。

TCPServer每次侦听到一个连接，就会新建一个idPeerThread，
而当这个idPeerThread触发OnExecute事件的时候，就会调用IdTCPServer1Execute，
///////////{ 怎样识别是哪线程发来的请求 的问题 ？}//////////DATA线程附加信息包，可以自己定义//以便区分到底是那一个线程发来的数据。//

Indy是阻塞式（Blocking）的

当你使用Winsock开发网络应用程序时，从Socket中读取数据或者向Socket写入数据都是异步发生的，这样就不会阻断程序中其它代码的执行。在收到数据时，Winsock会向应用程序发送相应的消息。这种访问方式被称作非阻塞式连接，它要求你对事件作出响应，设置状态机，并通常还需要一个等待循环。
与通常的Winsock编程方法不同的是，Indy使用了阻塞式（便于编程）Socket调用方式。阻塞式访问更像是文件存取。当你读取数据，或是写入数据时，读取和写入函数将一直等到相应的操作完成后才返回。程序也一直阻塞在读或写的地方比如说，发起网络连接只需调用Connect方法并等待它返回，如果该方法执行成功，在结束时就直接返回，如果未能成功执行，则会抛出相应的异常。同文件访问不同的是，Socket调用可能会需要更长的时间，因为要读写的数据可能不会立即就能准备好（在很大程度上依赖于网络带宽）。例如： 1 received_msg:=trim(AThread.Connection.ReadLn('*', 10, -1));
2 athread.Connection.WriteLn('confirm');
1 //调用ReadLn方法来//取数据，数据结束标志符//为‘*’，在未读到‘*’//时函数 一直阻塞在//该处，超时时间为10微秒，对字符串长度没有限制。 2 //在收到字符串后，(.ReadLn('*', 10, -1))成功运行后，下一步2运行。)。
reeze对抗“冻结”
Indy使用一个特殊的组件TIdAntiFreeze来透明地解决客户程序用户界面“冻结”的问题。TIdAntiFreeze在Indy内部定时中断对栈的调用，并在中断期间调用Application.ProcessMessages方法处理消息，而外部的Indy调用继续保存阻塞状态，就好像TIdAntiFreeze对象不存在一样。你只要在程序中的任意地方添加一个TIdAntiFreeze对象，就能在客户程序中利用到阻塞式Socket的所有优点而避开它的一些显著缺点。
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIdTCPServer提供配置服务器功能，包括：
DefaultPort
ListenQueue
OnListenException
ReuseSocket
MaxConnections
MaxConnectionReply
该控件也提供控制协议特殊功能的属性和方法，包括：
Greeting
ReplyExceptionCode
ReplyUnknownCommand
该控件用来实现两机之间的连接，支持以下事件：
OnConnect
OnExecute
OnDisconnect
OnException
该控件支持协议命令的控制，包括：
CommandHandlers
CommandHandlersEnabled
OnNoCommandHandler
OnAfterCommandHandler
OnBeforeCommandHandler

该控件是以下控件的父类：
TIdChargenServer, TIdDayTimeServer, TIdDICTServer, TIdEchoServer, TIdFingerServer,TIdGopherServer, TIdHostNameServer, TIdHTTPServer, TIdIRCServer, TIdNNTPServer, TIdQUOTDServer,TIdTelnetServer, TIdWhoisServer

一些重要的属性
property ListenQueue: integer;
允许排队未解决的最大监听连接数。

property ReuseSocket: TIdReuseSocket;
本地地址中被重新使用的监听线程。

property MaxConnections: Integer;
最大允许的连接数。

property MaxConnectionReply: TIdRFCReply;
到达最大连接后，返回给其它请求的连接的消息。

property ReplyExceptionCode: Integer;
在发生异常后，返回给连接的代码。

property ReplyTexts: TIdRFCReplies;
服务器实现的协议响应。

property ReplyUnknownCommand: TIdRFCReply;
对未知命令的响应。

property CommandHandlers: TIdCommandHandlers;
命令处理器集合。

property CommandHandlersEnabled: boolean;
在监听线程连接时是否使用命令处理器。

property Greeting: TIdRFCReply;
当监听线程连接成功后发送的标题信息。

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

以下是 Indy9控件及使用Demos 的CHAT里怎么使用IdTCPServer的例子：

(***********************************************************)
(** Chat room demo **)
(***********************************************************)
(** Created by: Jeremy Darling **)
(** Created on: Sept. 21st 2000 **)
(** Origional Indy Version: 8.005B **)
(***********************************************************)
(** Updates **)
(***********************************************************)
(** Sept. 25th 2000 Jeremy Darling **)
(** Added functionality that is commonly wanted in a **)
(** chat program. **)
(** 1) Added send client list on request **)
(** 2) Added ability to add system commands **)
(** **)
(***********************************************************)

unit MainForm;

interface

uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls,
ExtCtrls, ToolWin, ImgList, Spin, Menus, SysUtils, Classes, IdBaseComponent,
IdComponent, IdTCPServer, IdThreadMgr, IdThreadMgrDefault;

type
TSimpleClient = class(TObject)//定义一个类TObject的实例，实例名称为TSimpleClient包括以下4个自定义成员。

DNS,
Name : String;
ListLink : Integer;
Thread : Pointer;
end;

TfrmMain = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
lbClients: TListBox;
PageControl1: TPageControl;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
ImageList1: TImageList;
Label3: TLabel;
lblDNS: TLabel;
tcpServer: TIdTCPServer;
lblSocketVer: TLabel;
Label5: TLabel;
Label4: TLabel;
seBinding: TSpinEdit;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Label6: TLabel;
memEntry: TMemo;
Label7: TLabel;
memEMotes: TMemo;
Label8: TLabel;
Label9: TLabel;
lblClientName: TLabel;
lblClientDNS: TLabel;
puMemoMenu: TPopupMenu;
Savetofile1: TMenuItem;
Loadfromfile1: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ToolBar1: TToolBar;
btnServerUp: TToolButton;
ToolButton1: TToolButton;
btnKillClient: TToolButton;
btnClients: TToolButton;
btnPM: TToolButton;
Label12: TLabel;
edSyopName: TEdit;
procedure btnServerUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seBindingChange(Sender: TObject);
procedure tcpServerConnect(AThread: TIdPeerThread);
procedure tcpServerDisconnect(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Savetofile1Click(Sender: TObject);
procedure Loadfromfile1Click(Sender: TObject);
procedure tcpServerExecute(AThread: TIdPeerThread);
procedure btnClientsClick(Sender: TObject);
procedure btnPMClick(Sender: TObject);
procedure btnKillClientClick(Sender: TObject);
procedure lbClientsClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Clients : TList;
procedure UpdateBindings;
procedure UpdateClientList;
procedure BroadcastMessage( WhoFrom, TheMessage : String );
end;

var
frmMain: TfrmMain;

implementation

{$R *.DFM}

uses
IdSocketHandle; // This is where the IdSocketHandle class is defined.

procedure TfrmMain.UpdateBindings;
var
Binding : TIdSocketHandle;
begin
{ Set the TIdTCPServer's port to the chosen value }
tcpServer.DefaultPort := seBinding.Value;
{ Remove all bindings that currently exist }
tcpServer.Bindings.Clear;
{ Create a new binding }
Binding := tcpServer.Bindings.Add;
{ Assign that bindings port to our new port }
Binding.Port := seBinding.Value;
end;

procedure TfrmMain.btnServerUpClick(Sender: TObject);//启动服务器。
begin
try
{ Check to see if the server is online or offline }//检查服务器是否在线。
tcpServer.Active := not tcpServer.Active;
btnServerUp.Down := tcpServer.Active;
if btnServerUp.Down then
begin
{ Server is online }//在线时。
btnServerUp.ImageIndex := 1;
btnServerUp.Hint := 'Shut down server';
end
else
begin
{ Server is offline }//不在线时。
btnServerUp.ImageIndex := 0;
btnServerUp.Hint := 'Start up server';
end;
{ Setup GUI buttons }
btnClients.Enabled:= btnServerUp.Down;
seBinding.Enabled := not btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
except
{ If we have a problem then rest things }
btnServerUp.Down := false;
seBinding.Enabled := not btnServerUp.Down;
btnClients.Enabled:= btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
{ Initalize our clients list }//初始化clents列表。
Clients := TList.Create;
{ Call updatebindings so that the servers bindings are correct }//使服务器的bindings正确更新bindings
UpdateBindings;
{ Get the local DNS entry for this computer }//本机机器名称。
lblDNS.Caption := tcpServer.LocalName;
{ Display the current version of indy running on the system }
lblSocketVer.Caption := tcpServer.Version;
end;

procedure TfrmMain.seBindingChange(Sender: TObject);
begin
UpdateBindings;
end;

procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread);
var
Client : TSimpleClient;// TSimpleClient = class(TObject)定义一个类TObject的实例begin
{ Send a welcome message, and prompt for the users name }//发送欢迎信息，设置用户名
AThread.Connection.WriteLn('ISD Connection Established...');
AThread.Connection.WriteLn('Please send valid login sequence...');
AThread.Connection.WriteLn('Your Name:');
{ Create a client object }//创建 client 实例。
Client := TSimpleClient.Create;
{ Assign its default values }//指派clent的默认值。用户自定义的那4个。【DNS ,Name ，ListLink ，Thread 】。
Client.DNS := AThread.Connection.LocalName;//本地机器名
Client.Name := 'Logging In';//自定义的字符串
Client.ListLink := lbClients.Items.Count;//与用于显示线程的liestbox列表的索引相关联。
{ Assign the thread to it for ease in finding }//分配线程便于查找
Client.Thread := AThread;
{ Add to our clients list box }//把Client.Name一项加到listbox列表使它显示出来供用户使用和查看
lbClients.Items.Add(Client.Name);
{ Assign it to the thread so we can identify it later }//把上述4项信息作为线程的附加信息包 ，附加到线程里，便于以后我们识别改线程。
AThread.Data := Client;
{ Add it to the clients list }//把信息加入clents列表（虚拟不可见的一个列表）。
Clients.Add(Client);
end;

procedure TfrmMain.tcpServerDisconnect(AThread: TIdPeerThread);//断开时，主要用于在列表里删除线程记录。
var
Client : TSimpleClient;
begin
{ Retrieve Client Record from Data pointer }//从data信息包里取回记录信息。
Client := Pointer(AThread.Data);
{ Remove Client from the Clients TList }//从虚拟列表里删除记录。
Clients.Delete(Client.ListLink);
{ Remove Client from the Clients List Box }//从listbox里删除记录信息。
lbClients.Items.Delete(lbClients.Items.IndexOf(Client.Name));
BroadcastMessage('System', Client.Name + ' has left the chat.');//自定义的消息广播命令向每个客户端循环发送消息。
{ Free the Client object }
Client.Free;//释放client。
AThread.Data := nil;//清空下线的线程信息包。

end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);//关闭时主要时一些防错处理
gin
if (Clients.Count > 0) and
(tcpServer.Active) then
begin
Action := caNone;
ShowMessage('Can''t close CBServ while server is online.');
end
else
Clients.Free;
end;

procedure TfrmMain.Savetofile1Click(Sender: TObject);
begin
if not (puMemoMenu.PopupComponent is TMemo) then
exit;

if SaveDialog1.Execute then
begin
TMemo(puMemoMenu.PopupComponent).Lines.SaveToFile(SaveDialog1.FileName);
end;
end;

procedure TfrmMain.Loadfromfile1Click(Sender: TObject);
begin
if not (puMemoMenu.PopupComponent is TMemo) then
exit;

if OpenDialog1.Execute then
begin
TMemo(puMemoMenu.PopupComponent).Lines.LoadFromFile(OpenDialog1.FileName);
end;
end;

procedure TfrmMain.UpdateClientList;
var
Count : Integer;
begin
{ Loop through all the clients connected to the system and set their names }
for Count := 0 to lbClients.Items.Count -1 do
if Count < Clients.Count then
lbClients.Items.Strings[Count] := TSimpleClient(Clients.Items[Count]).Name;
end;

procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread);//线程有数据受到时触发在这里识别线程，根据线程的data信息包来识别，分别进行不同的操作。比如2个客户端一个给你传送图片数据，一个给你传送txt字符时，为了能同时正确接受，需要在这里进行分支。使线程们进入他该去的过程里。自己的理解^_^。

var
cient : TSimpleClient;
Com, // System command
Msg : String;
begin
{ Get the text sent from the client }
Msg := AThread.Connection.ReadLn;//读取受到的txt
Get the clients package info }//得到线程的信息包。即识别线程。
Client := Pointer(AThread.Data);
{ Check to see if the clients name has been assigned yet }//识别是否是新连接的客户端
if Client.Name = 'Logging In' then
begin
{ if not, assign the name and announce the client }//是新连接的
Client.Name := Msg;
UpdateClientList;
BroadcastMessage('System', Msg + ' has just logged in.');
AThread.Connection.WriteLn(memEntry.Lines.Text);
end
else
{ If name is set, then send the message }
if Msg[1] <> '@' then
begin
{ Not a system command }
BroadcastMessage(Client.Name, Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if Com = 'CLIENTS' then
AThread.Connection.WriteLn( '@' + 'clients:' +
lbClients.Items.CommaText);
end;
end;

procedure TfrmMain.BroadcastMessage( WhoFrom, TheMessage : String );
var
Count: Integer;
List : TList;
EMote,
Msg : String;
begin
Msg := Trim(TheMessage);

EMote := Trim(memEMotes.Lines.Values[Msg]);

if WhoFrom <> 'System' then
Msg := WhoFrom + ': ' + Msg;

if EMote <> '' then
Msg := Format(Trim(EMote), [WhoFrom]);

List := tcpServer.Threads.LockList;
try
for Count := 0 to List.Count -1 do
try
TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg);
except
TIdPeerThread(List.Items[Count]).Stop;
end;
finally
tcpServer.Threads.UnlockList;
end;
end;

procedure TfrmMain.btnClientsClick(Sender: TObject);
begin
UpdateClientList;
end;

procedure TfrmMain.btnPMClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Private Message', 'What is the message', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and
(lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end;

procedure TfrmMain.btnKillClientClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Disconnect message', 'Enter a reason for the disconnect', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and
(lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
TIdPeerThread(Client.Thread).Connection.Disconnect;
Clients.Delete(lbClients.ItemIndex);
lbClients.Items.Delete(lbClients.ItemIndex);
end;
end;

procedure TfrmMain.lbClientsClick(Sender: TObject);
var
Client : TSimpleClient;
begin
btnPM.Enabled := lbClients.ItemIndex <> -1;
btnKillClient.Enabled := btnPM.Enabled;

if lbClients.ItemIndex = -1 then
exit;
Client := Clients.Items[lbClients.ItemIndex];
lblClientName.Caption := Client.Name;
lblClientDNS.Caption := Client.DNS;
end;

end.

--------------------------------------------------------一个用递归来广播的服务端--------------------------------------------

======================server============================
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPServer, StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
IdTCPServer1: TIdTCPServer;
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure Button1Click(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
end;

type
PSocketThread=^TSocketThread;
TSocketThread=Record
SocketThread:TIdPeerThread;
Next:PSocketThread;
end;

var
Form1: TForm1;
ST_Head,ST_End:PSocketThread;
ST_Count:integer;

implementation

{$R *.dfm}

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
PST_:PSocketThread;
begin
New(PST_);
PST_^.SocketThread:=AThread;
PST_^.Next:=nil;
if ST_Count=0 then
begin
ST_Head:=PST_;
ST_End:=ST_Head;
end
else
begin
ST_End^.Next:=PST_;
ST_End:=PST_;
end;
ST_Count:=ST_Count+1;
Edit1.Text:=IntToStr(ST_Count);
end;

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
var
PST_,PST_0:PSocketThread;
begin
PST_:=ST_Head;
PST_0:=ST_Head;
while PST_<>nil do
begin
if PST_^.SocketThread.ThreadID=AThread.ThreadID then
begin
PST_0^.Next:=PST_^.Next;
Dispose(PST_);
ST_Count:=ST_Count-1;
Edit1.Text:=IntToStr(ST_Count);
end else
begin
PST_0:=PST_;
PST_:=PST_^.Next;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
PST_:PSocketThread;
begin
PST_:=ST_Head;
while PST_<>nil do
begin
PST_^.SocketThread.Connection.WriteLn('To U '+IntToStr(PST_^.SocketThread.ThreadID)+#$A);
PST_:=PST_^.Next;
end;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
begin
Memo1.Lines.Add(AThread.Connection.ReadLn);
end;

end.