注册 登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

Martian 's Blog

Welcome Martian 's Blog!

 
 
 

日志

 
 
 
 

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

2017-09-04 15:50:27|  分类: delphi |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

//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.

  评论这张
 
阅读(15)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018