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.