appclient_unit.pas

Delphi快速开发Web Server

unit AppClient_Unit;

{$include rtcDeploy.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,

  rtcLog,
  rtcFunction, rtcDataCli, rtcCliModule, rtcInfo, rtcConn,
  rtcHttpCli, rtcThrPool, rtcConnLimit, ComCtrls,

  {$IFDEF rtcTest}
  WSocket_rtc,
  {$endif}

  rtcMemory;

type
  TForm1 = class(TForm)
    RtcClient: TRtcHttpClient;
    RtcClientModule1: TRtcClientModule;
    RtcResult1: TRtcResult;
    RtcResult2: TRtcResult;
    RtcResult3: TRtcResult;
    MultiResult: TRtcResult;
    myPanel: TPanel;
    Panel1: TPanel;
    myBox: TPaintBox;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    eModule: TEdit;
    eServer: TEdit;
    xProxy: TCheckBox;
    ePort: TEdit;
    xSSL: TCheckBox;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    xLimitConn: TCheckBox;
    eMaxCon: TEdit;
    eMaxRead: TEdit;
    eMaxWrite: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    lblCount: TLabel;
    lblTotal: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    btnFlood: TButton;
    xFlood: TCheckBox;
    xRepost: TCheckBox;
    btnConnect: TButton;
    xAutoConnect: TCheckBox;
    xMultiThreaded: TCheckBox;
    TabSheet3: TTabSheet;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    lblFlood: TLabel;
    lblClients: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    eConCnt: TEdit;
    eReqCnt: TEdit;
    btnMultiFlood: TButton;
    xReqAutoRepeat: TCheckBox;
    eUpdCnt: TEdit;
    xAutoDisconnect: TCheckBox;
    xReqAutoConnect: TCheckBox;
    Label22: TLabel;
    Label27: TLabel;
    btnMultiCreate: TButton;
    btnMultiSend: TButton;
    btnMultiDisconnect: TButton;
    SendResult: TRtcResult;
    Label28: TLabel;
    Label29: TLabel;
    btnMultiFree: TButton;
    btnMultiConnect: TButton;
    xReqMultiThread: TCheckBox;
    btnConnDisconn: TButton;
    xEncrypt: TCheckBox;
    xEncrypt2: TCheckBox;
    Label30: TLabel;
    eModuleHost: TEdit;
    xCompress: TCheckBox;
    xCompress2: TCheckBox;
    Label31: TLabel;
    lblMemTotal: TLabel;
    Timer1: TTimer;
    Label32: TLabel;
    eThreads: TEdit;
    xExtensiveTest: TCheckBox;
    xUseXML: TCheckBox;
    procedure Edit1Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure RtcResult1Return(Sender: TRtcConnection; Data, Result: TRtcValue);
    procedure RtcResult2Return(Sender: TRtcConnection; Data, Result: TRtcValue);
    procedure RtcResult3Return(Sender: TRtcConnection; Data, Result: TRtcValue);
    procedure RtcClientConnect(Sender: TRtcConnection);
    procedure RtcClientDisconnect(Sender: TRtcConnection);
    procedure RtcClientModule1ResponseAbort(Sender: TRtcConnection);
    procedure eModuleChange(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure eServerChange(Sender: TObject);
    procedure btnFloodClick(Sender: TObject);
    procedure xProxyClick(Sender: TObject);
    procedure RtcClientModule1ResponseDone(Sender: TRtcConnection);
    procedure FormCreate(Sender: TObject);
    procedure xRepostClick(Sender: TObject);
    procedure btnMultiFloodClick(Sender: TObject);
    procedure MultiResultReturn(Sender: TRtcConnection; Data,
      Result: TRtcValue);
    procedure eMaxConExit(Sender: TObject);
    procedure eMaxReadExit(Sender: TObject);
    procedure eMaxWriteExit(Sender: TObject);
    procedure xLimitConnClick(Sender: TObject);
    procedure xSSLClick(Sender: TObject);
    procedure xMultiThreadedClick(Sender: TObject);
    procedure xAutoConnectClick(Sender: TObject);
    procedure btnMultiCreateClick(Sender: TObject);
    procedure btnMultiSendClick(Sender: TObject);
    procedure SendResultReturn(Sender: TRtcConnection; Data,
      Result: TRtcValue);
    procedure btnMultiFreeClick(Sender: TObject);
    procedure MultiClientConnect(Sender: TRtcConnection);
    procedure MultiClientDisconnect(Sender: TRtcConnection);
    procedure btnMultiDisconnectClick(Sender: TObject);
    procedure btnMultiConnectClick(Sender: TObject);
    procedure btnConnDisconnClick(Sender: TObject);
    procedure xEncryptClick(Sender: TObject);
    procedure xCompressClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure xUseXMLClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FloodCnt:int64;
    ClientCnt,
    TotalCnt:int64;
    SimpleCall:boolean;
    CliCon:array of TRtcHttpClient;
    CliMod:array of TRtcClientModule;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.RtcClientConnect(Sender: TRtcConnection);
  begin
  if not Sender.inMainThread then
    Sender.Sync(RtcClientConnect)
  else
    begin
    btnConnect.Caption:='Disconnect';
    Label10.Caption:='Connected to '+Sender.PeerAddr+':'+Sender.PeerPort;
    end;
  end;

procedure TForm1.RtcClientDisconnect(Sender: TRtcConnection);
  begin
  if not Sender.inMainThread then
    Sender.Sync(RtcClientDisconnect)
  else
    begin
    btnConnect.Caption:='Connect';
    Label10.Caption:='Not connected.';
    Label10.Refresh;
    end;
  end;

procedure TForm1.Edit1Change(Sender: TObject);
  begin
  with RtcClientModule1 do
    begin
    StartCalls;
    try
      // Call the Add function
      with Data.NewFunction('add') do
        begin
        if Edit1.Text<>'' then Value['A']:=StrToFloat(Edit1.Text);
        if Edit2.Text<>'' then Value['B']:=StrToFloat(Edit2.Text);
        end;
      Call(RtcResult1);
      // Call Add and Mul in combination
      with Data.NewFunction
      ('add') do
        begin
        // Call function "add" and store the value into "A" parameter
        with NewFunction('A','add') do
          begin
          if Edit1.Text<>'' then Value['A']:=StrToFloat(Edit1.Text);
          if Edit2.Text<>'' then Value['B']:=StrToFloat(Edit2.Text);
          end;
        // Call function "mul" and store the value into "B" parameter
        with NewFunction('B','mul') do
          begin
          if Edit4.Text<>'' then Value['A']:=StrToFloat(Edit4.Text);
          if Edit5.Text<>'' then Value['B']:=StrToFloat(Edit5.Text);
          end;
        // Parameters "A" and "B" are passed down to the function "add"
        // to calculate the final result.
        end;
      Call(RtcResult3);
    finally
      // Post all prepared calls
      Post;
      end;
    end;
  end;

procedure TForm1.Edit4Change(Sender: TObject);
  begin
  with RtcClientModule1 do
    begin
    StartCalls;
    try
      // Call the Mull function ...
      with Data.NewFunction('mul') do
        begin
        if Edit4.Text<>'' then Value['A']:=StrToFloat(Edit4.Text);
        if Edit5.Text<>'' then Value['B']:=StrToFloat(Edit5.Text);
        end;
      Call(RtcResult2);
      // Call Add and Mul in combination ...
      with Data.NewFunction('add') do
        begin
        // Call function "add" and store the value into "A" parameter
        with NewFunction('A','add') do
          begin
          if Edit1.Text<>'' then Value['A']:=StrToFloat(Edit1.Text);
          if Edit2.Text<>'' then Value['B']:=StrToFloat(Edit2.Text);
          end;
        // Call function "mul" and store the value into "B" parameter
        with NewFunction('B','mul') do
          begin
          if Edit4.Text<>'' then Value['A']:=StrToFloat(Edit4.Text);
          if Edit5.Text<>'' then Value['B']:=StrToFloat(Edit5.Text);
          end;
        // Parameters "A" and "B" are passed down to the function "add"
        // to calculate the final result.
        end;
      Call(RtcResult3);
    finally
      // Post all prepared calls
      Post;
      end;
    end;
  end;

procedure TForm1.RtcResult1Return(Sender: TRtcConnection; Data, Result: TRtcValue);
  begin
  if Result.isType=rtc_Exception then
    begin
    Edit3.Text:='Error';
    Label3.Caption:=Result.asString;
    end
  else if Result.isType=rtc_Null then
    begin
    Edit3.Text:='NULL';
    Label3.Caption:='Failed';
    end
  else
    begin
    Edit3.Text:=Result.Value;
    Label3.Caption:='OK';
    end;
  end;

procedure TForm1.RtcResult2Return(Sender: TRtcConnection; Data, Result: TRtcValue);
  begin
  if Result.isType=rtc_Exception then
    begin
    Edit6.Text:='Error';
    Label4.Caption:=Result.asString;
    end
  else if Result.isType=rtc_Null then
    begin
    Edit6.Text:='NULL';
    Label4.Caption:='Failed';
    end
  else
    begin
    Edit6.Text:=Result.Value;
    Label4.Caption:='OK';
    end;
  end;

procedure TForm1.RtcResult3Return(Sender: TRtcConnection; Data, Result: TRtcValue);
  begin
  if Result.isType=rtc_Exception then
    begin
    Edit7.Text:='Error';
    Label9.Caption:=Result.asString;
    end
  else if Result.isType=rtc_Null then
    begin
    Edit7.Text:='NULL';
    Label9.Caption:='Failed';
    end
  else
    begin
    Edit7.Text:=Result.Value;
    Label9.Caption:='OK';
    end;
  end;

procedure TForm1.RtcClientModule1ResponseAbort(Sender: TRtcConnection);
  begin
  with TRtcDataClient(Sender) do
    if MessageDlg('Request reposted '+IntToStr(Request.Reposted)+' times without success.'#13#10+
                  'Try to repost the request again?'#13#10+
                  'If you choose "No", connection will be Closed.', mtError, [mbYes,mbNo],0)=mrYes then
      Request.Repost
    else
      begin
      SkipRequests;
      Disconnect;
      end;
  end;

procedure TForm1.eModuleChange(Sender: TObject);
  begin
  if (RtcClientModule1.ModuleHost<>eModuleHost.Text) or
     (RtcClientModule1.ModuleFileName<>eModule.Text)then
    begin
    RtcClient.SkipRequests;

    RtcClientModule1.ModuleFileName:=eModule.Text;
    RtcClientModule1.ModuleHost:=eModuleHost.Text;

    eModule.Text:=RtcClientModule1.ModuleFileName;
    eModuleHost.Text:=RtcClientModule1.ModuleHost;
    end;
  end;

procedure TForm1.btnConnectClick(Sender: TObject);
  begin
  if RtcClient.isConnected then
    RtcClient.Disconnect
  else
    RtcClient.Connect;
  end;

procedure TForm1.eServerChange(Sender: TObject);
  begin
  if (RtcClient.ServerAddr<>eServer.Text) or
     (RtcClient.ServerPort<>ePort.Text) then
    begin
    eModuleHost.Text:=eServer.Text;

    RtcClient.Disconnect;
    RtcClient.ServerAddr:=eServer.Text;
    RtcClient.ServerPort:=ePort.Text;
    RtcClientModule1.ModuleHost:=eModuleHost.Text;

    eServer.Text:=RtcClient.ServerAddr;
    ePort.Text:=RtcClient.ServerPort;
    eModuleHost.Text:=RtcClientModule1.ModuleHost;
    end;
  end;

procedure TForm1.RtcClientModule1ResponseDone(Sender: TRtcConnection);
  begin
  with TRtcDataClient(Sender) do
    begin
    TotalCnt:=TotalCnt+1;
    lblTotal.Caption:=IntToStr(TotalCnt);
    lblCount.Caption:=IntToStr(RequestCount-1);
    if RequestCount=1 then
      if xFlood.Checked then
        btnFlood.Click;
    end;
  end;

procedure TForm1.FormCreate(Sender: TObject);
  begin
  StartLog;

  {$IFDEF RtcTest}
  //LOG_TIMEOUT_DISCONNECTS:=True;
  LOG_SOCKET_ERRORS:=True;
  LOG_MESSAGE_ERRORS:=True;
  LOG_THREAD_EXCEPTIONS:=True;
  LOG_EXCEPTIONS:=True;
  LOG_AV_ERRORS:=True;
  LOG_EVENT_ERRORS:=True;

  eServer.Text:='server';
  eModuleHost.Text:='server';
  xReqAutoRepeat.Checked:=True;
  PageControl1.ActivePage:=TabSheet3;
  {$endif}

  { If we wanted to test how fast compression works,
    we could force data compression, even though we know there will
    be no gain in compressing the data, only CPU usage increase. }
  //RTC_MIN_COMPRESS_SIZE:=0;

  TotalCnt:=0;
  RTC_LIMIT_CONN:=xLimitConn.Checked;
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_CONNECT]:=StrToInt(eMaxCon.Text);
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_READ]:=StrToInt(eMaxRead.Text);
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_WRITE]:=StrToInt(eMaxWrite.Text);

  Timer1Timer(Timer1);
  end;

procedure TForm1.xRepostClick(Sender: TObject);
  begin
  if xRepost.Checked then
    RtcClientModule1.AutoRepost:=-1 // unlimited repost
  else
    RtcClientModule1.AutoRepost:=2; // report up to 2 times.
  end;