xe 最大连接数限制、记录客户连接、心跳

//author: cxg

unit DSServerContainer;

interface

uses
  SysUtils, Classes, IniFiles, Windows, Provider, DBClient,
  DSTCPServerTransport,
  DSServer, DSCommonServer, DB, ADODB, Generics.Collections, DSService,
  DBXDataSnap, DBXCommon, DSHTTPLayer, DBXinterbase, forms, DbxCompressionFilter
  ,IdTCPConnection ,IdWinsock2, ExtCtrls
  ;

type
  TTCP_KeepAlive = record
    OnOff: Cardinal;
    KeepAliveTime: Cardinal;     // 多长时间（ms）没有数据就开始send心跳包
    KeepAliveInterval: Cardinal; // 每隔多长时间（ms）send一个心跳包，发5次（系统值）
  end;

  TServerContainer1 = class(TDataModule)
    DSServer1: TDSServer;
    DSTCPServerTransport1: TDSTCPServerTransport;
    DSServerClass1: TDSServerClass;
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure DataModuleCreate(Sender: TObject);
    procedure DSServer1Disconnect(DSConnectEventObject: TDSConnectEventObject);
    procedure DSServer1Connect(DSConnectEventObject: TDSConnectEventObject);
  private
    { Private declarations }

  end;

var
  ServerContainer1: TServerContainer1;
 

implementation

uses  ServerMethodsUnit1,MainForm;

{$R *.dfm}

procedure TServerContainer1.DataModuleCreate(Sender: TObject);
begin
  DSServer1.AutoStart :=False;
  DSTCPServerTransport1.Port :=g_port;
  DSServer1.Start;
end;

procedure TServerContainer1.DSServer1Connect(
  DSConnectEventObject: TDSConnectEventObject);
var
  ClientConnection: TIdTCPConnection;
  Val: TTCP_KeepAlive;
  Ret: DWord;
begin
  // 最大连接数量限制，验证来访者密码
  if (DSConnectEventObject.ChannelInfo = nil) or
    (g_CurrentConnNum >= FrmMain.MaxclientNum) or
    (DSConnectEventObject.ConnectProperties[TDBXPropertyNames.UserName] <> g_username) or
    (DSConnectEventObject.ConnectProperties[TDBXPropertyNames.Password] <> g_userpassword) then
  begin
    DSConnectEventObject.DbxConnection.Destroy;
    Exit;
  end
  else
  begin
    inc(g_currentconnnum);  // 记录来访者数量
    //把心跳包放到服务端上执行，如果服务器的某个TCP连接在5秒钟没有收到数据，
    //将会发送向对端发送心跳包，间隔3秒钟，连续发送5次。如果5次以后对端还没有应答，服务器将结束该TCP连接
    ClientConnection := TIdTCPConnection(DSConnectEventObject.ChannelInfo.Id);
    Val.OnOff := 1;
    Val.KeepAliveTime := 5000;
    Val.KeepAliveInterval := 3000;
    WSAIoctl(ClientConnection.Socket.Binding.Handle, IOC_IN or IOC_VENDOR or 4,
      @val, SizeOf(val), nil, 0, @Ret, nil, nil);
  end;

  //记录客户连接
  with FrmMain do
  begin
    dsShowDataSet.Append;
    dsShowDataSet.FindField('ClientConnect').AsDateTime := Time;

    if DSConnectEventObject.ChannelInfo <> nil then
    begin

      dsShowDataSet.FindField('ClientId').AsInteger := DSConnectEventObject.ChannelInfo.Id;
      dsShowDataSet.FindField('ClientIp').AsString := ClientConnection.Socket.Binding.PeerIP +
        ':' + IntToStr(ClientConnection.Socket.Binding.PeerPort);
      dsShowDataSet.FindField('ServerIp').AsString := ClientConnection.Socket.Binding.IP + ':' +
        IntToStr(ClientConnection.Socket.Binding.Port);
    end;

    dsShowDataSet.FindField('ClientUserName').AsString := DSConnectEventObject.ConnectProperties
      [TDBXPropertyNames.UserName];
    dsShowDataSet.FindField('ClientUserPassword').AsString :=
      DSConnectEventObject.ConnectProperties[TDBXPropertyNames.Password];
    dsShowDataSet.FindField('ServerInfo').AsString := '上线';
    dsShowDataSet.Post;
  end;
end;

procedure TServerContainer1.DSServer1Disconnect(
  DSConnectEventObject: TDSConnectEventObject);
var
  ClientConnection: TIdTCPConnection;
begin
  //记录客户下线
  with FrmMain do
  begin
    dsShowDataSet.Append;
    dsShowDataSet.FindField('ClientDisConn').AsDateTime := Time;

    if DSConnectEventObject.ChannelInfo <> nil then
    begin
      ClientConnection := TIdTCPConnection(DSConnectEventObject.ChannelInfo.Id);
      dsShowDataSet.FindField('ClientId').AsInteger := DSConnectEventObject.ChannelInfo.Id;
      dsShowDataSet.FindField('ClientIp').AsString := ClientConnection.Socket.Binding.PeerIP +
        ':' + IntToStr(ClientConnection.Socket.Binding.PeerPort);
      dsShowDataSet.FindField('ServerIp').AsString := ClientConnection.Socket.Binding.IP + ':' +
        IntToStr(ClientConnection.Socket.Binding.Port);
    end;

    dsShowDataSet.FindField('ClientUserName').AsString := DSConnectEventObject.ConnectProperties
      [TDBXPropertyNames.UserName];
    dsShowDataSet.FindField('ClientUserPassword').AsString :=
      DSConnectEventObject.ConnectProperties[TDBXPropertyNames.Password];
    dsShowDataSet.FindField('ServerInfo').AsString := '下线';
    dsShowDataSet.Post;
  end;

  Dec(g_CurrentConnNum);
end;

procedure TServerContainer1.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := ServerMethodsUnit1.TServerMethods1;
end;

end.