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调用方式。阻塞式访问更像是文件存取。当你读取数据，或是写入数据时，读取和写入函数将一直等到相应的操作完成后才返回。程序也一直阻塞1 / 13

在读或写的地方比如说，发起网络连接只需调用Connect方法并等待它返回，如果该方法执行成功，在结束时就直接返回，如果未能成功执行，则会抛出相应的异常。同文件访问不同的是，Socket调用可能会需要更长的时间，因为要读写的数据可能不会立即就能准备好（在很大程度上依赖于网络带宽）。例如：

1 received_msg:=trim(('*', 10,

-1));

2

n('confirm');

1 //调用ReadLn方法来//取数据，数据结束标志符//为‘*’，在未读到‘*’//时函数 一直阻塞在//该处，超时时间为10微秒，对字符串长度没有限制。 2 //在收到字符串后，(.ReadLn('*', 10, -1))成功运行后，下一步2运行。)。

reeze对抗“冻结”

Indy使用一个特殊的组件TIdAntiFreeze来透明地解决客户程序用户界面“冻结”的问题。TIdAntiFreeze在Indy内部定时中断对栈的调用，并在中断期间调用sMessages方法处理消息，而外部的Indy调用继续保存阻塞状态，就好像TIdAntiFreeze对象不存在一样。你只要在程序中的任意地方添加一个TIdAntiFreeze对象，就能在客户程序中利用到阻塞式Socket的所有优点而避开它的一些显著缺点。

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

TIdTCPServer提供配置服务器功能，包括：

DefaultPort

ListenQueue

OnListenException

ReuseSocket

MaxConnections

MaxConnectionReply

该控件也提供控制协议特殊功能的属性和方法，包括：

Greeting

ReplyExceptionCode

ReplyUnknownCommand

该控件用来实现两机之间的连接，支持以下事件：

OnConnect

OnExecute

OnDisconnect

OnException

该控件支持协议命令的控制，包括：

CommandHandlers

2 / 13

CommandHandlersEnabled

OnNoCommandHandler

OnAfterCommandHandler

OnBeforeCommandHandler

该控件是以下控件的父类：

TIdChargenServer, TIdDayTimeServer, TIdDICTServer, TIdEchoServer,

TIdFingerServer,TIdGopherServer, TIdHostNameServer, TIdbbbServer,

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的例子：

3 / 13

(***********************************************************)

(** 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;

4 / 13

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);

5 / 13

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 Bindings;

var

Binding : TIdSocketHandle;

begin

{ Set the TIdTCPServer's port to the chosen value }

tPort := ;

{ Remove all bindings that currently exist }

;

{ Create a new binding }

Binding := ;

{ Assign that bindings port to our new port }

:= ;

end;

6 / 13

procedure verUpClick(Sender: TObject);//启动服务器。

begin

try

{ Check to see if the server is online or offline }//检查服务器是否在线。

:= not ;

:= ;

if then

begin

{ Server is online }//在线时。

ndex := 1;

:= 'Shut down server';

end

else

begin

{ Server is offline }//不在线时。

ndex := 0;

:= 'Start up server';

end;

{ Setup GUI buttons }

d:= ;

d := not ;

d:= not ;

except

{ If we have a problem then rest things }

:= false;

d := not ;

d:= ;

d:= not ;

end;

end;

procedure eate(Sender: TObject);

begin

{ Initalize our clients list }//初始化clents列表。

Clients := ;

{ Call updatebindings so that the servers bindings are correct }//使服务器的bindings正确更新bindings

UpdateBindings;

{ Get the local DNS entry for this computer }//本机机器名称。

n := ame;

{ Display the current version of indy running on the system }

n := n;

end;

7 / 13

procedure ingChange(Sender: TObject);

begin

UpdateBindings;

end;

procedure verConnect(AThread: TIdPeerThread);

var

Client : TSimpleClient;// TSimpleClient = class(TObject)定义一个类TObject的实例begin

{ Send a welcome message, and prompt for the users name }//发送欢迎信息，设置用户名

n('ISD ');

n('Please send valid ');

n('Your Name:');

{ Create a client object }//创建 client 实例。

Client := ;

{ Assign its default values }//指派clent的默认值。用户自定义的那4个。【DNS ,Name ，ListLink ，Thread 】。

:= ame;//本地机器名

:= 'Logging In';//自定义的字符串

nk := ;//与用于显示线程的liestbox列表的索引相关联。

{ Assign the thread to it for ease in finding }//分配线程便于查找

:= AThread;

{ Add to our clients list box }//把一项加到listbox列表使它显示出来供用户使用和查看

();

{ Assign it to the thread so we can identify it later }//把上述4项信息作为线程的附加信息包 ，附加到线程里，便于以后我们识别改线程。

:= Client;

{ Add it to the clients list }//把信息加入clents列表（虚拟不可见的一个列表）。

(Client);

end;

procedure verDisconnect(AThread: TIdPeerThread);//断开时，主要用于在列表里删除线程记录。

var

Client : TSimpleClient;

begin

{ Retrieve Client Record from Data pointer }//从data信息包里取回记录信息。

Client := Pointer();

{ Remove Client from the Clients TList }//从虚拟列表里删除记录。

8 / 13

(nk);

{ Remove Client from the Clients List Box }//从listbox里删除记录信息。

(f());

BroadcastMessage('System', + ' has left the chat.');//自定义的消息广播命令向每个客户端循环发送消息。

{ Free the Client object }

;//释放client。

:= nil;//清空下线的线程信息包。

end;

procedure ose(Sender: TObject; var Action:

TCloseAction);//关闭时主要时一些防错处理

gin

if ( > 0) and

() then

begin

Action := caNone;

ShowMessage('Can''t close CBServ while server is online.');

end

else

;

end;

procedure file1Click(Sender: TObject);

begin

if not (omponent is TMemo) then

exit;

if e then

begin

TMemo(omponent).File(me);

end;

end;

procedure omfile1Click(Sender: TObject);

begin

if not (omponent is TMemo) then

exit;

if e then

begin

TMemo(omponent).omFile(me);

9 / 13

end;

end;

procedure ClientList;

var

Count : Integer;

begin

{ Loop through all the clients connected to the system and set their names }

for Count := 0 to -1 do

if Count < then

s[Count] :=

TSimpleClient([Count]).Name;

end;

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

var

cient : TSimpleClient;

Com, // System command

Msg : String;

begin

{ Get the text sent from the client }

Msg := ;//读取受到的txt

Get the clients package info }//得到线程的信息包。即识别线程。

Client := Pointer();

{ Check to see if the clients name has been assigned yet }//识别是否是新连接的客户端

if = 'Logging In' then

begin

{ if not, assign the name and announce the client }//是新连接的

:= Msg;

UpdateClientList;

BroadcastMessage('System', Msg + ' has just logged in.');

n();

end

else

{ If name is set, then send the message }

if Msg[1] <> '@' then

begin

{ Not a system command }

BroadcastMessage(, Msg);

10 / 13

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

n( '@' + 'clients:' +

aamaText);

end;

end;

procedure astMessage( WhoFrom, TheMessage : String );

var

Count: Integer;

List : TList;

EMote,

Msg : String;

begin

Msg := Trim(TheMessage);

EMote := Trim([Msg]);

if WhoFrom <> 'System' then

Msg := WhoFrom + ': ' + Msg;

if EMote <> '' then

Msg := Format(Trim(EMote), [WhoFrom]);

List := st;

try

for Count := 0 to -1 do

try

TIdPeerThread([Count]).n(Msg);

except

TIdPeerThread([Count]).Stop;

end;

finally

List;

end;

end;

11 / 13

procedure entsClick(Sender: TObject);

begin

UpdateClientList;

end;

procedure lick(Sender: TObject);

var

Msg : String;

Client : TSimpleClient;

begin

Msg := InputBox('Private Message', 'What is the message', '');

Msg := Trim(Msg);

Msg := + '> ' + Msg;

if (Msg <> '') and

(dex <> -1) then

begin

Client := [dex];

TIdPeerThread().n(Msg);

end;

end;

procedure lClientClick(Sender: TObject);

var

Msg : String;

Client : TSimpleClient;

begin

Msg := InputBox('Disconnect message', 'Enter a reason for the disconnect',

'');

Msg := Trim(Msg);

Msg := + '> ' + Msg;

if (Msg <> '') and

(dex <> -1) then

begin

Client := [dex];

TIdPeerThread().n(Msg);

TIdPeerThread().nect;

(dex);

(dex);

end;

end;

procedure ntsClick(Sender: TObject);

var

Client : TSimpleClient;

begin

12 / 13

d := dex <> -1;

d := d;

if dex = -1 then

exit;

Client := [dex];

n := ;

n := ;

end;

end.

[文档可能无法思考全面，请浏览后下载，另外祝您生活愉快，工作顺利，万事如意!]

13 / 13