IdTCPServer简介

IdTCPServer简介 修改浏览权限删除 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提供配置服务器功能，包括：DefaultPortListenQueueOnListenExceptionReuseSocketMaxConnectionsMaxConnectionReply该控件也提供控制协议特殊功能的属性和方法，包括：GreetingReplyExceptionCodeReplyUnknownCommand该控件用来实现两机之间的连接，支持以下事件：OnConnectOnExecuteOnDisconnectOnException该控件支持协议命令的控制，包括：CommandHandlersCommandHandlersEnabledOnNoCommandHandlerOnAfterCommandHandlerOnBeforeCommandHandler该控件是以下控件的父类：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;interfaceusesWindows, Messages, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls,ExtCtrls, ToolWin, ImgList, Spin, Menus, SysUtils, Classes, IdBaseComponent,IdComponent, IdTCPServer, IdThreadMgr, IdThreadMgrDefault;typeTSimpleClient = 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;varfrmMain: TfrmMain;implementation$R *.DFMusesIdSocketHandle; / This is where the IdSocketHandle class is cedure TfrmMain.UpdateBindings;varBinding : TIdSocketHandle;begin Set the TIdTCPServers 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);/启动服务器。begintry 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正确更新bindingsUpdateBindings; 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);beginUpdateBindings;end;procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread);varClient : 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);/断开时，主要用于在列表里删除线程记录。varClient : 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);/关闭时主要时一些防错处理ginif (Clients.Count 0) and (tcpServer.Active) then begin Action := caNone; ShowMessage(Cant close CBServ while server is online.); endelse Clients.Free;end;procedure TfrmMain.Savetofile1Click(Sender: TObject);beginif 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);beginif not (puMemoMenu.PopupComponent is TMemo) then exit;if OpenDialog1.Execute then begin TMemo(puMemoMenu.PopupComponent).Lines.LoadFromFile(OpenDialog1.FileName); end;end;procedure TfrmMain.UpdateClientList;varCount : 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.StringsCount := TSimpleClient(Clients.ItemsCount).Name;end;procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread);/线程有数据受到时触发在这里识别线程，根据线程的data信息包来识别，分别进行不同的操作。比如2个客户端一个给你传送图片数据，一个给你传送txt字符时，为了能同时正确接受，需要在这里进行分支。使线程们进入他该去的过程里。自己的理解_。varcient : TSimpleClient;Com, / System commandMsg : String;begin Get the text sent from the client Msg := AThread.Connection.ReadLn;/读取受到的txtGet 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); endelse If name is set, then send the message if Msg1 then begin Not a system command BroadcastMessage(Client.Name, Msg); endelse 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 );varCount: Integer;List : TList;EMote,Msg : String;beginMsg := Trim(TheMessage);EMote := Trim(memEMotes.Lines.ValuesMsg);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.ItemsCount).Connection.WriteLn(Msg); except TIdPeerThread(List.ItemsCount).Stop; end;finally tcpServer.Threads.UnlockList;end;end;procedure TfrmMain.btnCli