server_form.pas

Delphi快速开发Web Server

unit Server_Form;

{$include rtcDeploy.inc}

interface

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

  rtcLog, rtcSyncObjs,
  rtcInfo, rtcConn,
  rtcDataSrv, rtcHttpSrv,
  rtcConnLimit,

  {$ifdef rtcTest}
  WSocket_rtc,
  {$endif}

  AppServer_Module, ExtCtrls,

  rtcThrPool,
  rtcMemory;

type
  TForm1 = class(TForm)
    RtcDataServer1: TRtcHttpServer;
    Label1: TLabel;
    btnListen: TButton;
    Label2: TLabel;
    ePort: TEdit;
    Label3: TLabel;
    lblCliCnt: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label23: TLabel;
    Label22: TLabel;
    xLimitConn: TCheckBox;
    eMaxAccept: TEdit;
    eMaxRead: TEdit;
    eMaxWrite: TEdit;
    Label4: TLabel;
    Bevel1: TBevel;
    xEncrypt: TCheckBox;
    xMultiThreaded: TCheckBox;
    xCompress: TCheckBox;
    Timer1: TTimer;
    Label6: TLabel;
    lblTotalMem: TLabel;
    eThreads: TEdit;
    Label5: TLabel;
    Label7: TLabel;
    xMonitorDataInOut: TCheckBox;
    lblDataInOut: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure RtcDataServer1ListenStart(Sender: TRtcConnection);
    procedure RtcDataServer1ListenError(Sender: TRtcConnection;
      E: Exception);
    procedure RtcDataServer1ListenStop(Sender: TRtcConnection);
    procedure btnListenClick(Sender: TObject);
    procedure xLimitConnClick(Sender: TObject);
    procedure eMaxAcceptExit(Sender: TObject);
    procedure eMaxReadExit(Sender: TObject);
    procedure eMaxWriteExit(Sender: TObject);
    procedure RtcDataServer1ClientConnect(Sender: TRtcConnection);
    procedure RtcDataServer1ClientDisconnect(Sender: TRtcConnection);
    procedure xEncryptClick(Sender: TObject);
    procedure xMultiThreadedClick(Sender: TObject);
    procedure xCompressClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure RtcDataServer1ResponseDone(Sender: TRtcConnection);
    procedure RtcDataServer1DataIn(Sender: TRtcConnection);
    procedure RtcDataServer1DataOut(Sender: TRtcConnection);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    CS:TRtcCritSec;
    ResponseDoneCount:int64;
    LastTime,StartTime:longword;
    TotalDataIn,TotalDataOut:int64;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
  begin
  CS:=TRtcCritSec.Create;

  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;
  {$endif}

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

  RTC_LIMIT_CONN:=xLimitConn.Checked;
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_ACCEPT]:=StrToInt(eMaxAccept.Text);
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_READ]:=StrToInt(eMaxRead.Text);
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_WRITE]:=StrToInt(eMaxWrite.Text);

  AppSrv_Module.ServerLink.Server:=RtcDataServer1;

  // Using properties set up by form
  xCompressClick(xCompress);
  xEncryptClick(xEncrypt);
  xMultiThreadedClick(xMultiThreaded);

  ResponseDoneCount:=0;
  Timer1Timer(Timer1);
  end;

procedure TForm1.RtcDataServer1ListenStart(Sender: TRtcConnection);
  begin
  if not Sender.inMainThread then
    Sender.Sync(RtcDataServer1ListenStart)
  else
    begin
    StartTime:=GetTickCount;
    LastTime:=StartTime;


    XLog('Time (sec); Memory (KB); Requests; Connections; Avg req/sec; Curr req/sec; Listener started!');
    XLog('0; '+Format('%.0n', [Get_AddressSpaceUsed*1.0]));
    btnListen.Caption:='Stop';
    Label1.Caption:='Listening on Port '+Sender.LocalPort;
    end;
  end;

procedure TForm1.RtcDataServer1ListenError(Sender: TRtcConnection; E: Exception);
  begin
  if not Sender.inMainThread then
    Sender.Sync(RtcDataServer1ListenError,E)
  else
    Label1.Caption:='Listening Error: '+E.Message;
  end;

procedure TForm1.RtcDataServer1ListenStop(Sender: TRtcConnection);
  var
    cnt:int64;
    m:string;
    tm:longword;
  begin
  if not Sender.inMainThread then
    Sender.Sync(RtcDataServer1ListenStop)
  else
    begin
    tm:=GetTickCount;

    cnt:=ResponseDoneCount;
    m:=Format('%.0n', [Get_AddressSpaceUsed*1.0]);
    lblTotalMem.Caption:=m+' KB';

    XLog(IntToStr((tm-StartTime) div 1000)+
        '; '+Format('%.0n', [Get_AddressSpaceUsed*1.0] )+
        '; '+Format('%.0n', [cnt*1.0] )+
        '; '+Format('%.0n', [Sender.TotalServerConnectionCount*1.0] )+
        '; '+Format('%.1n', [cnt/(tm-StartTime)*1000.0] )+
        '; '+Format('%.1n', [(cnt mod $2000)/(tm-LastTime)*1000.0] ) +
        '; Listener STOPPED!');

    ResponseDoneCount:=0;

    btnListen.Caption:='Listen';
    Label1.Caption:='Stopped listening.';
    end;
  end;

procedure TForm1.btnListenClick(Sender: TObject);
  begin
  if RtcDataServer1.isListening then
    RtcDataServer1.StopListen
  else
    begin
    TotalDataIn:=0;
    TotalDataOut:=0;

    // DO NOT CHANGE THIS WHEN CLIENT OR SERVER ARE RUNNING !!!
    RTC_THREAD_POOL_MAX:=StrToInt(eThreads.Text);

    lblDataInOut.Caption:='???';

    if xMonitorDataInOut.Checked then
      begin
      RtcDataServer1.OnDataIn:=RtcDataServer1DataIn;
      RtcDataServer1.OnDataOut:=RtcDataServer1DataOut;
      end
    else
      begin
      RtcDataServer1.OnDataIn:=nil;
      RtcDataServer1.OnDataOut:=nil;
      end;
    RtcDataServer1.ServerPort:=ePort.Text;
    RtcDataServer1.Listen;
    end;
end;

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

procedure TForm1.eMaxAcceptExit(Sender: TObject);
  begin
  RTC_LIMIT_CONN_COUNT[RTC_ACTION_ACCEPT]:=StrToInt(eMaxAccept.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.RtcDataServer1ClientConnect(Sender: TRtcConnection);
begin
  if not Sender.inMainThread then
    Sender.Sync(RtcDataServer1ClientConnect)
  else
    begin
    lblCliCnt.Caption:=IntToStr(RtcDataServer1.TotalServerConnectionCount);
    lblCliCnt.Refresh;
    end;

end;

procedure TForm1.RtcDataServer1ClientDisconnect(Sender: TRtcConnection);
begin
  if not Sender.inMainThread then
    Sender.Sync(RtcDataServer1ClientDisconnect)
  else
    begin
    lblCliCnt.Caption:=IntToStr(RtcDataServer1.TotalServerConnectionCount);
    lblCliCnt.Refresh;
    end;
end;

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

procedure TForm1.xMultiThreadedClick(Sender: TObject);
  begin
  RtcDataServer1.MultiThreaded:=xMultiThreaded.Checked;
  end;

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

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

procedure TForm1.RtcDataServer1ResponseDone(Sender: TRtcConnection);
  var
    tm:longword;
    cnt:int64;
  begin
  CS.Enter;
    ResponseDoneCount:=ResponseDoneCount+1;
    cnt:=ResponseDoneCount;
  CS.Leave;
  if cnt and $1FFF=0 then
    begin
    tm:=GetTickCount;
    XLog(IntToStr((tm-StartTime) div 1000)+
        '; '+Format('%.0n', [Get_AddressSpaceUsed*1.0] )+
        '; '+Format('%.0n', [cnt*1.0] )+
        '; '+Format('%.0n', [Sender.TotalServerConnectionCount*1.0] )+
        '; '+Format('%.1n', [cnt/(tm-StartTime)*1000.0] )+
        '; '+Format('%.1n', [$2000/(tm-LastTime)*1000.0] ) );
    LastTime:=tm;
    end;
  end;

procedure TForm1.RtcDataServer1DataIn(Sender: TRtcConnection);
  begin
  if not Sender.inMainThread then
    Sender.Sync(RtcDataServer1DataIn)
  else
    begin
    TotalDataIn:=TotalDataIn+Sender.DataIn;
    lblDataInOut.Caption:=IntToStr(TotalDataIn)+' + '+IntToStr(TotalDataOut)+' bytes';
    end;
  end;

procedure TForm1.RtcDataServer1DataOut(Sender: TRtcConnection);
  begin
  if not Sender.inMainThread then
    Sender.Sync(RtcDataServer1DataOut)
  else
    begin
    TotalDataOut:=TotalDataOut+Sender.DataOut;
    lblDataInOut.Caption:=IntToStr(TotalDataIn)+' + '+IntToStr(TotalDataOut)+' bytes';
    end;
  end;

procedure TForm1.FormDestroy(Sender: TObject);
  begin
  CS.Destroy;
  end;

end.