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

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

 //.... 

二、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 >=  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), );
       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;

版权声明：本文为博主原创文章，未经博主允许不得转载。