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;

//....      

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;      

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;