|
前 言
Borland公司出品的Delphi 7以及Kylix 3都含有功能强大的Internet Direct 控件包，这些控件包用来建立网络应用是非常便捷和快速的，在本文中我将介绍如何使用Internet Direct 控件包中TIdTCPServer 来开发多线程的TCP服务器.。
一、IdTCPServer 的特性
TIdTCPServer是TIdComponent的继承类，隶属于IdTCPServer单元。TIdTCPServer把一个完整、多线程的TCP(Transmission Control Protocol)服务器进行封装。TIdTCPServer使用一根或多个线程为监听客户的请求和并且与TIdThreadMgr控件一起进行协同,分配一根独立线程来处理每一客户和服务器的连接。一系列的活跃的ThreadClass实例在线程中进行维护。
TIdTCPServer提供选项来允许服务器监听线程的配置，包含如下:
DefaultPort
ListenQueue
OnListenException
ReuseSocket
MaxConnections
MaxConnectionReply
TIdTCPServer也提供属性和方法控制特有的选项，他们是:
Greeting
ReplyExceptionCode
ReplyUnknownCommand
TIdTCPServer的构架为端对端的通信提供了两种机制。第一方法使用事件句柄，该句柄在每个连接的线程的上下文中执行。服务器的实现能给事件句柄分配过程，从而对下列的事件进行处理:
OnConnect
OnExecute
OnDisconnect
OnException
另一方法使用一组对象TIdCommandHandler来识别合法的服务器命令，并且提供方法和属性来处理参数，执行动作，规划错误和成功回答。与TCommandHandler 相关的属性和方法的使用方法如下所示:
CommandHandlers
CommandHandlersEnabled
OnNoCommandHandler
OnAfterCommandHandler
OnBeforeCommandHandler
服务器的实现者能在使用基于服务器的事件句柄和命令句柄这两种方法之间选择，以便对服务器和协议的运行和控制提供更好的解决方案。TIdTCPServer能被使用作为一个基类用来建立用户自己的对于TCP支持特有协议的服务器.很多Indy服务器组件都是以该组件为基础的，这些组件是TIdChargenServer, TIdDayTimeServer, TIdDICTServer, TIdEchoServer, TIdFingerServer, TIdGopherServer, TIdHostNameServer, TIdHTTPServer, TIdIRCServer, TIdNNTPServer, TIdQUOTDServer, TIdTelnetServer, 和TIdWhoisServer等等。
二、使用TIdTCPServer进行基于事件句柄的多线程服务器的开发
我们在Delphi 7中先建立如下的窗体：
窗体的第一页
窗体的第二页
在代码的public部分加入如下的变量和函数
fErrors : TStringList;
fServerRunning : boolean;
procedure PopulateIPAddresses;
function PortDescription(const PortNumber: integer): string;
function StartServer:Boolean;
function StopServer:Boolean;
为IdTCPServer的Execute事件添加代码
procedure TfrmMain.IdTCPServerExecute(AThread: TIdPeerThread);
var
Command : String;
begin
Command := AThread.Connection.ReadLn;
//从套接子读取命令
Command := uppercase(Command);
if Command = 'TIME' then
AThread.Connection.WriteLn(FormatDateTime('hh:nn:ss',now))
//向套接子发送当前的时间
else if Command = 'DATE' then
AThread.Connection.WriteLn(FormatDateTime('dd/mmm/yyyy',date))
//向套接字发送当前的日期
else if Command = 'TICKCOUNT' then
AThread.Connection.WriteInteger(GetTickCount)
//获得系统开机以来的毫秒数
else if Command = 'QUIT' then
begin
AThread.Connection.WriteLn('Goodbye!');
AThread.Connection.Disconnect;
End
//客户端结束本次连接
else AThread.Connection.WriteLn('Command not recognised - try again!')
end;
procedure TfrmMain.PopulateIPAddresses;
//该函数用来获得IP地址
var
i : integer;
begin
with lbIPs do
begin
Clear;
Items := GStack.LocalAddresses;
//GStack的LocalAddresses属性返回的是一个TStrings类型的结果，该结果包括//了所有的与该服务器机器绑定的IP地址
Items.Insert(0, '127.0.0.1');
//插入回环的IP地址
end;
try
cboPorts.Items.Add(RSBindingAny); //绑定任何端口
cboPorts.Items.BeginUpdate;
for i := 0 to IdPorts.Count - 1 do
cboPorts.Items.Add(PortDescription(Integer(IdPorts[i]))); //把系统中所有//可以识别的端口加入到列表中
finally
cboPorts.Items.EndUpdate;
end;
end;
function TfrmMain.PortDescription(const PortNumber: integer): string;
//获得关于端口的描述
begin
with GStack.WSGetServByPort(PortNumber) do try
Result := '';
if Count > 0 then begin
Result := Format('%d: %s', [PortNumber, CommaText]); {Do not Localize}
end;
finally
Free;
end;
end;
procedure TfrmMain.cboPortsChange(Sender: TObject);
//分离出段口号
function GetPort(AString:String):String;
begin
Result := AString;
if pos(':',AString) > 0 then
Result := copy(AString,1,pos(':',AString)-1);
end;
begin
edtPort.Text :=
GetPort(cboPorts.Items.Strings[cboPorts.ItemIndex])
end;
function TfrmMain.StartServer: Boolean;
//启动服务器
var
Binding : TIdSocketHandle;//为套接字的句柄
i : integer;
SL : TStringList;
begin
SL := TStringList.Create;
if not StopServer then
begin //如果服务器没有停止
fErrors.Append('Error stopping server');
Result := false;
exit;
end;
IdTCPServer.Bindings.Clear;
try
try
for i := 0 to lbIPs.Count-1 do
if lbIPs.Checked[i] then
begin
Binding := IdTCPServer.Bindings.Add;
Binding.IP := lbIPs.Items.Strings[i];
Binding.Port := StrToInt(edtPort.Text);
SL.append('Server bound to IP ' + Binding.IP + ' on port ' + edtPort.Text);
end; //把选中的IP地址进行服务的绑定
IdTCPServer.Active := true; //启动服务器
result := IdTCPServer.Active;
fServerRunning := result;
lbProcesses.Items.AddStrings(SL);
lbProcesses.Items.Append('Server started');
if result then
StatusBar.SimpleText := 'Server running'
else StatusBar.SimpleText := 'Server stopped';
//在状态栏上显示服务器的状态
except
on E : Exception do
begin //服务器失效的异常处理
lbProcesses.Items.Append('Server not started');
fErrors.append(E.Message);
Result := false;
fServerRunning := result;
end;
end;
finally
FreeAndNil(SL);
end;
end;
procedure TfrmMain.btnStopServerClick(Sender: TObject);
//停止服务器
begin
fErrors.Clear;
if not fServerRunning then
begin
ShowMessage('Server it not running - no need to stop !');
Exit;
end;
if not StopServer then
ShowMessage('Error stopping server ' + #13 + #13 + fErrors.Text)
else
ShowMessage('Server stopped successfully');
end;
procedure TfrmMain.btnStartServerClick(Sender: TObject);
//启动服务器
var
x,i : integer;
begin
for i := 0 to lbIPs.Count-1 do
if lbIPs.Checked[i] then
inc(x);
if x < 1 then
begin
ShowMessage('Cannot proceed until you select at least one IP to bind!');
exit;
end;
//规定至少选中一个IP地址作为服务器使用
fErrors.Clear;
if not StartServer then
ShowMessage('Error starting server' + #13 + #13 + fErrors.text)
else ShowMessage('Server started successfully!');
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FreeAndNil(fErrors);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
fErrors := TStringList.Create;
PopulateIPAddresses;
end;
procedure TfrmMain.btnClearMessagesClick(Sender: TObject);
begin
lbProcesses.Clear;
end;
procedure TfrmMain.IdTCPServerConnect(AThread: TIdPeerThread);
begin
AThread.Connection.WriteLn('Welcome to the Indy TCP basic client/server demo');
end;
三、小结 使用Internet Direct 控件包进行Internet的程序开发是非常高效的，同时还具有可移植性，即我们使用Internet Direct 控件包开发的应用程序同时也可以在Linux上编译运行，光这一点就十分吸引众多的开发人员了。相信大家再看完本文以后，一定能动手自己写一个服务器程序了。
|
