DataSnap Demo：TFDConnection、最大连接数、客户端回叫功能、多线程模拟、压力测试等

一、限制最大连接数，并验证来访者用户身份：

procedure TServerContainer1.DSServer1Connect(
  DSConnectEventObject: TDSConnectEventObject);
var
  sError:string;
begin
  //限制最大连接数，并且验证来访者密码
  if (DSConnectEventObject.ChannelInfo = nil)
     or (FConnections.Count > _MaxConnCount)
     or (DSConnectEventObject.ConnectProperties[TDBXPropertyNames.UserName] <> _UserName)
     or (DSConnectEventObject.ConnectProperties[TDBXPropertyNames.Password] <> _UserPassWord)
     //or (DSConnectEventObject.ChannelInfo.ClientInfo.IpAddress)<>'127.0.0.1')
     then
  begin
  try
    //客户端调用RegisterCallback或UnRegisterCallback方法时，_UserName和_UserPassWord将赋值给
    //TDBXPropertyNames.DSAuthenticationUser和TDBXPropertyNames.DSAuthenticationPassword这两个属性，
    //而真正的TDBXPropertyNames.UserName和TDBXPropertyNames.Password属性反而没有被赋值，不知道这算不算XE的一个BUG。
    //本人已修正这一“BUG”，在Datasnap.DSCommon.pas单元的第484行附近的这一函数：
    //function TDSClientCallbackChannelManager.DBXConnectionProperties(NoTimeout: Boolean): TDBXDatasnapProperties;
    //中，加上了对TDBXPropertyNames.UserName和TDBXPropertyNames.Password属性的赋值，此单元源文件我放在Demo目录下了。
    //必须加上此判断，因为注销回叫函数时会新开一个连接测试服务器是否可用，如果不加上此判断，当客户端连接数正好达到
    //我们设置的最大连接数时，因再无连接数可用会导致回叫函数一直无法被注销。
    if (DSConnectEventObject.ChannelInfo <> nil) and
       (DSConnectEventObject.ConnectProperties[TDBXPropertyNames.DSAuthenticationUser] = _UserName) and
       (DSConnectEventObject.ConnectProperties[TDBXPropertyNames.DSAuthenticationPassword] = _UserPassWord) then
       Exit;

    if (FConnections.Count > _MaxConnCount) then
    begin
      sError := '客户端超过服务器的最大连接数了！'
    end
    else if (DSConnectEventObject.ConnectProperties[TDBXPropertyNames.UserName]<>_UserName) or
            (DSConnectEventObject.ConnectProperties[TDBXPropertyNames.Password]<>_UserPassWord) then
      sError := '认证失败！非法的接入用户，连接被拒绝！'
    else
      sError := '';
    DSConnectEventObject.DbxConnection.Destroy;
  except
    on e:Exception do
    begin
      if sError<>'' then
        raise Exception.Create(sError)
      else
        raise e;
    end;
  end;
  end;
end;

二、最大连接数的设定

procedure TSrvMainForm.InitDSServerOpt;
begin
  _MaxConnCount := StrToIntDef(edt_MaxCount.Text,0);
  ServerContainer1.DSTCPServerTransport1.MaxThreads := _MaxConnCount+5;
  _UserName := edt_UserName.Text;
  _UserPassWord := edt_UserPwd.Text;
  //千万别设置MaxThreads属性，如果设置此属性，一旦客户端连接数超此值，服务器并不会向客户端反馈任何消息，
  //而是把客户端连接请求放入队列中，一直等到直至服务器有空闲、断开或者其他原因得到的“可用的”连接资源，
  //从而导致客户端进入假死状态。
  //ServerContainer1.DSTCPServerTransport1.MaxThreads := _MaxConnCount;
end;

三、动态注册回叫控件

procedure TClientMainForm.btn_RegCallback_DynClick(Sender: TObject);
var
  i:integer;
  se:Cardinal;
  sManagerId,sCallbackId:string;
begin
  se := GetTickCount;
  edt_SecondLength.Text := '';
  Memo1.Lines.Clear;
  Application.ProcessMessages;

  Screen.Cursor := crHourGlass;
  try
    FarrCount := StrToIntDef(edt_CallbackCount.Text,1);
    btn_UnRegCallback_DynClick(Self);
    SetLength(arrChannelManager,FarrCount);

    for i := Low(arrChannelManager) to High(arrChannelManager) do
    begin
      sCallbackId := Format('%.4d',[i+1]); //IntToStr(GetTickCount());//'XXX-LMM';
      sManagerId := '客户端_'+sCallbackId;
      if not Assigned(arrChannelManager[i]) then
        arrChannelManager[i] := TDSClientCallbackChannelManager.Create(nil)
      else
        arrChannelManager[i].UnregisterCallback(sCallbackId);

      arrChannelManager[i].ChannelName := 'jfglxt'; //可以把应用程序标识存放于此
      arrChannelManager[i].ManagerId := sManagerId;
      arrChannelManager[i].CommunicationProtocol := 'tcp/ip';
      arrChannelManager[i].DSHostname := edt_SrvIp.Text;
      arrChannelManager[i].DSPort := '211';
      arrChannelManager[i].UserName := edt_UserName.Text;
      arrChannelManager[i].Password := edt_UserPwd.Text;

      arrChannelManager[i].RegisterCallback(sCallbackId,TDemoCallback.Create);
      edt_CallbackCount.Text := IntToStr(i+1);
      Application.ProcessMessages;
    end;
  finally
    edt_SecondLength.Text := Format('%fs',[(gettickcount()-se)/1000]);
    Screen.Cursor := crDefault;
  end;
end;

四、创建多个线程，对数据库进行查询

procedure TClientMainForm.btn_RegCallback_DynClick(Sender: TObject);
var
  i:integer;
  se:Cardinal;
  sManagerId,sCallbackId:string;
begin
  se := GetTickCount;
  edt_SecondLength.Text := '';
  Memo1.Lines.Clear;
  Application.ProcessMessages;

  Screen.Cursor := crHourGlass;
  try
    FarrCount := StrToIntDef(edt_CallbackCount.Text,1);
    btn_UnRegCallback_DynClick(Self);
    SetLength(arrChannelManager,FarrCount);

    for i := Low(arrChannelManager) to High(arrChannelManager) do
    begin
      sCallbackId := Format('%.4d',[i+1]); //IntToStr(GetTickCount());//'XXX-LMM';
      sManagerId := '客户端_'+sCallbackId;
      if not Assigned(arrChannelManager[i]) then
        arrChannelManager[i] := TDSClientCallbackChannelManager.Create(nil)
      else
        arrChannelManager[i].UnregisterCallback(sCallbackId);

      arrChannelManager[i].ChannelName := 'jfglxt'; //可以把应用程序标识存放于此
      arrChannelManager[i].ManagerId := sManagerId;
      arrChannelManager[i].CommunicationProtocol := 'tcp/ip';
      arrChannelManager[i].DSHostname := edt_SrvIp.Text;
      arrChannelManager[i].DSPort := '211';
      arrChannelManager[i].UserName := edt_UserName.Text;
      arrChannelManager[i].Password := edt_UserPwd.Text;

      arrChannelManager[i].RegisterCallback(sCallbackId,TDemoCallback.Create);
      edt_CallbackCount.Text := IntToStr(i+1);
      Application.ProcessMessages;
    end;
  finally
    edt_SecondLength.Text := Format('%fs',[(gettickcount()-se)/1000]);
    Screen.Cursor := crDefault;
  end;
end;

截个图：

源码下载：

DataSanpDemo.rar