appclient_unit.pas

Delphi快速开发Web Server

(***************************************************)
(** Methods used by MULTI-CONNECTION FLOOD TEST! ***)
(***************************************************)

procedure TForm1.eMaxConExit(Sender: TObject);
  begin
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_CONNECT]:=StrToInt(eMaxCon.Text);
  end;

procedure TForm1.eMaxReadExit(Sender: TObject);
  begin
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_READ]:=StrToInt(eMaxRead.Text);
  end;

procedure TForm1.eMaxWriteExit(Sender: TObject);
  begin
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_WRITE]:=StrToInt(eMaxWrite.Text);
  end;

procedure TForm1.xLimitConnClick(Sender: TObject);
  begin
  RTC_LIMIT_CONN:=xLimitConn.Checked;
  end;

procedure TForm1.btnFloodClick(Sender: TObject);
  var
    a:integer;
  begin
  for a:=1 to 250 do // x 4 = 1.000
    begin
    Edit1.Text:=IntToStr(random(1000000));
    Edit2.Text:=IntToStr(random(1000000));
    Edit4.Text:=IntToStr(random(1000000));
    Edit5.Text:=IntToStr(random(1000000));
    end;
  end;

procedure PrepareBigFunction(Func:TRtcFunctionInfo);
  var
    a:integer;
  begin
  with Func do
    begin
    with newRecord('data') do
      begin
      with NewFunction('func','add') do
        begin
        with NewFunction('A','add') do
          begin
          asInteger['A']:=random(1000000);
          asInteger['B']:=random(1000000);
          end;
        with NewFunction('B','mul') do
          begin
          asInteger['A']:=random(1000000);
          asInteger['B']:=random(1000000);
          end;
        end;
      with newArray('arr') do
        begin
        asBoolean[0]:=true;
        asBoolean[1]:=false;
        asInteger[2]:=random(123456789);
        asLargeInt[3]:=random(1234567890);
        asFloat[4]:=random(123456789)/1000;
        asCurrency[5]:=random(123456789)/100;
        asDateTime[6]:=Now;
        asException[7]:='Test Exception message';
        asVarName[8]:='Test Variable name';
        asWideString[9]:='Test Wide String';
        asText[10]:='Test Text';
        asString[11]:='Test String';
        with NewRecord(12) do
          begin
          asBoolean['bool1']:=true;
          asBoolean['bool2']:=false;
          asInteger['int']:=random(123456789);
          asLargeInt['lint']:=random(1234567890);
          asFloat['float']:=random(123456789)/1000;
          asCurrency['curr']:=random(123456789)/100;
          asDateTime['dat']:=Now;
          asException['exc']:='Test Exception message';
          asVarName['var']:='Test Variable name';
          asWideString['wstr']:='Test Wide String';
          asText['txt']:='Test Text';
          asString['str']:='Test String';
          end;
        end;
      with newRecord('rec') do
        begin
        asBoolean['bool1']:=true;
        asBoolean['bool2']:=false;
        asInteger['int']:=random(123456789);
        asLargeInt['lint']:=random(1234567890);
        asFloat['float']:=random(123456789)/1000;
        asCurrency['curr']:=random(123456789)/100;
        asDateTime['dat']:=Now;
        asException['exc']:='Test Exception message';
        asVarName['var']:='Test Variable name';
        asWideString['wstr']:='Test Wide String';
        asText['txt']:='Test Text';
        asString['str']:='Test String';
        with NewRecord('rec') do
          begin
          asBoolean['bool1']:=true;
          asBoolean['bool2']:=false;
          asInteger['int']:=random(123456789);
          asLargeInt['lint']:=random(1234567890);
          asFloat['float']:=random(123456789)/1000;
          asCurrency['curr']:=random(123456789)/100;
          asDateTime['dat']:=Now;
          asException['exc']:='Test Exception message';
          asVarName['var']:='Test Variable name';
          asWideString['wstr']:='Test Wide String';
          asText['txt']:='Test Text';
          asString['str']:='Test String';
          end;
        end;
      with NewDataSet('dset') do
        begin
        for a:=1 to 10 do // 10 complex records
          begin
          Append;
          asBoolean['bool1']:=true;
          asBoolean['bool2']:=false;
          asInteger['int']:=random(123456789);
          asLargeInt['lint']:=random(1234567890)*random(100000);
          asFloat['float']:=random(123456789)/1000;
          asCurrency['curr']:=random(123456789)/100;
          asDateTime['dat']:=Now;
          asException['exc']:='Test Exception message';
          asVarName['var']:='Test Variable name';
          asWideString['wstr']:='Test Wide String';
          asText['txt']:='Test Text';
          asString['str']:='Test String';
          with newArray('arr') do
            begin
            asBoolean[0]:=true;
            asBoolean[1]:=false;
            asInteger[2]:=random(123456789);
            asLargeInt[3]:=random(1234567890)*random(100000);
            asFloat[4]:=random(123456789)/1000;
            asCurrency[5]:=random(123456789)/100;
            asDateTime[6]:=Now;
            asException[7]:='Test Exception message';
            asVarName[8]:='Test Variable name';
            asWideString[9]:='Test Wide String';
            asText[10]:='Test Text';
            asString[11]:='Test String';
            with NewRecord(12) do
              begin
              asBoolean['bool1']:=true;
              asBoolean['bool2']:=false;
              asInteger['int']:=random(123456789);
              asLargeInt['lint']:=random(1234567890)*random(100000);
              asFloat['float']:=random(1234567890)/10000;
              asCurrency['curr']:=random(1234567890)/100;
              asDateTime['dat']:=Now;
              asException['exc']:='Test Exception message';
              asVarName['var']:='Test Variable name';
              asWideString['wstr']:='Test Wide String';
              asText['txt']:='Test Text';
              asString['str']:='Test String';
              end;
            end;
          with newRecord('rec') do
            begin
            asBoolean['bool1']:=true;
            asBoolean['bool2']:=false;
            asInteger['int']:=random(1234567890);
            asLargeInt['lint']:=random(1234567890)*random(100000);
            asFloat['float']:=random(1234567890)/(random(10000)+1);
            asCurrency['curr']:=random(1234567890)/(random(100)+1);
            asDateTime['dat']:=Now;
            asException['exc']:='Test Exception message';
            asVarName['var']:='Test Variable name';
            asWideString['wstr']:='Test Wide String';
            asText['txt']:='Test Text';
            asString['str']:='Test String';
            with NewRecord('rec') do
              begin
              asBoolean['bool1']:=true;
              asBoolean['bool2']:=false;
              asInteger['int']:=random(123456789);
              asLargeInt['lint']:=random(1234567890);
              asFloat['float']:=random(123456789)/(random(1000)+1);
              asCurrency['curr']:=random(123456789)/(random(100)+1);
              asDateTime['dat']:=Now;
              asException['exc']:='Test Exception message';
              asVarName['var']:='Test Variable name';
              asWideString['wstr']:='Test Wide String';
              asText['txt']:='Test Text';
              asString['str']:='Test String';
              end;
            end;
          end;
        end;
      end;
    end;
  end;

procedure TForm1.btnMultiFloodClick(Sender: TObject);
  var
    cnt,req,upd,a:integer;
  begin
  // DO NOT TRY TO CHANGE THIS WHEN CONNECTIONS ARE ACTIVE!
  try
    RTC_THREAD_POOL_MAX:=StrToInt(Trim(eThreads.Text));
  except
    Showmessage('Invalid value for Max Threads');
    Exit;
    end;

  myPanel.Refresh;

  SimpleCall:=not xExtensiveTest.Checked;

  ClientCnt:=0;
  FloodCnt:=0;
  lblClients.Caption:='0';
  lblFlood.Caption:='0';

  try
    cnt:=StrToInt(eConCnt.Text);
  except
    ShowMessage('Invalid value for Connection count');
    Exit;
    end;
  try
    req:=StrToInt(eReqCnt.Text);
  except
    ShowMessage('Invalid value for Request count');
    Exit;
    end;
  try
    upd:=StrToInt(eUpdCnt.Text);
  except
    ShowMessage('Invalid value for Update count');
    Exit;
    end;

  btnMultiCreate.Enabled:=False;

  btnMultiFlood.Enabled:=False;
  eConCnt.Enabled:=False;

  SetLength(CliCon,cnt);
  SetLength(CliMod,cnt);
  // Create new connection and client module components ...
  for a:=0 to cnt-1 do
    begin
    CliCon[a]:=TRtcHttpClient.Create(nil);
    CliMod[a]:=TRtcClientModule.Create(nil);
    with CliCon[a] do
      begin
      ServerAddr:=eServer.Text;
      ServerPort:=ePort.Text;
      MultiThreaded:=xReqMultiThread.Checked;

      AutoConnect:=xReqAutoConnect.Checked;
      UseProxy:=xProxy.Checked;
      UseSSL:=xSSL.Checked;

      ReconnectOn.ConnectError:=True;
      ReconnectOn.ConnectLost:=True;
      ReconnectOn.ConnectFail:=True;
      OnConnecting:=MultiClientConnect;
      OnDisconnecting:=MultiClientDisconnect;
      Timeout.AfterConnecting:=RtcClient.Timeout.AfterConnecting;
      Timeout.AfterConnect:=RtcClient.Timeout.AfterConnect;
      end;
    with CliMod[a] do
      begin
      AutoRepost:=-1; // unlimited
      AutoSessions:=True;
      if xEncrypt2.Checked then
        EncryptionKey:=16;
      if xCompress2.Checked then
        Compression:=cFast;
      ModuleFileName:=RtcClientModule1.ModuleFileName;
      ModuleHost:=RtcClientModule1.ModuleHost;
      SecureKey:=RtcClientModule1.SecureKey;
      DataFormat:=RtcClientModule1.DataFormat;
      Client:=CliCon[a];
      end;
    with CliCon[a].Info do
      begin
      Obj['MOD']:=CliMod[a];
      asInteger['CNT']:=req;
      asInteger['LEFT']:=req;
      asInteger['MAX']:=req;
      asInteger['UPD']:=upd;
      asInteger['ID']:=a;
      end;
    end;
  myBox.Canvas.Brush.Color:=clBtnFace;
  myBox.Canvas.FillRect(Rect(0,0,myBox.Width,myBox.Height));
  myBox.Canvas.Brush.Color:=clNone;
  for a:=0 to Length(CliMod)-1 do
    begin
    myBox.Canvas.Pen.Color:=clMaroon;
    myBox.Canvas.MoveTo(a,0);
    myBox.Canvas.LineTo(a,myBox.Height-1);
    if not CliCon[a].AutoConnect then
      CliCon[a].Connect;
    with CliMod[a] do
      begin
      // Call the Add function
      if SimpleCall then
        begin
        with Data.NewFunction('add') do
          begin
          with NewFunction('A','add') do
            begin
            asInteger['A']:=random(1000000);
            asInteger['B']:=random(1000000);
            end;
          with NewFunction('B','mul') do
            begin
            asInteger['A']:=random(1000000);
            asInteger['B']:=random(1000000);
            end;
          end;
        end
      else
        PrepareBigFunction(Data.NewFunction('loopo'));
      Call(MultiResult);
      end;
    end;
  end;

procedure TForm1.MultiResultReturn(Sender: TRtcConnection; Data,Result: TRtcValue);
  var
    x,y,a,req,upd:integer;
  begin
  { It is not usual for one RTC application to dinamicaly create
    connection and clientmodule components at runtime.
    It is also adviseable to NOT do this, because it makes your code
    more err-prone, since you will also have to take care about
    releasing the components when they are no longer needed.
    If any normal client application, you should use only 1
    ClientModule (which is best to be placed on your Form)
    for sending remote function calls to a specific ServerModule. }
  if Sender=nil then // posted interactive
    begin
    { We will browse through all connection and
      ClientModule components to release them, one-by-one. }
    for a:=0 to length(CliCon)-1 do
      begin
      { Remove pointer to ClientModule from Connection's Info property.
        It is important to remove all pointers to objects
        stored in the Info property before the object is
        destroyed, to avoid geting access violations if
        component tries to access those objects later. }
      CliCon[a].Info.Obj['MOD']:=nil;

      { Remove the ClientModule component from memory. }
      if CliMod[a].Client=nil then
        { "Release" only works for the component which posted
        the event interactively, so we will use it only if
        this even was posted interactively from component's event
        (check the end of this event). }
        CliMod[a].Release
      else
        begin
        { For all other ClientModule's, we will call "Free" directly,
          since we KNOW that those ClientModule's are not being used anymore. }
        CliMod[a].Free;
        end;

      // When using "Release", OnDisconnect event will NOT be called.
      CliCon[a].Release;
      end;
    ClientCnt:=0;
    lblClients.Caption:='0';
    end
  else if Result.isNull then
    begin
    Log('No Result from Server!');
    end
  else if Result.isType=rtc_Exception then
    begin
    Log('Exception from Server!'#13#10+Result.asException);
    end
  else with TRtcDataClient(Sender) do
    begin
    if Info.asInteger['CNT']>0 then
      begin
      if (Info.asInteger['LEFT']-Info.asInteger['CNT']>=Info.asInteger['UPD']) then
        if not inMainThread then
          Sync(MultiResultReturn,Data,Result)
        else
          begin
          x:=Info.asInteger['ID'];
          y:=round(Info.asInteger['CNT']/Info.asInteger['MAX']*myBox.Height);
          if Info.asInteger['CNT'] mod (Info.asInteger['UPD']*2) >= Info.asInteger['UPD'] then
            myBox.Canvas.Pen.Color:=clRed
          else
            myBox.Canvas.Pen.Color:=clMaroon;
          myBox.Canvas.MoveTo(x,0);
          myBox.Canvas.LineTo(x,y);
          myBox.Canvas.Pen.Color:=clLime;
          myBox.Canvas.LineTo(x,myBox.Height-1);

          FloodCnt:=FloodCnt+Info.asInteger['UPD'];
          lblFlood.Caption:=Format('%.0n',[FloodCnt*1.0]);
          lblFlood.Refresh;

          Info.asInteger['LEFT']:=Info.asInteger['LEFT']-Info.asInteger['UPD'];
          { If MultiThreaded, we had to do a Sync(), so ...
            Event execution will continue in background thread,
            directly after Sync() ... }
          if MultiThreaded then Exit;
          end;
      Info.asInteger['CNT']:=Info.asInteger['CNT']-1;
      with TRtcClientModule(Info.Obj['MOD']) do
        begin
      { WARNING!
        I am calling a remote function from the result event ONLY to avoid filling
        a large number of identical requests into memory, since this is a flood-test.

        NOTE that I am using TRUE as 2nd parameter (FromInsideEvent) for this to work. }

        if SimpleCall then
          begin
          with Data.NewFunction('add') do
            begin
            with NewFunction('A','add') do
              begin
              asInteger['A']:=random(1000000);
              asInteger['B']:=random(1000000);
              end;
            with NewFunction('B','mul') do
              begin
              asInteger['A']:=random(1000000);
              asInteger['B']:=random(1000000);
              end;
            end;
          end
        else
          PrepareBigFunction(Data.NewFunction('loopo'));
        Call(MultiResult,True);
        end;