appclient_unit.pas

Delphi快速开发Web Server

      end
    else if not inMainThread then
      // need to call the event synchronized, since we are accessing the GUI
      Sync(MultiResultReturn, Data,Result)
    else
      begin
      // We've gone through all requested interrations,
      // time to update the counter display and disconnect,
      // since we probably won't be using this connection anymore.
      x:=Info.asInteger['ID'];
      myBox.Canvas.Pen.Color:=clAqua;
      myBox.Canvas.MoveTo(x,0);
      myBox.Canvas.LineTo(x,myBox.Height-1);
      eConCnt.Text:=IntToStr(StrToInt(eConCnt.Text)-1);

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

      if xAutoDisconnect.Checked then
        begin
        Info.asBoolean['closed']:=True;
        Disconnect;
        end;

      lblMemTotal.Caption:=Format('%.0n KB',[Get_AddressSpaceUsed*1.0]);

      // Are all connections finished?
      if eConCnt.Text='0' then
        begin
        btnMultiFlood.Enabled:=True;

        btnMultiCreate.Enabled:=True;

        eConCnt.Enabled:=True;
        eConCnt.Text:=IntToStr(length(CliCon));
        // Update our MAX, LEFT and CNT values.
        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 frequency');
          Exit;
          end;
        // Do we have to repeat the whole thing once again?
        if xReqAutoRepeat.Checked then
          begin
          btnMultiCreate.Enabled:=False;

          btnMultiFlood.Enabled:=False;
          eConCnt.Enabled:=False;
          { This loop will Post one request using each Client Module
            and re-open each connection by calling "Connect".
            We have to open the connections here again, because
            we chose to close them when they have finished their jobs. }
          myBox.Canvas.Brush.Color:=clBtnFace;
          myBox.Canvas.FillRect(Rect(0,0,myBox.Width,myBox.Height));
          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);
            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'));
              // When making the call from inside our own event, need to use TRUE!!!
              Call(MultiResult, CliCon[a]=Sender);
              end;
            with CliCon[a] do
              begin
              with Info do
                begin
                asInteger['MAX']:=req;
                asInteger['CNT']:=req;
                asInteger['LEFT']:=req;
                asInteger['UPD']:=upd;
                if asBoolean['closed'] then
                  begin
                  asBoolean['closed']:=False;
                  if not AutoConnect then
                    Connect;
                  end;
                end;
              end;
            end;
          end
        else
          begin
          with TRtcClientModule(Info.Obj['MOD']) do
          { Looks like we won't be needing those connection and
            ClientModule components, it's time to release them from memory.
            Since we are not allowed to release the ClientModule from
            inside that module's result event, we need to post this
            request to be executed interactive (check start of this event).

            We will also clear the "Client" property of our ClientModule,
            to know that we posted Interactive from here. }
            Client:=nil;
          PostInteractive;
          end;
        end;
      end;
    end;
  end;

procedure TForm1.xProxyClick(Sender: TObject);
  begin
  RtcClient.Disconnect;
  try
    RtcClient.UseProxy:=xProxy.Checked;
  finally
    xProxy.Checked:=RtcClient.UseProxy;
    end;
  end;

procedure TForm1.xSSLClick(Sender: TObject);
  begin
  RtcClient.Disconnect;
  try
    RtcClient.UseSSL:=xSSL.Checked;
  finally
    xSSL.Checked:=RtcClient.UseSSL;
    if xSSL.Checked then
      ePort.Text:='443'
    else
      ePort.Text:='80';
    end;
  end;

procedure TForm1.xMultiThreadedClick(Sender: TObject);
  begin
  RtcClient.Disconnect;
  try
    RtcClient.MultiThreaded:=xMultiThreaded.Checked;
  finally
    xMultiThreaded.Checked:=RtcClient.MultiThreaded;
    end;
  end;

procedure TForm1.xAutoConnectClick(Sender: TObject);
  begin
  RtcClient.Disconnect;
  try
    RtcClient.AutoConnect:=xAutoConnect.Checked;
  finally
    xAutoConnect.Checked:=RtcClient.AutoConnect;
    end;
  end;

procedure TForm1.btnMultiCreateClick(Sender: TObject);
  var
    cnt,req,a:integer;
  begin
  myPanel.Refresh;
  SimpleCall:=not xExtensiveTest.Checked;

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

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

  btnMultiFlood.Enabled:=False;

  btnMultiCreate.Enabled:=False;

  btnMultiConnect.Enabled:=True;
  btnMultiSend.Enabled:=True;
  btnMultiDisconnect.Enabled:=True;
  btnMultiFree.Enabled:=True;

  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;
      Info.asInteger['ID']:=a;
      Info.asInteger['CNT']:=0;
      Info.asInteger['MAX']:=req;
      end;
    with CliMod[a] do
      begin
      AutoRepost:=-1; // unlimited
      AutoSessions:=True;
      if xEncrypt2.Checked then
        EncryptionKey:=16;
      if xCompress.Checked then
        Compression:=cFast;
      ModuleFileName:=RtcClientModule1.ModuleFileName;
      ModuleHost:=RtcClientModule1.ModuleHost;
      SecureKey:=RtcClientModule1.SecureKey;
      DataFormat:=RtcClientModule1.DataFormat;
      Client:=CliCon[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;
    end;
  end;

procedure TForm1.btnMultiSendClick(Sender: TObject);
  var
    a:integer;
  begin
  SimpleCall:=not xExtensiveTest.Checked;
  for a:=0 to Length(CliMod)-1 do
    begin
    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(SendResult);
      end;
    end;
  end;

procedure TForm1.SendResultReturn(Sender: TRtcConnection; Data,Result: TRtcValue);
  var
    x,y:integer;
  begin
  with TRtcDataClient(Sender) do
    if not inMainThread then
      Sync(SendResultReturn,Data,Result)
    else
      begin
      Info.asInteger['CNT']:=Info.asInteger['CNT']+1;
      if Info.asInteger['CNT']>=Info.asInteger['MAX'] then
        Info.asInteger['CNT']:=1;

      x:=Info.asInteger['ID'];
      y:=myBox.Height-round(Info.asInteger['CNT']/Info.asInteger['MAX']*myBox.Height);

      if Info.asInteger['CNT'] mod 2=0 then
        myBox.Canvas.Pen.Color:=clMaroon
      else
        myBox.Canvas.Pen.Color:=clRed;

      myBox.Canvas.MoveTo(x,0);
      myBox.Canvas.LineTo(x,y);
      myBox.Canvas.Pen.Color:=clLime;
      myBox.Canvas.LineTo(x,myBox.Height);

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

procedure TForm1.btnMultiFreeClick(Sender: TObject);
  var
    a:integer;
  begin
  // We are releasing all connection components.
  // This will free them from memory,
  // without calling "OnDisconnect".
  // This is something that you should NOT do
  // from a normal client application.
  for a:=0 to length(CliCon)-1 do
    begin
    CliCon[a].Release;
    CliMod[a].Free;
    end;
  eConCnt.Enabled:=True;
  eConCnt.Text:=IntToStr(length(CliCon));

  SetLength(CliCon,0);
  SetLength(CliMod,0);

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

  btnMultiFlood.Enabled:=True;

  btnMultiCreate.Enabled:=True;
  btnMultiConnect.Enabled:=False;
  btnMultiSend.Enabled:=False;
  btnMultiDisconnect.Enabled:=False;
  btnMultiFree.Enabled:=False;
  end;

procedure TForm1.MultiClientConnect(Sender: TRtcConnection);
  begin
  if not Sender.inMainThread then
    Sender.Sync(MultiClientConnect)
  else
    begin
    Inc(ClientCnt);
    lblClients.Caption:=IntToStr(ClientCnt);
    end;
  end;

procedure TForm1.MultiClientDisconnect(Sender: TRtcConnection);
  begin
  if not Sender.inMainThread then
    Sender.Sync(MultiClientDisconnect)
  else
    begin
    Dec(ClientCnt);
    lblClients.Caption:=IntToStr(ClientCnt);
    end;
  end;

procedure TForm1.btnMultiConnectClick(Sender: TObject);
  var
    a:integer;
  begin
  for a:=0 to Length(CliMod)-1 do
    CliCon[a].Connect;
  end;

procedure TForm1.btnMultiDisconnectClick(Sender: TObject);
  var
    a:integer;
  begin
  for a:=0 to length(CliCon)-1 do
    CliCon[a].Disconnect;
  end;

procedure TForm1.btnConnDisconnClick(Sender: TObject);
  var
    a:integer;
  begin
  for a:=1 to 10 do
    begin
    RtcClient.Connect;
    RtcClient.Disconnect;
    end;
  end;

procedure TForm1.xEncryptClick(Sender: TObject);
  begin
  if xEncrypt.Checked then
    RtcClientModule1.EncryptionKey:=16
  else
    begin
    RtcClientModule1.EncryptionKey:=0;
    RtcClientModule1.AutoSessions:=False;
    end;
  end;

procedure TForm1.xCompressClick(Sender: TObject);
  begin
  if xCompress.Checked then
    RtcClientModule1.Compression:=cFast
  else
    RtcClientModule1.Compression:=cNone;
  end;

procedure TForm1.Timer1Timer(Sender: TObject);
  begin
  lblMemTotal.Caption:=Format('%.0n KB',[Get_AddressSpaceUsed*1.0]);
  end;

procedure TForm1.xUseXMLClick(Sender: TObject);
  begin
  if xUseXML.Checked then
    RtcClientModule1.DataFormat:=fmt_XMLRPC
  else
    RtcClientModule1.DataFormat:=fmt_RTC;
  end;

end.