1 unit GlobVar;
 2
 3 interface
 4
 5 uses System.SysUtils, System.Classes,IdTCPConnection,System.Generics.Collections,
 6   Datasnap.DSTCPServerTransport,IdWinsock2,Data.DBXCommon,Datasnap.DBClient,
 7   Datasnap.DSServer, Datasnap.DSCommonServer;
 8
 9 type
10   pClientConns = ^TClientConns; // 客户连接
11
12   TClientConns = record
13     ClientId: integer;
14     Ip: string;
15     Port: string;
16     LoginTime: TDateTime;
17   end;
18
19 const
20   gb_MaxConnNum = 1000;//每个进程最大连接数设置为1000
21
22 var
23   gb_ClientConnects: TDictionary<TIdTCPConnection, pClientConns>; // 客户端连接字典
24   gb_ConnnectCount:Integer=0;
25
26 //.... 

 1 uses GlobVar;
 2 //...
 3 procedure TServerContainer1.DSTCPServerTransport1Connect(Event: TDSTCPConnectEventObject);
 4 var
 5   p: pClientConns;
 6 begin
 7   try
 8     if gb_ConnnectCount >= gb_MaxConnNum then
 9     begin
10       LogInfo('已超过系统授权的客户连接数');
11       TIdTCPConnection(Event.Connection).Disconnect;
12       Exit;
13     end;
14     InterlockedIncrement(gb_ConnnectCount);
15     New(p);
16     if Assigned(p) then
17     begin
18       p^.ClientId := Event.Channel.ChannelInfo.Id;
19       p^.Ip := Event.Channel.ChannelInfo.ClientInfo.IpAddress;
20       p^.Port := Event.Channel.ChannelInfo.ClientInfo.ClientPort;
21       p^.LoginTime := Now;
22       gb_ClientConnects.Add(TIdTCPConnection(Event.Connection), p);
23       PostMessage(Application.SrvMainForm.Handle, WM_ADDUSER, wParam(p),lParam(TIdTCPConnection(Event.Connection)));
24     end;
25   except
26     Exit;
27   end;
28 end;
29
30 procedure TServerContainer1.DSTCPServerTransport1Disconnect(Event: TDSTCPDisconnectEventObject);
31 var
32   p: pClientConns;
33 begin
34   try
35     if gb_ConnnectCount >= 1 then
36       InterlockedDecrement(GlobalVar.gb_ConnnectCount);//GlobalVar.pas单元中定义了系统全局变量
37     p := gb_ClientConnects.Items[TIdTCPConnection(Event.Connection)];
38     if Assigned(p) then
39     begin
40       SendMessage(Application.SrvMainForm.Handle, WM_DELUSER, wParam(p), 0);
41       gb_ClientConnects.Remove(TIdTCPConnection(Event.Connection));
42     end;
43   except
44     Exit;
45   end;
46 end;

 1 procedure TSrvMainForm.AddUser(var msg: TMessage);
 2 var
 3   p: pClientConns;
 4 begin
 5   try
 6   lbl_MaxCount.Caption := IntToStr(gb_ConnnectCount);
 7   p := pClientConns(msg.WParam);
 8   if Assigned(p) then
 9   begin
10     ClientDataSet1.Append;
11     ClientDataSet1.FieldByName('Id').AsInteger := p^.ClientId;
12     ClientDataSet1.FieldByName('Ip').AsString := p^.Ip;
13     ClientDataSet1.FieldByName('Port').AsString := p^.Port;
14     ClientDataSet1.FieldByName('LoginTime').AsDateTime := p^.LoginTime;
15     ClientDataSet1.FieldByName('Conn').AsInteger := msg.LParam;
16     ClientDataSet1.Post;
17   end;
18   except
19     on E: Exception do
20     begin
21       LogInfo('TSrvMainForm.AddUser---' + E.Message);
22       exit;
23     end;
24   end;
25 end;
26
27 procedure TSrvMainForm.DelUser(var msg: TMessage);
28 var
29   p: pClientConns;
30 begin
31   try
32     lbl_MaxCount.Caption := IntToStr(gb_ConnnectCount);
33     p := pClientConns(msg.WParam);
34     if Assigned(p) then
35     begin
36       if ClientDataSet1.FindKey([p^.ClientId]) then  //Id字段请设置索引
37         ClientDataSet1.Delete;
38       Dispose(p);
39     end;
40   except
41     on E: Exception do
42     begin
43       LogInfo('TSrvMainForm.DelUser---' + E.Message);
44       Exit;
45     end;
46   end;
47 end;

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