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;

截个图：

源码下载：https://download.csdn.net/download/xieyunc/9055713

转载于:https://www.cnblogs.com/xieyunc/p/4839595.html