DataSnap被動斷開客戶端及主動斷開客戶端

本例為XE3開發，用tcp/ip連接，用http(s)則無效，因為主要用到TDSTCPServerTransport類。

本例參考李維的教程稍做修改，功能為管理員可以在服務端斷開客戶連接，並顯示在服務端的主界面上，如下圖：

以上的截圖開了三個客戶端，一個服務端，客戶端主動斷開時，服務端會顯示主動斷開；服務端關閉客戶時會顯示被動斷開。

關鍵點：

   1.在TServerContainer中建立FConnections的TobjectDirectionary<TIDTcpConnection,TDSChannel>,用它來記錄目前已連接的客戶端數

   2.關閉客戶端時，主要查看FConnections中以TidTcpConnection關聯的TDSChannel，找到后用TDSChannel.Close即可。

   3.不管是主動關閉或被動關閉，都要消除掉FConnections的相關記錄並顯示當前的Session數。

以下為服務端的相關代碼：

unit ServerContainerUnit1;

interface

uses 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<TIdTCPConnection,TDSTCPChannel>;//記錄connections
    procedure UpdateTCPMonitorInfo;
    procedure AddConnetionToList(Conn:TIdTCPConnection;Channel:TDSTCPChannel);


  public
    procedure DisConnectConnection(theConnection:TIdTCPConnection);//管理員主動斷開客戶端
  end;

var
  ServerContainer1: TServerContainer1;
  disstr:string;

implementation

uses Winapi.Windows, ServerMethodsUnit1;

{$R *.dfm}
var
  pconn:TIdTCPConnection;
  ConnInfoStr:string;
  ConnInfoStr1:string;



procedure TServerContainer1.DataModuleCreate(Sender: TObject);
begin
  FConnections:=TObjectDictionary<TIdTCPConnection,TDSTCPChannel>.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;

interface

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

implementation
uses 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的心跳包打開。