source upload

contrib/mORMot/SQLite3/Samples/21 - HTTP Client-Server performance/Project21HttpClient.dpr

@@ -0,0 +1,23 @@
+/// this client will stress a remote TSQLRestServerDB over HTTP
+program Project21HttpClient;
+
+// first line of uses clause must be   {$I SynDprUses.inc}
+uses
+  {$I SynDprUses.inc}
+  Forms,
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  ECCProcess in '..\33 - ECC\ECCProcess.pas',
+  Project21HttpClientMain in 'Project21HttpClientMain.pas' {MainForm};
+
+{$ifndef FPC}
+{$R *.res}
+{$R Vista.res}
+{$endif}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TMainForm, MainForm);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/21 - HTTP Client-Server performance/Project21HttpClientMain.dfm

@@ -0,0 +1,96 @@
+object MainForm: TMainForm
+  Left = 245
+  Top = 228
+  BorderStyle = bsDialog
+  Caption = ' mORMot HTTP Client Stress Test'
+  ClientHeight = 292
+  ClientWidth = 666
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  DesignSize = (
+    666
+    292)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object lbledtServerAddress: TLabeledEdit
+    Left = 24
+    Top = 24
+    Width = 177
+    Height = 21
+    EditLabel.Width = 174
+    EditLabel.Height = 13
+    EditLabel.Caption = 'Remote HTTP server IP (port is 888)'
+    TabOrder = 0
+    Text = '127.0.0.1'
+  end
+  object lbledtClientThreadCount: TLabeledEdit
+    Left = 24
+    Top = 128
+    Width = 177
+    Height = 21
+    EditLabel.Width = 118
+    EditLabel.Height = 13
+    EditLabel.Caption = 'Number of client threads'
+    TabOrder = 2
+    Text = '50'
+    OnKeyPress = lbledtClientPerThreadInstanceCountKeyPress
+  end
+  object lbledtClientPerThreadInstanceCount: TLabeledEdit
+    Left = 24
+    Top = 168
+    Width = 177
+    Height = 21
+    EditLabel.Width = 180
+    EditLabel.Height = 13
+    EditLabel.Caption = 'Number of client instances per thread'
+    TabOrder = 3
+    Text = '1'
+    OnKeyPress = lbledtClientPerThreadInstanceCountKeyPress
+  end
+  object lbledtNumberOfObjectAdded: TLabeledEdit
+    Left = 24
+    Top = 72
+    Width = 177
+    Height = 21
+    EditLabel.Width = 121
+    EditLabel.Height = 13
+    EditLabel.Caption = 'Number of objects added'
+    TabOrder = 1
+    Text = '10000'
+    OnKeyPress = lbledtClientPerThreadInstanceCountKeyPress
+  end
+  object btnStart: TButton
+    Left = 24
+    Top = 216
+    Width = 129
+    Height = 49
+    Caption = 'Start'
+    TabOrder = 4
+    OnClick = btnStartClick
+  end
+  object mmoInfo: TMemo
+    Left = 224
+    Top = 8
+    Width = 433
+    Height = 273
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    Lines.Strings = (
+      '')
+    ScrollBars = ssVertical
+    TabOrder = 5
+  end
+  object chkSocketAPI: TCheckBox
+    Left = 24
+    Top = 269
+    Width = 129
+    Height = 17
+    Caption = 'Use Socket API'
+    TabOrder = 6
+  end
+end

contrib/mORMot/SQLite3/Samples/21 - HTTP Client-Server performance/Project21HttpClientMain.pas

@@ -0,0 +1,120 @@
+unit Project21HttpClientMain;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls;
+
+type
+  TMainForm = class(TForm)
+    lbledtServerAddress: TLabeledEdit;
+    lbledtClientThreadCount: TLabeledEdit;
+    lbledtClientPerThreadInstanceCount: TLabeledEdit;
+    lbledtNumberOfObjectAdded: TLabeledEdit;
+    btnStart: TButton;
+    mmoInfo: TMemo;
+    chkSocketAPI: TCheckBox;
+    procedure lbledtClientPerThreadInstanceCountKeyPress(Sender: TObject;
+      var Key: Char);
+    procedure btnStartClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+uses
+  SynCommons,
+  SynLog,
+  SynTests,
+  mORMot,
+  SynSelfTests;
+
+{$R *.dfm}
+
+procedure TMainForm.lbledtClientPerThreadInstanceCountKeyPress(
+  Sender: TObject; var Key: Char);
+begin
+  if (Key<'0') or (Key>'9') then
+    Key := #0;
+end;
+
+procedure TMainForm.btnStartClick(Sender: TObject);
+var Tests: TSynTestsLogged;
+    Test: TTestMultiThreadProcess;
+    ThreadCount, OperationCount, ClientPerThread: integer;
+    Timer: TPrecisionTimer;
+    txt: string;
+begin
+  if (not TryStrToInt(lbledtClientThreadCount.Text,ThreadCount)) or
+     (ThreadCount<1) or (ThreadCount>500) then begin
+    lbledtClientThreadCount.SetFocus;
+    exit;
+  end;
+  if not TryStrToInt(lbledtNumberOfObjectAdded.Text,OperationCount) or
+     (OperationCount<1) or (OperationCount>100000) then begin
+    lbledtNumberOfObjectAdded.SetFocus;
+    exit;
+  end;
+  if not TryStrToInt(lbledtClientPerThreadInstanceCount.Text,ClientPerThread) or
+     (ClientPerThread<1) or (ClientPerThread>100) then begin
+    lbledtClientPerThreadInstanceCount.SetFocus;
+    exit;
+  end;
+  txt := mmoInfo.Text;
+  btnStart.Enabled := false;
+  try
+    Tests := TSynTestsLogged.Create;
+    Test := TTestMultiThreadProcess.Create(Tests);
+    try
+      Test.ClientOnlyServerIP := StringToAnsi7(lbledtServerAddress.Text);
+      Test.MinThreads := ThreadCount;
+      Test.MaxThreads := ThreadCount;
+      Test.OperationCount := OperationCount;
+      Test.ClientPerThread := ClientPerThread;
+      Test.CreateThreadPool;
+      txt := Format
+        ('%s'#13#10#13#10'Test started with %d threads, %d client(s) per thread and %d rows to be inserted...',
+        [txt,ThreadCount,ClientPerThread,OperationCount]);
+      mmoInfo.Text := txt;
+      mmoInfo.SelStart := length(txt);
+      mmoInfo.SelLength := 0;
+      Timer.Start;
+      if chkSocketAPI.Checked then
+        Test.SocketAPI else
+        Test.WindowsAPI;
+      txt := mmoInfo.Text+Format(#13#10'Assertion(s) failed: %d / %d'+
+        #13#10'Number of clients connected at once: %d'+
+        #13#10'Time to process: %s'#13#10'Operation per second: %d',
+        [Test.AssertionsFailed,Test.Assertions,
+         ThreadCount*ClientPerThread,Timer.Stop,Timer.PerSec(OperationCount*2)]);
+      mmoInfo.Text := txt;
+      mmoInfo.SelStart := length(txt);
+      mmoInfo.SelLength := 0;
+    finally
+      Test.Free;
+      Tests.Free;
+    end;
+  finally
+    btnStart.Enabled := true;
+  end;
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+  // define the log level
+  TSynLogTestLog := TSQLLog;
+  with TSQLLog.Family do begin
+    Level := LOG_STACKTRACE+[sllFail];
+    PerThreadLog := ptIdentifiedInOnFile;
+  end;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/21 - HTTP Client-Server performance/Project21HttpServer.dpr

@@ -0,0 +1,76 @@
+/// this server will use TSQLRestServerDB over HTTP
+program Project21HttpServer;
+
+{$APPTYPE CONSOLE}
+
+// first line of uses clause must be   {$I SynDprUses.inc}
+uses
+  {$I SynDprUses.inc}
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynTable,
+  SynLog,
+  mORMot,
+  mORMotSQlite3,
+  SynSQLite3,
+  SynSQLite3Static,
+  mORMotHttpServer;
+
+type
+  TSQLRecordPeople = class(TSQLRecord)
+  private
+    fFirstName: RawUTF8;
+    fLastName: RawUTF8;
+    fYearOfBirth: integer;
+    fYearOfDeath: word;
+  published
+    property FirstName: RawUTF8 read fFirstName write fFirstName;
+    property LastName: RawUTF8 read fLastName write fLastName;
+    property YearOfBirth: integer read fYearOfBirth write fYearOfBirth;
+    property YearOfDeath: word read fYearOfDeath write fYearOfDeath;
+  end;
+
+var
+  aDatabaseFile: TFileName;
+  aModel: TSQLModel;
+  aServer: TSQLRestServerDB;
+  aHTTPServer: TSQLHttpServer;
+begin
+  // define the log level
+  with TSQLLog.Family do begin
+    Level := LOG_STACKTRACE;
+    EchoToConsole := LOG_VERBOSE; // events to the console
+    PerThreadLog := ptIdentifiedInOnFile;
+  end;
+  // create a Data Model
+  aModel := TSQLModel.Create([TSQLRecordPeople]);
+  try
+    aDatabaseFile := ChangeFileExt(ExeVersion.ProgramFileName,'.db3');
+    DeleteFile(aDatabaseFile);
+    aServer := TSQLRestServerDB.Create(aModel,aDatabaseFile);
+    try
+      aServer.AcquireWriteTimeOut := 15000;   // 15 seconds before write failure
+      aServer.DB.Synchronous := smOff;
+      aServer.DB.LockingMode := lmExclusive;  // off+exclusive = fastest SQLite3  
+      aServer.NoAJAXJSON := true;
+      aServer.CreateMissingTables;
+      // launch the server
+      aHTTPServer := TSQLHttpServer.Create('888',[aServer]);
+      try
+        writeln(#13#10'Background server is running at http://localhost:888'#13#10+
+                #13#10'Press [Enter] to close the server.');
+        ConsoleWaitForEnterKey;
+        with TSQLLog.Family do
+          if not (sllInfo in Level) then // let global server stats be logged
+            Level := Level+[sllInfo];
+      finally
+        aHTTPServer.Free;
+      end;
+    finally
+      aServer.Free;
+    end;
+  finally
+    aModel.Free;
+  end;
+end.