一个实例，如果客户端是TCP/IP是短连接的情况就没有必要了。
一、GlobVar.pas单元，定义应用系统全局数据类型及变量：
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 //....
二、ServerContainer1.pas单元：
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;
三、SrvMainForm.pas
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;
版权声明：本文为博主原创文章，未经博主允许不得转载。