本例为XE3开发，用tcp/ip连接，用http(s)则无效，因为主要用到TDSTCPServerTransport类。

本例参考李维的教程稍做修改，功能为管理员可以在服务端断开客户连接，并显示在服务端的主界面上，如下图：

以上的截图开了三个客户端，一个服务端，客户端主动断开时，服务端会显示主动断开；服务端关闭客户时会显示被动断开。

关键点：

   1.在TServerContainer中建立FConnections的TobjectDirectionary<TIDTcpConnection,TDSChannel>,用它来记录目前已连接的客户端数

   2.关闭客户端时，主要查看FConnections中以TidTcpConnection关联的TDSChannel，找到后用TDSChannel.Close即可。

   3.不管是主动关闭或被动关闭，都要消除掉FConnections的相关记录并显示当前的Session数。

以下为服务端的相关代码：

unit ServerContainerUnit1;interfaceuses System.SysUtils, System.Classes,  Datasnap.DSTCPServerTransport,  Datasnap.DSServer, Datasnap.DSCommonServer,  Datasnap.DSAuth, IPPeerServer,System.Generics.Collections,IdTCPConnection,UMain;type  TServerContainer1 = class(TDataModule)    DSServer1: TDSServer;    DSTCPServerTransport1: TDSTCPServerTransport;    DSServerClass1: TDSServerClass;    procedure DataModuleCreate(Sender: TObject);    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;      var PersistentClass: TPersistentClass);    procedure DSTCPServerTransport1Connect(Event: TDSTCPConnectEventObject);    procedure DSTCPServerTransport1Disconnect(Event: TDSTCPDisconnectEventObject);  private    {
     Private declarations }    FConnections:TObjectDictionary
     
      ;//记录connections    procedure UpdateTCPMonitorInfo;    procedure AddConnetionToList(Conn:TIdTCPConnection;Channel:TDSTCPChannel);  public    procedure DisConnectConnection(theConnection:TIdTCPConnection);//管理员主动断开客户端  end;var  ServerContainer1: TServerContainer1;  disstr:string;implementationuses Winapi.Windows, ServerMethodsUnit1;{
    $R *.dfm}var  pconn:TIdTCPConnection;  ConnInfoStr:string;  ConnInfoStr1:string;procedure TServerContainer1.DataModuleCreate(Sender: TObject);begin  FConnections:=TObjectDictionary
      
       .Create;end;procedure TServerContainer1.AddConnetionToList(Conn: TIdTCPConnection;  Channel: TDSTCPChannel);begin  pconn:=Conn;  if (Conn<>nil) and (Channel<>nil) and (Channel.ChannelInfo<>nil)     and (Channel.ChannelInfo.ClientInfo.IpAddress<>EmptyStr)  then  begin    with Channel.ChannelInfo.ClientInfo do    begin      ConnInfoStr:=Format('%s:%s',[IPAddress,ClientPort]);      ConnInfoStr1:=Format('AppName: %s, Protocol: %s, IP: %s, Port: %s',                            [AppName,Protocol,IpAddress,ClientPort]                          );    end;  end else    ConnInfoStr:='通道资讯错误.';end;procedure TServerContainer1.DisConnectConnection(  theConnection: TIdTCPConnection);var  theChannel:TDSTCPChannel;begin  if (theConnection<>nil) then  begin    FConnections.TryGetValue(theConnection,theChannel);    TThread.Synchronize(nil,                        procedure                         var                           i:integer;                           sip,sport:string;                        begin                          sip:=theChannel.ChannelInfo.ClientInfo.IpAddress;                          sport:=theChannel.ChannelInfo.ClientInfo.ClientPort;                          disstr:=Format('%s:%s',[sIP,sport]);                          i:= FrmMain.lbTcpMonitorInfo.Items.IndexOf(disstr);                          if i<>-1 then                             FrmMain.lbTcpMonitorInfo.Items[i]:=Format('%s:%s 被动断开',[sip,sport]);                        end                       );    System.TMonitor.Enter(FConnections);    FConnections.Remove(theConnection);    System.TMonitor.Exit(FConnections);    theChannel.Close;  end;end;procedure TServerContainer1.DSServerClass1GetClass(  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);begin  PersistentClass := ServerMethodsUnit1.TServerMethods1;end;procedure TServerContainer1.DSTCPServerTransport1Connect(Event:    TDSTCPConnectEventObject);begin  System.TMonitor.Enter(FConnections);  try     FConnections.Add(TIdTCPConnection(Event.Connection),Event.Channel);  finally    System.TMonitor.Exit(FConnections);  end;  AddConnetionToList(TIdTCPConnection(Event.Connection),Event.Channel);  TThread.Synchronize(nil,UpdateTCPMonitorInfo);end;procedure TServerContainer1.DSTCPServerTransport1Disconnect(Event:    TDSTCPDisconnectEventObject); var   sip,sport:string;   conn:TIdTCPConnection;   i:integer;begin   conn:=TIdTCPConnection(Event.Connection);  if Assigned(conn) then  begin    sip:=conn.Socket.Binding.PeerIP;    sport:=IntToStr(conn.Socket.Binding.PeerPort);    System.TMonitor.Enter(ServerContainer1.FConnections);     if FConnections.ContainsKey(conn) then     FConnections.Remove(conn);    System.TMonitor.Exit(FConnections);    i:= FrmMain.lbTcpMonitorInfo.Items.IndexOf(Format('%s:%s',[sip,sport]));    if i<>-1 then    begin      FrmMain.lbTcpMonitorInfo.Items[i]:=Format('%s:%s 主动断开',[sip,sport]);    end;  end;  FrmMain.edtSessionCount.Text:=IntToStr(FConnections.Count);end;procedure TServerContainer1.UpdateTCPMonitorInfo;begin  FrmMain.lbTcpMonitorInfo.Items.AddObject(ConnInfoStr,pconn) ;  FrmMain.ListBox1.Items.Add(ConnInfoStr1);  FrmMain.edtSessionCount.Text:=IntToStr(FConnections.Count);end;end.
      
     

 

unit UMain;interfaceuses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,  Vcl.StdCtrls,IdTCPConnection;type  TFrmMain = class(TForm)    lbTcpMonitorInfo: TListBox;    btcCloseClient: TButton;    Label1: TLabel;    edtSessionCount: TEdit;    ListBox1: TListBox;    procedure btcCloseClientClick(Sender: TObject);  private    {
     Private declarations }    function GetSelectedConnection:TIdTCPConnection;  public    {
     Public declarations }  end;var  FrmMain: TFrmMain;implementationuses ServerContainerUnit1;{
    $R *.dfm}procedure TFrmMain.btcCloseClientClick(Sender: TObject);var  pConn:TIdTCPConnection;  connstr:string;begin  pConn:=GetSelectedConnection;  ServerContainer1.DisConnectConnection(pConn);  ShowMessage('已切断: '+disstr+'的连线');end;function TFrmMain.GetSelectedConnection: TIdTCPConnection;var  I,Count,Index:Integer;  obj:TObject;begin  Result:=nil;  Index:=-1;  Count:=lbTcpMonitorInfo.Count;  if Count>0 then  begin    for i := 0 to count-1 do    begin      if lbTcpMonitorInfo.Selected[i] then      begin        Index:=i;        Break;      end;    end;  end;  if Index>-1 then  begin    obj:=lbTcpMonitorInfo.Items.Objects[index];    if obj<>nil then      Exit(TidtcpConnection(Obj));  end;end;end.

也可以把TDSTCPServerTransport的心跳包打开。