一个实例,如果客户端是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;