DataSnap如何监控Tcp/IP客户端的连接情况

一个实例，如果客户端是TCP/IP是短连接的情况就没有必要了。

一、GlobVar.pas单元，定义应用系统全局数据类型及变量：

unit GlobVar;

interface

uses System.SysUtils, System.Classes,IdTCPConnection,System.Generics.Collections,
  Datasnap.DSTCPServerTransport,IdWinsock2,Data.DBXCommon,Datasnap.DBClient,
  Datasnap.DSServer, Datasnap.DSCommonServer;

type
  pClientConns = ^TClientConns; // 客户连接

  TClientConns = record
    ClientId: integer;
    Ip: string;
    Port: string;
    LoginTime: TDateTime;
  end;

const
  gb_MaxConnNum = 1000;//每个进程最大连接数设置为1000

var
  gb_ClientConnects: TDictionary<TIdTCPConnection, pClientConns>; // 客户端连接字典
  gb_ConnnectCount:Integer=0;

//.... 

二、ServerContainer1.pas单元：

uses GlobVar;
//...
procedure TServerContainer1.DSTCPServerTransport1Connect(Event: TDSTCPConnectEventObject);
var
  p: pClientConns;
begin
  try
    if gb_ConnnectCount >= gb_MaxConnNum then
    begin
      LogInfo('已超过系统授权的客户连接数');
      TIdTCPConnection(Event.Connection).Disconnect;
      Exit;
    end;
    InterlockedIncrement(gb_ConnnectCount);
    New(p);
    if Assigned(p) then
    begin
      p^.ClientId := Event.Channel.ChannelInfo.Id;
      p^.Ip := Event.Channel.ChannelInfo.ClientInfo.IpAddress;
      p^.Port := Event.Channel.ChannelInfo.ClientInfo.ClientPort;
      p^.LoginTime := Now;
      gb_ClientConnects.Add(TIdTCPConnection(Event.Connection), p);
      PostMessage(Application.SrvMainForm.Handle, WM_ADDUSER, wParam(p),lParam(TIdTCPConnection(Event.Connection)));
    end;
  except
    Exit;
  end;
end;

procedure TServerContainer1.DSTCPServerTransport1Disconnect(Event: TDSTCPDisconnectEventObject);
var
  p: pClientConns;
begin
  try
    if gb_ConnnectCount >= 1 then
      InterlockedDecrement(GlobalVar.gb_ConnnectCount);//GlobalVar.pas单元中定义了系统全局变量
    p := gb_ClientConnects.Items[TIdTCPConnection(Event.Connection)];
    if Assigned(p) then
    begin
      SendMessage(Application.SrvMainForm.Handle, WM_DELUSER, wParam(p), 0);
      gb_ClientConnects.Remove(TIdTCPConnection(Event.Connection));
    end;
  except
    Exit;
  end;
end;

三、SrvMainForm.pas

procedure TSrvMainForm.AddUser(var msg: TMessage);
var
  p: pClientConns;
begin
  try
  lbl_MaxCount.Caption := IntToStr(gb_ConnnectCount);
  p := pClientConns(msg.WParam);
  if Assigned(p) then
  begin
    ClientDataSet1.Append;
    ClientDataSet1.FieldByName('Id').AsInteger := p^.ClientId;
    ClientDataSet1.FieldByName('Ip').AsString := p^.Ip;
    ClientDataSet1.FieldByName('Port').AsString := p^.Port;
    ClientDataSet1.FieldByName('LoginTime').AsDateTime := p^.LoginTime;
    ClientDataSet1.FieldByName('Conn').AsInteger := msg.LParam;
    ClientDataSet1.Post;
  end;
  except
    on E: Exception do
    begin
      LogInfo('TSrvMainForm.AddUser---' + E.Message);
      exit;
    end;
  end;
end;

procedure TSrvMainForm.DelUser(var msg: TMessage);
var
  p: pClientConns;
begin
  try
    lbl_MaxCount.Caption := IntToStr(gb_ConnnectCount);
    p := pClientConns(msg.WParam);
    if Assigned(p) then
    begin
      if ClientDataSet1.FindKey([p^.ClientId]) then  //Id字段请设置索引
        ClientDataSet1.Delete;
      Dispose(p);
    end;
  except
    on E: Exception do
    begin
      LogInfo('TSrvMainForm.DelUser---' + E.Message);
      Exit;
    end;
  end;
end;