source upload

contrib/mORMot/SQLite3/Samples/01 - In Memory ORM/Project01.dpr

@@ -0,0 +1,51 @@
+{
+   Synopse mORMot framework
+
+   Sample 01 - In Memory ORM
+     purpose of this sample is to show the basic ORM usage of the framework:
+
+   - a TRecord class is defined in Unit1.pas
+   - a static server (i.e. in-memory database) is initialized (see
+     TSQLRestStorage.Create below); 
+     it will store the data in a JSON file in the disk and won't require
+     the SQLite3 database engine
+   - the purpose of the form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - on application quit, the Database.Destroy will update the JSON file
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note the tiny size of the EXE (since we don't use SQLite3), less than
+     80KB with LVCL :)
+
+  Version 1.0 - January 24, 2010
+    - Initial Release
+
+  Version 1.1 - April 14, 2011
+    - use TSQLRestStorageInMemory instead of abstract TSQLRestStorage
+
+}
+
+program Project01;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  SysUtils,
+  SynCommons,
+  mORMot,
+  Unit1 in 'Unit1.pas' {Form1},
+  SampleData in 'SampleData.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Form1.Caption := ' Sample 01 - In Memory ORM';
+  Form1.Database := TSQLRestStorageInMemory.Create(TSQLSampleRecord,nil,
+    ChangeFileExt(ExeVersion.ProgramFileName,'.db'));
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/01 - In Memory ORM/Project01.lpi

@@ -0,0 +1,88 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Project01"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="Project01.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Project01"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="Unit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="Project01"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir);..\..\.."/>
+      <OtherUnitFiles Value="..\..;..\..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Conditionals Value="if TargetOS='darwin' then
+   CustomOptions := ' -Cg-';"/>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/01 - In Memory ORM/Project01.lpr

@@ -0,0 +1,53 @@
+{
+   Synopse mORMot framework
+
+   Sample 01 - In Memory ORM
+     purpose of this sample is to show the basic ORM usage of the framework:
+
+   - a TRecord class is defined in Unit1.pas
+   - a static server (i.e. in-memory database) is initialized (see
+     TSQLRestStorage.Create below);
+     it will store the data in a JSON file in the disk and won't require
+     the SQLite3 database engine
+   - the purpose of the form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - on application quit, the Database.Destroy will update the JSON file
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+
+  Version 1.0 - January 24, 2010
+    - Initial Release
+
+  Version 1.1 - April 14, 2011
+    - use TSQLRestStorageInMemory instead of abstract TSQLRestStorage
+
+}
+
+program Project01;
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms,
+  SysUtils,
+  mORMot,
+  Unit1 {Form1},
+  SampleData in 'SampleData.pas';
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Form1.Caption := ' Sample 01 - In Memory ORM';
+  Form1.Database := TSQLRestStorageInMemory.Create(TSQLSampleRecord,nil,
+    ChangeFileExt(paramstr(0),'.db'));
+  Application.Run;
+end.
+

contrib/mORMot/SQLite3/Samples/01 - In Memory ORM/SampleData.pas

@@ -0,0 +1,39 @@
+/// it's a good practice to put all data definition into a stand-alone unit
+// - this unit will be shared between client and server
+unit SampleData;
+
+interface
+
+uses
+  SynCommons,
+  mORMot;
+
+type
+  /// here we declare the class containing the data
+  // - it just has to inherits from TSQLRecord, and the published
+  // properties will be used for the ORM (and all SQL creation)
+  // - the beginning of the class name must be 'TSQL' for proper table naming
+  // in client/server environnment
+  TSQLSampleRecord = class(TSQLRecord)
+  private
+    fQuestion: RawUTF8;
+    fName: RawUTF8;
+    fTime: TModTime;
+  published
+    property Time: TModTime read fTime write fTime;
+    property Name: RawUTF8 read fName write fName;
+    property Question: RawUTF8 read fQuestion write fQuestion;
+  end;
+
+/// an easy way to create a database model for client and server
+function CreateSampleModel: TSQLModel;
+
+
+implementation
+
+function CreateSampleModel: TSQLModel;
+begin
+  result := TSQLModel.Create([TSQLSampleRecord]);
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/01 - In Memory ORM/Unit1.dfm

@@ -0,0 +1,73 @@
+object Form1: TForm1
+  Left = 604
+  Top = 370
+  BorderStyle = bsSingle
+  ClientHeight = 286
+  ClientWidth = 490
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  PixelsPerInch = 96
+  TextHeight = 16
+  object Label1: TLabel
+    Left = 40
+    Top = 16
+    Width = 67
+    Height = 16
+    Caption = 'Your name:'
+  end
+  object Label2: TLabel
+    Left = 40
+    Top = 72
+    Width = 86
+    Height = 16
+    Caption = 'Your message:'
+  end
+  object QuestionMemo: TMemo
+    Left = 32
+    Top = 88
+    Width = 409
+    Height = 121
+    TabOrder = 0
+  end
+  object NameEdit: TEdit
+    Left = 32
+    Top = 32
+    Width = 217
+    Height = 24
+    TabOrder = 1
+  end
+  object AddButton: TButton
+    Left = 48
+    Top = 232
+    Width = 145
+    Height = 25
+    Caption = 'Add the message'
+    TabOrder = 2
+    OnClick = AddButtonClick
+  end
+  object QuitButton: TButton
+    Left = 296
+    Top = 232
+    Width = 75
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 3
+    OnClick = QuitButtonClick
+  end
+  object FindButton: TButton
+    Left = 256
+    Top = 32
+    Width = 185
+    Height = 25
+    Caption = 'Find a previous message'
+    TabOrder = 4
+    OnClick = FindButtonClick
+  end
+end

contrib/mORMot/SQLite3/Samples/01 - In Memory ORM/Unit1.lfm

@@ -0,0 +1,74 @@
+object Form1: TForm1
+  Left = 378
+  Height = 286
+  Top = 390
+  Width = 490
+  BorderStyle = bsSingle
+  Caption = 'Form1'
+  ClientHeight = 286
+  ClientWidth = 490
+  Color = clBtnFace
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  LCLVersion = '1.2.6.0'
+  object Label1: TLabel
+    Left = 40
+    Height = 15
+    Top = 16
+    Width = 73
+    Caption = 'Your name:'
+    ParentColor = False
+  end
+  object Label2: TLabel
+    Left = 40
+    Height = 15
+    Top = 72
+    Width = 95
+    Caption = 'Your message:'
+    ParentColor = False
+  end
+  object QuestionMemo: TMemo
+    Left = 32
+    Height = 121
+    Top = 88
+    Width = 409
+    TabOrder = 0
+  end
+  object NameEdit: TEdit
+    Left = 32
+    Height = 23
+    Top = 32
+    Width = 217
+    TabOrder = 1
+  end
+  object AddButton: TButton
+    Left = 48
+    Height = 25
+    Top = 232
+    Width = 145
+    Caption = 'Add the message'
+    OnClick = AddButtonClick
+    TabOrder = 2
+  end
+  object QuitButton: TButton
+    Left = 296
+    Height = 25
+    Top = 232
+    Width = 75
+    Caption = 'Quit'
+    OnClick = QuitButtonClick
+    TabOrder = 3
+  end
+  object FindButton: TButton
+    Left = 256
+    Height = 25
+    Top = 32
+    Width = 185
+    Caption = 'Find a previous message'
+    OnClick = FindButtonClick
+    TabOrder = 4
+  end
+end

contrib/mORMot/SQLite3/Samples/01 - In Memory ORM/Unit1.pas

@@ -0,0 +1,105 @@
+unit Unit1;
+
+interface
+
+uses
+  {$ifdef MSWINDOWS}
+  Windows,
+  Messages,
+  Graphics,
+  {$endif}
+  Classes, SysUtils, Forms, Controls, Dialogs, StdCtrls,
+  SynCommons,
+  SynTable,
+  mORMot,
+  SampleData;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    AddButton: TButton;
+    Label1: TLabel;
+    Label2: TLabel;
+    QuitButton: TButton;
+    FindButton: TButton;
+    QuestionMemo: TMemo;
+    NameEdit: TEdit;
+    procedure AddButtonClick(Sender: TObject);
+    procedure FindButtonClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure QuitButtonClick(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+    Database: TSQLRest;
+    Model: TSQLModel;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$ifdef FPC}
+{$R *.lfm}
+{$else}
+{$R *.dfm}
+{$endif}
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Model := CreateSampleModel; // from SampleData unit
+end;
+
+procedure TForm1.AddButtonClick(Sender: TObject);
+var Rec: TSQLSampleRecord;
+begin
+  Rec := TSQLSampleRecord.Create;
+  try
+    // we use explicit StringToUTF8() for conversion below
+    // a real application should use TLanguageFile.StringToUTF8() in mORMoti18n
+    Rec.Name := StringToUTF8(NameEdit.Text);
+    Rec.Question := StringToUTF8(QuestionMemo.Text);
+    if Database.Add(Rec,true)=0 then
+      ShowMessage('Error adding the data') else begin
+      NameEdit.Text := '';
+      QuestionMemo.Text := '';
+      NameEdit.SetFocus;
+    end;
+  finally
+    Rec.Free;
+  end;
+end;
+
+procedure TForm1.FindButtonClick(Sender: TObject);
+var Rec: TSQLSampleRecord;
+begin
+  Rec := TSQLSampleRecord.Create(Database,'Name=?',[StringToUTF8(NameEdit.Text)]);
+  try
+    if Rec.ID=0 then
+      QuestionMemo.Text := 'Not found' else
+      QuestionMemo.Text := UTF8ToString(Rec.Question);
+  finally
+    Rec.Free;
+  end;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Database.Free;
+  Model.Free;
+end;
+
+procedure TForm1.QuitButtonClick(Sender: TObject);
+begin
+  Close;
+end;
+
+end.
+

contrib/mORMot/SQLite3/Samples/02 - Embedded SQLite3 ORM/Project02.dpr

@@ -0,0 +1,54 @@
+{
+   Synopse mORMot framework
+
+   Sample 02 - Embedded SQLite3 ORM
+     purpose of this sample is to show embedded SQLite3 database usage:
+
+   - a TSampleRecord class is defined in Unit1.pas
+   - a SQLite3 server is initialized (see TSQLRestServerDB.Create below) and
+     will work embedded, i.e. not in Client/Server mode here
+   - the CreateMissingTables method will create all necessary tables in the
+     SQLite3 database
+   - the purpose of the form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note that you didn't need to write any SQL statement, only define a
+     class and call some methods; even the query was made very easy (just an
+     obvious WHERE clause to write)
+   - thanks to the true object oriented modeling of the framework, the same
+     exact Unit1 is used for both static in-memory database engine, or
+     with SQLite3 database storage: only the TForm1.Database object creation
+     instance was modified
+   - look at the tiny size of the EXE (even with SQLite3 engine embedded), less
+     than 400KB with LVCL :)
+
+  Version 1.0 - January 24, 2010
+
+}
+program Project02;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  SysUtils,
+  SynCommons,
+  mORMot,
+  mORMotSQLite3, SynSQLite3Static,
+  Unit1 in '..\01 - In Memory ORM\Unit1.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Form1.Caption := ' Sample 02 - Embedded SQLite3 ORM';
+  Form1.Database := TSQLRestServerDB.Create(Form1.Model,
+    ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
+  TSQLRestServerDB(Form1.Database).CreateMissingTables;
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/02 - Embedded SQLite3 ORM/Project02.lpi

@@ -0,0 +1,78 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Project02"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="Project02.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Project02"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="Project02"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir);..\..\.."/>
+      <OtherUnitFiles Value="..\..;..\..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Conditionals Value="if TargetOS='darwin' then
+   CustomOptions := ' -Cg-';"/>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/02 - Embedded SQLite3 ORM/Project02.lpr

@@ -0,0 +1,57 @@
+{
+   Synopse mORMot framework
+
+   Sample 02 - Embedded SQLite3 ORM
+     purpose of this sample is to show embedded SQLite3 database usage:
+
+   - a TSampleRecord class is defined in Unit1.pas
+   - a SQLite3 server is initialized (see TSQLRestServerDB.Create below) and
+     will work embedded, i.e. not in Client/Server mode here
+   - the CreateMissingTables method will create all necessary tables in the
+     SQLite3 database
+   - the purpose of the form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note that you didn't need to write any SQL statement, only define a
+     class and call some methods; even the query was made very easy (just an
+     obvious WHERE clause to write)
+   - thanks to the true object oriented modeling of the framework, the same
+     exact Unit1 is used for both static in-memory database engine, or
+     with SQLite3 database storage: only the TForm1.Database object creation
+     instance was modified
+   - look at the tiny size of the EXE (even with SQLite3 engine embedded), less
+     than 400KB with LVCL :)
+
+  Version 1.0 - January 24, 2010
+
+}
+program Project02;
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms,
+  SysUtils,
+  mORMot,
+  mORMotSQLite3, SynSQLite3Static,
+  Unit1 in '..\01 - In Memory ORM\Unit1.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Form1.Caption := ' Sample 02 - Embedded SQLite3 ORM';
+  Form1.Database := TSQLRestServerDB.Create(Form1.Model,
+    ChangeFileExt(paramstr(0),'.db3'));
+  TSQLRestServerDB(Form1.Database).CreateMissingTables;
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/03 - NamedPipe Client-Server/Project03Client.dpr

@@ -0,0 +1,51 @@
+{
+   Synopse mORMot framework
+
+   Sample 03 - NamedPipe Client-Server
+     purpose of this sample is to show Client/Server SQLite3 database usage:
+
+   - a TSampleRecord class is defined in Unit1.pas
+   - this sample uses down projects, Project03Client.dpr and Project03Server.dpr
+   - a SQLite3 server is initialized in Project03Server
+   - the CreateMissingTables method will create all necessary tables in the
+     SQLite3 database
+   - one or more client instances can be run in Project03Client
+   - the purpose of the Client form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our mORMoti18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note that you didn't need to write any SQL statement, only define a
+     class and call some methods; even the query was made very easy (just an
+     obvious WHERE clause to write)
+   - thanks to the true object oriented modeling of the framework, the same
+     exact Unit1 is used for both static in-memory database engine, or
+     with SQLite3 database storage: only the TForm1.Database object creation
+     instance was modified
+   - look at the tiny size of the EXE (even with SQLite3 engine embedded), less
+     than 400KB for the server, and 80KB for the client, with LVCL :)
+
+
+  Version 1.0 - January 24, 2010
+}
+program Project03Client;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  SysUtils,
+  mORMot,
+  Unit1 in '..\01 - In Memory ORM\Unit1.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Form1.Caption := ' Sample 03 - NamedPipe Client';
+  Form1.Database := TSQLRestClientURINamedPipe.Create(Form1.Model,'03');
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/03 - NamedPipe Client-Server/Project03Server.dpr

@@ -0,0 +1,48 @@
+{
+   Synopse mORMot framework
+
+   Sample 03 - NamedPipe Client-Server
+     purpose of this sample is to show Client/Server SQLite3 database usage:
+
+   - a TSampleRecord class is defined in Unit1.pas
+   - this sample uses down projects, Project03Client.dpr and Project03Server.dpr
+   - a SQLite3 server is initialized in Project03Server
+   - the CreateMissingTables method will create all necessary tables in the
+     SQLite3 database
+   - one or more client instances can be run in Project03Client
+   - the purpose of the Client form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note that you didn't need to write any SQL statement, only define a
+     class and call some methods; even the query was made very easy (just an
+     obvious WHERE clause to write)
+   - thanks to the true object oriented modeling of the framework, the same
+     exact Unit1 is used for both static in-memory database engine, or
+     with SQLite3 database storage: only the TForm1.Database object creation
+     instance was modified
+   - look at the tiny size of the EXE (even with SQLite3 engine embedded), less
+     than 400KB for the server, and 80KB for the client, with LVCL :)
+
+
+  Version 1.0 - January 24, 2010
+}
+
+program Project03Server;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  Unit2 in 'Unit2.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/03 - NamedPipe Client-Server/Unit2.dfm

@@ -0,0 +1,48 @@
+object Form1: TForm1
+  Left = 198
+  Top = 124
+  Caption = ' 03 - NamedPipe Server'
+  ClientHeight = 182
+  ClientWidth = 418
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 16
+  object Label1: TLabel
+    Left = 40
+    Top = 16
+    Width = 297
+    Height = 33
+    AutoSize = False
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clTeal
+    Font.Height = -16
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object Label2: TLabel
+    Left = 56
+    Top = 72
+    Width = 110
+    Height = 16
+    Caption = 'Server is running...'
+  end
+  object Button1: TButton
+    Left = 88
+    Top = 120
+    Width = 75
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 0
+    OnClick = Button1Click
+  end
+end

contrib/mORMot/SQLite3/Samples/03 - NamedPipe Client-Server/Unit2.pas

@@ -0,0 +1,56 @@
+unit Unit2;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs,
+  SynCommons, mORMot, mORMotSQLite3, SynSQLite3Static, StdCtrls, SampleData;
+
+type
+  TForm1 = class(TForm)
+    Label1: TLabel;
+    Button1: TButton;
+    Label2: TLabel;
+    procedure Button1Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+  public
+    Model: TSQLModel;
+    Server: TSQLRestServerDB;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Model := CreateSampleModel;
+  Server := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
+  Server.CreateMissingTables;
+  Server.ExportServerNamedPipe('03');
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Server.Free;
+  Model.Free;
+end;
+
+procedure TForm1.FormShow(Sender: TObject);
+begin
+  Label1.Caption := Caption;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Project04Client.dpr

@@ -0,0 +1,61 @@
+{
+   Synopse mORMot framework
+
+   Sample 04 - HTTP Client-Server
+     purpose of this sample is to show HTTP Client/Server SQLite3 database usage:
+
+   - a TSQLSampleRecord class is defined in shared unit SampleData.pas
+   - this sample uses two projects, Project04Client.dpr and Project04Server.dpr
+   - a SQLite3 server is initialized in Project04Server
+   - the CreateMissingTables method will create all necessary tables in the
+     SQLite3 database
+   - one or more client instances can be run in Project04Client
+   - the purpose of the Client form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note that you didn't need to write any SQL statement, only define a
+     class and call some methods; even the query was made very easy (just an
+     obvious WHERE clause to write)
+   - thanks to the true object oriented modeling of the framework, the same
+     exact Unit1 is used for both static in-memory database engine, or
+     with SQLite3 database storage, in local mode or in Client/Server mode: 
+     only the TForm1.Database object creation instance was modified
+   - look at the tiny size of the EXE (even with SQLite3 engine embedded), less
+     than 400KB for the server, and 80KB for the client, with LVCL :)
+
+  Version 1.0 - February 07, 2010
+
+  Version 1.16
+  - added authentication to the remote process
+
+}
+
+program Project04Client;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  SysUtils,
+  mORMot,
+  mORMotHttpClient,
+  Unit1 in '..\01 - In Memory ORM\Unit1.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+var Server: AnsiString;
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Form1.Caption := ' Sample 04 - HTTP Client';
+  if ParamCount=0 then
+    Server := 'localhost' else
+    Server := AnsiString(Paramstr(1));
+  Form1.Database := TSQLHttpClient.Create(Server,'8080',Form1.Model);
+  TSQLHttpClient(Form1.Database).SetUser('User','synopse');
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Project04Client.lpi

@@ -0,0 +1,80 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Project04Client"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="Project04Client.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Project04Client"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="Project04Client"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir);..\..\.."/>
+      <OtherUnitFiles Value="..\..;..\..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Conditionals Value="if TargetOS='darwin' then
+   CustomOptions := ' -Cg-';"/>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Project04Client.lpr

@@ -0,0 +1,65 @@
+{
+   Synopse mORMot framework
+
+   Sample 04 - HTTP Client-Server
+     purpose of this sample is to show HTTP Client/Server SQLite3 database usage:
+
+   - a TSQLSampleRecord class is defined in shared unit SampleData.pas
+   - this sample uses two projects, Project04Client.dpr and Project04Server.dpr
+   - a SQLite3 server is initialized in Project04Server
+   - the CreateMissingTables method will create all necessary tables in the
+     SQLite3 database
+   - one or more client instances can be run in Project04Client
+   - the purpose of the Client form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note that you didn't need to write any SQL statement, only define a
+     class and call some methods; even the query was made very easy (just an
+     obvious WHERE clause to write)
+   - thanks to the true object oriented modeling of the framework, the same
+     exact Unit1 is used for both static in-memory database engine, or
+     with SQLite3 database storage, in local mode or in Client/Server mode: 
+     only the TForm1.Database object creation instance was modified
+   - look at the tiny size of the EXE (even with SQLite3 engine embedded), less
+     than 400KB for the server, and 80KB for the client, with LVCL :)
+
+  Version 1.0 - February 07, 2010
+
+  Version 1.16
+  - added authentication to the remote process
+
+}
+
+program Project04Client;
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms,
+  SysUtils,
+  mORMot,
+  mORMotHttpClient,
+  Unit1 in '..\01 - In Memory ORM\Unit1.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+var Server: AnsiString;
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Form1.Caption := ' Sample 04 - HTTP Client';
+  if ParamCount=0 then
+    Server := 'localhost' else
+    Server := AnsiString(Paramstr(1));
+  Form1.Database := TSQLHttpClient.Create(Server,'8080',Form1.Model);
+  TSQLHttpClient(Form1.Database).SetUser('User','synopse');
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Project04Server.dpr

@@ -0,0 +1,57 @@
+{
+   Synopse mORMot framework
+
+   Sample 04 - HTTP Client-Server
+     purpose of this sample is to show HTTP Client/Server SQLite3 database usage:
+
+   - a TSQLSampleRecord class is defined in shared unit SampleData.pas
+   - this sample uses two projects, Project04Client.dpr and Project04Server.dpr
+   - a SQLite3 server is initialized in Project04Server
+   - the CreateMissingTables method will create all necessary tables in the
+     SQLite3 database
+   - one or more client instances can be run in Project04Client
+   - the purpose of the Client form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note that you didn't need to write any SQL statement, only define a
+     class and call some methods; even the query was made very easy (just an
+     obvious WHERE clause to write)
+   - thanks to the true object oriented modelling of the framework, the same
+     exact Unit1 is used for both static in-memory database engine, or
+     with SQLite3 database storage, in local mode or in Client/Server mode:
+     only the TForm1.Database object creation instance was modified
+   - in order to register the URL for the http.sys server, you have to run 
+     this program once as administrator, or call Project04ServerRegister first
+   - look at the tiny size of the EXE (even with SQLite3 engine embedded), less
+     than 400KB for the server, and 80KB for the client, with LVCL :)
+
+
+  Version 1.0 - February 07, 2010
+
+  Version 1.16
+  - added authentication to the remote process
+
+  Version 1.18
+  - added Project04ServerRegister.dpr program
+
+}
+
+program Project04Server;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  Unit2 in 'Unit2.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Project04Server.lpi

@@ -0,0 +1,80 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Project04Server"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="Project04Server.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Project04Server"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="Project04Server"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir);..\..\.."/>
+      <OtherUnitFiles Value="..\..;..\..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Conditionals Value="if TargetOS='darwin' then
+   CustomOptions := ' -Cg-';"/>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Project04Server.lpr

@@ -0,0 +1,61 @@
+{
+   Synopse mORMot framework
+
+   Sample 04 - HTTP Client-Server
+     purpose of this sample is to show HTTP Client/Server SQLite3 database usage:
+
+   - a TSQLSampleRecord class is defined in shared unit SampleData.pas
+   - this sample uses two projects, Project04Client.dpr and Project04Server.dpr
+   - a SQLite3 server is initialized in Project04Server
+   - the CreateMissingTables method will create all necessary tables in the
+     SQLite3 database
+   - one or more client instances can be run in Project04Client
+   - the purpose of the Client form in Unit1.pas is to add a record to the
+     database; the Time field is filled with the current date and time
+   - the 'Find a previous message' button show how to perform a basic query
+   - since the framework use UTF-8 encoding, we use some basic functions for
+     fast conversion to/from the User Interface; in real applications,
+     you should better use our SQLite3i18n unit and the corresponding
+     TLanguageFile.StringToUTF8() and TLanguageFile.UTF8ToString() methods
+   - note that you didn't need to write any SQL statement, only define a
+     class and call some methods; even the query was made very easy (just an
+     obvious WHERE clause to write)
+   - thanks to the true object oriented modelling of the framework, the same
+     exact Unit1 is used for both static in-memory database engine, or
+     with SQLite3 database storage, in local mode or in Client/Server mode:
+     only the TForm1.Database object creation instance was modified
+   - in order to register the URL for the http.sys server, you have to run 
+     this program once as administrator, or call Project04ServerRegister first
+   - look at the tiny size of the EXE (even with SQLite3 engine embedded), less
+     than 400KB for the server, and 80KB for the client, with LVCL :)
+
+
+  Version 1.0 - February 07, 2010
+
+  Version 1.16
+  - added authentication to the remote process
+
+  Version 1.18
+  - added Project04ServerRegister.dpr program
+
+}
+
+program Project04Server;
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms,
+  Unit2 in 'Unit2.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Project04ServerRegister.dpr

@@ -0,0 +1,38 @@
+{{ in order to be able to use http.sys server for Project04Server.exe 
+ under Vista or Seven, call first this program with Administrator rights
+  - you can unregister it later with command line parameter /delete }
+program Project04ServerRegister;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SynCrtSock,
+  SysUtils;
+
+const
+  REGSTR: array[boolean] of string = (
+    'Registration', 'Deletion');
+
+{$R VistaAdm.res} // force elevation to Administrator under Vista/Seven
+
+var delete: boolean;
+
+procedure Call(const Root: SockString);
+begin
+  writeln(REGSTR[delete],' of http://+:8080/',root,'/ for http.sys');
+  writeln(THttpApiServer.AddUrlAuthorize(root,'8080',false,'+',delete));
+end;
+
+begin
+  // test if we have to un-register the url
+  delete := (ParamCount=1) and SameText(ParamStr(1),'/DELETE');
+  // perform url (un)registration for http.sys
+  // (e.g. to be run as administrator under Windows Vista/Seven)
+  Call('root');   // for the TSQLModel as defined in SampleData.pas
+  Call('static'); // for Project04Static.dpr
+  // we're done
+  WriteLn('Done - Press ENTER to Exit');
+  ReadLn;
+end.
+ 

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Project04ServerStatic.dpr

@@ -0,0 +1,35 @@
+{
+   Synopse mORMot framework
+
+   Sample 04 - HTTP Client-Server
+     purpose of this sample is to show how to serve files in
+     addition to RESTful Client/Server of a SQLite3 database
+
+   This sample will serve as REST the data as defined in SampleData,
+   and serve 'www' sub-folder content within localhost:8080/static
+
+   It is IMHO preferred and less-error prone to define a method-based service,
+   then let the method return the file using Ctxt.ReturnFile() method.
+   
+   See also https://synopse.info/forum/viewtopic.php?id=1896
+
+   Version 1.18
+  - added Project04ServerStatic.dpr program
+
+}
+
+program Project04ServerStatic;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  Unit2Static in 'Unit2Static.pas' {Form1},
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Unit2.dfm

@@ -0,0 +1,48 @@
+object Form1: TForm1
+  Left = 198
+  Top = 124
+  Width = 434
+  Height = 220
+  Caption = ' 04 - HTTP Server'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 16
+  object Label1: TLabel
+    Left = 40
+    Top = 16
+    Width = 297
+    Height = 33
+    AutoSize = False
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clTeal
+    Font.Height = -16
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object Label2: TLabel
+    Left = 56
+    Top = 72
+    Width = 145
+    Height = 16
+    Caption = 'HTTP Server is running...'
+  end
+  object Button1: TButton
+    Left = 88
+    Top = 120
+    Width = 75
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 0
+    OnClick = Button1Click
+  end
+end

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Unit2.lfm

@@ -0,0 +1,48 @@
+object Form1: TForm1
+  Left = 198
+  Top = 124
+  Width = 434
+  Height = 220
+  Caption = ' 04 - HTTP Server'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 16
+  object Label1: TLabel
+    Left = 40
+    Top = 16
+    Width = 297
+    Height = 33
+    AutoSize = False
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clTeal
+    Font.Height = -16
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object Label2: TLabel
+    Left = 56
+    Top = 72
+    Width = 145
+    Height = 16
+    Caption = 'HTTP Server is running...'
+  end
+  object Button1: TButton
+    Left = 88
+    Top = 120
+    Width = 75
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 0
+    OnClick = Button1Click
+  end
+end

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Unit2.pas

@@ -0,0 +1,63 @@
+unit Unit2;
+
+interface
+
+uses
+  {$ifdef MSWINDOWS}
+  Windows,
+  Messages,
+  {$endif}
+  SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls,
+  SynCommons, mORMot, mORMotSQLite3, SynSQLite3Static, mORMotHttpServer, SampleData;
+
+type
+  TForm1 = class(TForm)
+    Label1: TLabel;
+    Button1: TButton;
+    Label2: TLabel;
+    procedure Button1Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+  public
+    Model: TSQLModel;
+    DB: TSQLRestServerDB;
+    Server: TSQLHttpServer;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Model := CreateSampleModel;
+  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'),true);
+  DB.CreateMissingTables;
+  Server := TSQLHttpServer.Create('8080',[DB],'+',HTTP_DEFAULT_MODE);
+  Server.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Server.Free;
+  DB.Free;
+  Model.Free;
+end;
+
+procedure TForm1.FormShow(Sender: TObject);
+begin
+  Label1.Caption := Caption;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Unit2Static.dfm

@@ -0,0 +1,48 @@
+object Form1: TForm1
+  Left = 198
+  Top = 124
+  Width = 434
+  Height = 220
+  Caption = ' 04 - HTTP Server'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 16
+  object Label1: TLabel
+    Left = 40
+    Top = 16
+    Width = 297
+    Height = 33
+    AutoSize = False
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clTeal
+    Font.Height = -16
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object Label2: TLabel
+    Left = 56
+    Top = 72
+    Width = 145
+    Height = 16
+    Caption = 'HTTP Server is running...'
+  end
+  object Button1: TButton
+    Left = 88
+    Top = 120
+    Width = 75
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 0
+    OnClick = Button1Click
+  end
+end

contrib/mORMot/SQLite3/Samples/04 - HTTP Client-Server/Unit2Static.pas

@@ -0,0 +1,89 @@
+unit Unit2Static;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls,
+  SynCommons, mORMot, mORMotSQLite3, SynSQLite3Static,
+  mORMotHttpServer, SynCrtSock,
+  SampleData;
+
+type
+  TForm1 = class(TForm)
+    Label1: TLabel;
+    Button1: TButton;
+    Label2: TLabel;
+    procedure Button1Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+  public
+    Model: TSQLModel;
+    DB: TSQLRestServerDB;
+    Server: TSQLHttpServer;
+  end;
+
+  TCustomHttpServer = class(TSQLHttpServer)
+  protected
+    /// override the server response - must be thread-safe
+    function Request(Ctxt: THttpServerRequest): cardinal; override;
+  end;
+
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Model := CreateSampleModel;
+  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'),true);
+  DB.CreateMissingTables;
+  Server := TCustomHttpServer.Create('8080',[DB],'+',useHttpApiRegisteringURI,32,secNone,'static');
+  Server.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Server.Free;
+  DB.Free;
+  Model.Free;
+end;
+
+procedure TForm1.FormShow(Sender: TObject);
+begin
+  Label1.Caption := Caption;
+end;
+
+
+{ TCustomHttpServer }
+
+function TCustomHttpServer.Request(Ctxt: THttpServerRequest): cardinal;
+var FileName: TFileName;
+begin
+  if (Ctxt.Method='GET') and IdemPChar(pointer(Ctxt.URL),'/STATIC/') and
+     (PosEx('..',Ctxt.URL)=0) then begin
+    // http.sys will send the specified file from kernel mode
+    FileName := ExeVersion.ProgramFilePath+'www\'+UTF8ToString(Copy(Ctxt.URL,8,maxInt));
+    Ctxt.OutContent := StringToUTF8(FileName);
+    Ctxt.OutContentType := HTTP_RESP_STATICFILE;
+    result := 200; // THttpApiServer.Execute will return 404 if not found
+  end else
+    // call the associated TSQLRestServer instance(s)
+    result := inherited Request(Ctxt);
+end;
+
+
+end.

contrib/mORMot/SQLite3/Samples/05 - Report created from code/SynPdfFormCanvas.dpr

@@ -0,0 +1,62 @@
+program SynPdfFormCanvas;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  Math,
+  DateUtils,
+  SynCommons,
+  SynPDF;
+
+const
+  PDFFactor: Single = 72.0 / 2.54;
+
+var
+  obPDF: TPdfDocument;
+  obFormCanvas: TPdfFormWithCanvas;
+
+begin
+  obPDF := TPdfDocument.Create(false,0,false);
+  obPDF.GeneratePDF15File := true;
+  obPDF.DefaultPaperSize := psA4;
+  obPDF.DefaultPageLandscape := false;
+  obPDF.CompressionMethod := cmFlateDecode;
+
+  obFormCanvas := TPdfFormWithCanvas.Create(obPDF,Trunc(5.0*PDFFactor),Trunc(5.0*PDFFactor));
+  obPDF.AddXObject('FORMOBJECT',obFormCanvas);
+
+  obFormCanvas.Canvas.SetTextRenderingMode(trFill);
+  obFormCanvas.Canvas.SetFont('Arial',10.0,[]);
+
+  obFormCanvas.Canvas.SetLineWidth(0.01*PDFFactor);
+
+  obFormCanvas.Canvas.Rectangle(0.0*PDFFactor,0.0*PDFFactor,4.9*PDFFactor,4.9*PDFFactor);
+  obFormCanvas.Canvas.Stroke;
+
+  obFormCanvas.Canvas.TextOut(1.0*PDFFactor,2.5*PDFFactor,'form text');
+
+  obFormCanvas.CloseCanvas;
+
+  obPDF.AddPage;
+
+  obPDF.Canvas.SetTextRenderingMode(trFill);
+  obPDF.Canvas.SetFont('Arial',10.0,[]);
+
+  obPDF.Canvas.SetLineWidth(0.01*PDFFactor);
+
+  obPDF.Canvas.Rectangle(1.0*PDFFactor,1.0*PDFFactor,19.0*PDFFactor,27.9*PDFFactor);
+  obPDF.Canvas.Stroke;
+
+  obPDF.Canvas.TextOut(2.0*PDFFactor,27.0*PDFFactor,'XObject form canvas sample');
+
+  obPDF.Canvas.DrawXObject(2.0*PDFFactor,5.0*PDFFactor,1.0,1.0,'FORMOBJECT');
+  obPDF.Canvas.DrawXObject(10.0*PDFFactor,10.0*PDFFactor,1.0,0.5,'FORMOBJECT');
+  obPDF.Canvas.DrawXObject(8.0*PDFFactor,15.0*PDFFactor,2.0,2.0,'FORMOBJECT');
+  obPDF.Canvas.DrawXObject(2.0*PDFFactor,20.0*PDFFactor,0.5,1.0,'FORMOBJECT');
+
+  obPDF.SaveToFile(ChangeFileExt(ExeVersion.ProgramFileName,'.pdf'));
+
+  FreeAndNil(obPDF);
+end.

contrib/mORMot/SQLite3/Samples/05 - Report created from code/SynPdfLayers.dpr

@@ -0,0 +1,133 @@
+program SynPdfLayers;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  Math,
+  DateUtils,
+  SynCommons,
+  SynPDF;
+
+const
+  PDFFactor: Single = 72.0 / 2.54;
+
+var
+  obPDF: TPdfDocument;
+
+  obMainLayer1: TPdfOptionalContentGroup;
+  obMainLayer2: TPdfOptionalContentGroup;
+  obMainLayer3: TPdfOptionalContentGroup;
+
+  obSubLayer1: TPdfOptionalContentGroup;
+  obSubLayer2: TPdfOptionalContentGroup;
+  obSubLayer3: TPdfOptionalContentGroup;
+
+  obSubSubLayer1: TPdfOptionalContentGroup;
+  obSubSubLayer2: TPdfOptionalContentGroup;
+
+  obRadioLayer1: TPdfOptionalContentGroup;
+  obRadioLayer2: TPdfOptionalContentGroup;
+  obRadioLayer3: TPdfOptionalContentGroup;
+
+
+begin
+  obPDF := TPdfDocument.Create(false,0,false);
+  obPDF.UseOptionalContent := true;
+  obPDF.DefaultPaperSize := psA4;
+  obPDF.DefaultPageLandscape := true;
+  obPDF.CompressionMethod := cmFlateDecode;
+
+  obMainLayer1 := obPDF.CreateOptionalContentGroup(nil,'Main Layer 1',true);
+  obMainLayer2 := obPDF.CreateOptionalContentGroup(nil,'Main Layer 2',true);
+  obMainLayer3 := obPDF.CreateOptionalContentGroup(nil,'Main Layer 3',true);
+
+  obSubLayer1 := obPDF.CreateOptionalContentGroup(obMainLayer1,'Sub Layer 1',true);
+  obSubLayer2 := obPDF.CreateOptionalContentGroup(obMainLayer1,'Sub Layer 2',true);
+  obSubLayer3 := obPDF.CreateOptionalContentGroup(obMainLayer1,'Sub Layer 3',true);
+
+  obSubSubLayer1 := obPDF.CreateOptionalContentGroup(obSubLayer1,'Sub Sub Layer 1',false);
+  obSubSubLayer2 := obPDF.CreateOptionalContentGroup(obSubLayer1,'Sub Sub Layer 2',false);
+
+  obRadioLayer1 := obPDF.CreateOptionalContentGroup(obMainLayer2,'Radio Layer 1',true);
+  obRadioLayer2 := obPDF.CreateOptionalContentGroup(obMainLayer2,'Radio Layer 2',false);
+  obRadioLayer3 := obPDF.CreateOptionalContentGroup(obMainLayer2,'Radio Layer 3',false);
+
+  // to use the main layers as radios uncomment following line and set only main layer 1 to visible (line 40ff)
+  //obPDF.CreateOptionalContentRadioGroup([obMainLayer1,obMainLayer2,obMainLayer3]);
+
+  obPDF.CreateOptionalContentRadioGroup([obRadioLayer1,obRadioLayer2,obRadioLayer3]);
+
+  obPDF.AddPage;
+
+  obPDF.Canvas.SetTextRenderingMode(trFill);
+  obPDF.Canvas.SetFont('Arial',10.0,[]);
+  obPDF.Canvas.SetLineWidth(0.01*PDFFactor);
+
+  obPDF.Canvas.Rectangle(1.0*PDFFactor,1.0*PDFFactor,27.7*PDFFactor,19.0*PDFFactor);
+  obPDF.Canvas.Stroke;
+
+  obPDF.Canvas.TextOut(2.0*PDFFactor,17.0*PDFFactor,'Main Layer 1:');
+
+  obPDF.Canvas.BeginMarkedContent(obMainLayer1);
+  begin
+    obPDF.Canvas.TextOut(10.0*PDFFactor,17.0*PDFFactor,'Text visible in Main Layer 1');
+
+    obPDF.Canvas.BeginMarkedContent(obSubLayer1);
+    begin
+      obPDF.Canvas.TextOut(10.0*PDFFactor,15.0*PDFFactor,'Text visible in Sub Layer 1');
+
+      obPDF.Canvas.BeginMarkedContent(obSubSubLayer1);
+      obPDF.Canvas.TextOut(15.0*PDFFactor,15.0*PDFFactor,'Text visible in Sub Sub Layer 1');
+      obPDF.Canvas.EndMarkedContent;
+
+      obPDF.Canvas.BeginMarkedContent(obSubSubLayer2);
+      obPDF.Canvas.TextOut(22.0*PDFFactor,15.0*PDFFactor,'Text visible in Sub Sub Layer 2');
+      obPDF.Canvas.EndMarkedContent;
+    end;
+    obPDF.Canvas.EndMarkedContent;
+
+    obPDF.Canvas.BeginMarkedContent(obSubLayer2);
+    begin
+      obPDF.Canvas.TextOut(10.0*PDFFactor,14.0*PDFFactor,'Text visible in Sub Layer 2');
+    end;
+    obPDF.Canvas.EndMarkedContent;
+
+    obPDF.Canvas.BeginMarkedContent(obSubLayer3);
+    obPDF.Canvas.TextOut(10.0*PDFFactor,13.0*PDFFactor,'Text visible in Sub Layer 3');
+    obPDF.Canvas.EndMarkedContent;
+  end;
+  obPDF.Canvas.EndMarkedContent;
+
+
+  obPDF.Canvas.TextOut(2.0*PDFFactor,10.0*PDFFactor,'Main Layer 2:');
+
+  obPDF.Canvas.BeginMarkedContent(obMainLayer2);
+  begin
+    obPDF.Canvas.TextOut(10.0*PDFFactor,10.0*PDFFactor,'Text visible in Main Layer 2');
+
+    obPDF.Canvas.BeginMarkedContent(obRadioLayer1);
+    obPDF.Canvas.TextOut(10.0*PDFFactor,8.0*PDFFactor,'Text visible in Radio Layer 1');
+    obPDF.Canvas.EndMarkedContent;
+
+    obPDF.Canvas.BeginMarkedContent(obRadioLayer2);
+    obPDF.Canvas.TextOut(10.0*PDFFactor,7.0*PDFFactor,'Text visible in Radio Layer 2');
+    obPDF.Canvas.EndMarkedContent;
+
+    obPDF.Canvas.BeginMarkedContent(obRadioLayer3);
+    obPDF.Canvas.TextOut(10.0*PDFFactor,6.0*PDFFactor,'Text visible in Radio Layer 3');
+    obPDF.Canvas.EndMarkedContent;
+  end;
+  obPDF.Canvas.EndMarkedContent;
+
+  obPDF.Canvas.TextOut(2.0*PDFFactor,2.0*PDFFactor,'Main Layer 3:');
+
+  obPDF.Canvas.BeginMarkedContent(obMainLayer3);
+  obPDF.Canvas.TextOut(10.0*PDFFactor,2.0*PDFFactor,'Text visible in Main Layer 3');
+  obPDF.Canvas.EndMarkedContent;
+
+  obPDF.SaveToFile(ChangeFileExt(ExeVersion.ProgramFileName,'.pdf'));
+
+  FreeAndNil(obPDF);
+end.

contrib/mORMot/SQLite3/Samples/05 - Report created from code/TestSQLite3Pages.dpr

@@ -0,0 +1,14 @@
+program TestSQLite3Pages;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  Unit1 in 'Unit1.pas' {Form1};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/05 - Report created from code/Unit1.dfm

@@ -0,0 +1,86 @@
+object Form1: TForm1
+  Left = 258
+  Top = 211
+  Width = 338
+  Height = 356
+  Caption = ' SQLite3Pages Test'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 13
+  object lbl1: TLabel
+    Left = 32
+    Top = 16
+    Width = 62
+    Height = 13
+    Caption = 'Enter a Title:'
+  end
+  object Label1: TLabel
+    Left = 32
+    Top = 80
+    Width = 81
+    Height = 13
+    Caption = 'Enter some text:'
+  end
+  object edt1: TEdit
+    Left = 32
+    Top = 32
+    Width = 233
+    Height = 21
+    TabOrder = 0
+    Text = 'This is a Title from a field'
+  end
+  object mmo1: TMemo
+    Left = 32
+    Top = 96
+    Width = 233
+    Height = 153
+    Lines.Strings = (
+      
+        'In our Synopse SQLite3 framework there is a very easy Open Sourc' +
+        'e reporting system.'
+      ''
+      
+        'You create your report from code, then you can preview it on the' +
+        ' screen.'
+      'You can then print or export the report as PDF.'
+      ''
+      'Just right click on the report preview to see options.')
+    ScrollBars = ssVertical
+    TabOrder = 1
+    WordWrap = False
+  end
+  object btn1: TButton
+    Left = 32
+    Top = 264
+    Width = 113
+    Height = 33
+    Caption = 'Create Report'
+    TabOrder = 2
+    OnClick = btn1Click
+  end
+  object btn2: TButton
+    Left = 152
+    Top = 264
+    Width = 113
+    Height = 33
+    Caption = 'Quit'
+    TabOrder = 3
+    OnClick = btn2Click
+  end
+  object Button1: TButton
+    Left = 208
+    Top = 56
+    Width = 75
+    Height = 25
+    Caption = 'Button1'
+    TabOrder = 4
+    OnClick = Button1Click
+  end
+end

contrib/mORMot/SQLite3/Samples/05 - Report created from code/Unit1.pas

@@ -0,0 +1,336 @@
+unit Unit1;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ShellApi, Printers,
+  SynCommons, SynPdf, mORMotReport;
+
+type
+  TForm1 = class(TForm)
+    edt1: TEdit;
+    lbl1: TLabel;
+    Label1: TLabel;
+    mmo1: TMemo;
+    btn1: TButton;
+    btn2: TButton;
+    Button1: TButton;
+    procedure btn2Click(Sender: TObject);
+    procedure btn1Click(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+{$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
+
+procedure TForm1.btn2Click(Sender: TObject);
+begin
+  Close;
+end;
+
+const
+  UNICODE: array[0..5] of WideChar =
+   (#27161,#28310,#33836,#22283,#30908,#0);
+procedure TForm1.btn1Click(Sender: TObject);
+var Bmp: TBitmap;
+    U: RawUTF8;
+    s: string;
+    i: integer;
+{   R, Marg: TRect;
+    iz: TSize;
+    M: TMetaFile;}
+begin
+  Bmp := TBitmap.Create;
+  try
+    Bmp.Width := ClientWidth;
+    Bmp.Height := ClientHeight;
+    PaintTo(Bmp.Canvas,0,0); // create some bitmap content
+    with TGDIPages.Create(self) do
+    try
+      // the name of the report is taken from main Window's caption
+      Caption := self.Caption;
+      //Orientation := poLandscape;
+      // now we add some content to the report
+      BeginDoc;
+      {
+      M := TMetaFile.Create;
+      M.LoadFromFile('emf1.emf');
+      Siz := PaperSize;
+      Marg := PageMargins;
+      R.Left := Marg.Left;
+      R.Right := Siz.cx-Marg.Right;
+      R.Top := Marg.Top;
+      R.Bottom := Siz.cy-Marg.Top;
+      DrawMeta(R,M);
+      M.Free;
+      }
+
+      // header and footer
+      Font.Name := 'Georgia';
+      //Font.Name := 'Arial Unicode MS';
+      Font.Size := 11;
+      SaveLayout;
+      Font.Style := [fsItalic,fsUnderline];
+      TextAlign := taRight;
+      AddTextToHeaderAt('http://synopse.info',RightMarginPos);
+      Font.Style := [];
+      AddLineToFooter(false);
+      AddPagesToFooterAt(sPageN,RightMarginPos);
+      RestoreSavedLayout;
+      AddTextToHeader(ExeVersion.ProgramName);
+      AddTextToFooter(DateTimeToStr(Now));
+      AddLineToHeader(false);
+      Font.Size := 12;
+      ExportPDFForceJPEGCompression := 0;
+
+{      // test
+      WordWrapLeftCols := true;
+      AddColumns([10,22,22,22,22]);
+      AddColumnHeaders(['#','Two','Three','4','5'],true,true);
+      for i := 1 to 50 do
+        DrawTextAcrossCols([IntToStr(i),'Column '+IntToStr(i),
+        'This is some big text which must be justified on multiple lines. Text "four" and "five" will be invisible in pdf...',
+        'four','five']);
+      EndDoc;
+      ExportPDF('cells.pdf',True,True);}
+
+      // main content (automaticaly split on next pages)
+      NewHalfLine;
+      TextAlign := taJustified;
+      U := RawUnicodeToUtf8(UNICODE,StrLenW(UNICODE));
+      U := 'This is some big '+U+' text which must be justified on multiple lines. ';
+      U := U+U+U+U;
+      DrawTextU(U);
+      NewLine;
+      TextAlign := taLeft;
+      DrawTitle(edt1.Text,true);
+      for i := 1 to 10 do
+        DrawText('This is some text '+IntToStr(i));
+      NewLine;
+      DrawBMP(Bmp,maxInt,50,'Some bitmap in the report');
+      AddBookMark('bookmarkname');
+      WordWrapLeftCols := true;
+      AddColumns([10,20,50]);
+      AddColumnHeaders(['#','Two','Three'],true,true);
+      for i := 1 to 100 do
+        DrawTextAcrossCols([IntToStr(i),'Column '+IntToStr(i),'Some text here. '+s]);
+      NewLine;
+      DrawBMP(Bmp,maxInt,50,'Some bitmap in the report (twice)');
+      DrawTitle('This is your text',false,0,'','bookmarkname');
+      DrawText(mmo1.Text);
+
+      EndDoc;
+      ForceInternalAntiAliasedFontFallBack := true;
+      ForceNoAntiAliased := true;
+      //ForceInternalAntiAliased := false;
+      ExportPDFAuthor := 'A.Bouchez';
+      ExportPDFSubject := 'This is some sample file';
+      // set optional PDF export options
+      // ExportPDFForceJPEGCompression := 80;
+      // ExportPDFEmbeddedTTF := true;
+      // ExportPDFUseUniscribe := true;
+      // ExportPDFA1 := true;
+      //ExportPDF('test.pdf',true,true); close; exit;
+      // show a preview form, and allow basic actions via corresponding buttons
+      // ForceInternalAntiAliased := true;
+      // ForceInternalAntiAliasedFontFallBack := true;
+      ShowPreviewForm;
+  
+    finally
+      Free;
+    end;
+  finally
+    Bmp.Free;
+  end;
+end;
+
+
+procedure TForm1.FormShow(Sender: TObject);
+var FN: TFileName;
+    M: TMetaFile;
+    i: integer;
+begin
+  exit;
+  //btn1Click(nil); Close; exit;
+  //Button1Click(nil); Close; exit;
+  with TPdfDocument.Create do
+  try
+    for i := 0 to 24 do begin
+      AddPage;
+      M := TMetaFile.Create;
+      M.LoadFromFile(IntToStr(i)+'.emf');
+      Canvas.RenderMetaFile(M,Canvas.Page.PageHeight/M.Height*1.3);
+      M.Free;
+    end;
+{    AddPage;
+    with Canvas do
+    begin
+      SetFont('Arial',12,[fsBold]);
+      TextOut(100,500,'Test');
+      MoveTo(100,400);
+      LineTo(500,500);
+      Stroke;
+    end; }
+    FN := ChangeFileExt(ExeVersion.ProgramFileName,'.pdf');
+    SaveToFile(FN);
+    ShellExecute(Handle,nil,pointer(FN),nil,nil,SW_SHOWNORMAL);
+  finally
+    Free;
+  end;
+  Close;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+  i, y: integer;
+  TestImage: TBitmap;
+  Stream: TStream;
+  MF: TMetaFile;
+  R: TRect;
+begin
+  if false then
+  with TGDIPages.Create(self) do
+  try
+    BeginDoc;
+    MF := TMetafile.Create;
+    MF.LoadFromFile('d:\download\Sample (1).emf');
+    DrawGraphic(MF,0,PaperSize.cx-20);
+{    for y := 0 to 4 do
+    begin
+
+      DrawTitle(edt1.Text, true);
+      for i := 1 to 10 do
+        DrawText('This is some text ' + IntToStr(i));
+      NewLine;
+
+      TestImage := TBitmap.Create;
+      try
+        TestImage.Width := 500;
+        TestImage.Height := 500;
+
+        TestImage.Canvas.Pen.Color := clRed;
+        TestImage.Canvas.MoveTo(0, y * 80);
+        TestImage.Canvas.LineTo(TestImage.Width, y * 80);
+
+        DrawBMP(TestImage, maxInt, RightMarginPos);
+      finally
+        TestImage.Free;
+      end;
+
+      NewPage;
+    end;}
+
+    EndDoc;
+    ForceInternalAntiAliased := true;
+    ForceInternalAntiAliasedFontFallBack := true;
+    ExportPDFGeneratePDF15File := true;
+    ExportPDFUseUniscribe := true;
+    ShowPreviewForm;
+    //ExportPDF('test.pdf', true, true);
+  finally
+    Free;
+  end
+  else
+  if false then
+  with TPdfDocumentGDI.Create do
+    try
+      Stream := TFileStream.Create(ExeVersion.ProgramFilePath + 'streamdirect.pdf', fmCreate);
+      try
+        SaveToStreamDirectBegin(Stream);
+        for i := 1 to 9 do
+        begin
+          AddPage;
+          with VCLCanvas do
+          begin
+            Font.Name := 'Times new roman';
+            Font.Size := 120;
+            Font.Style := [fsBold, fsItalic];
+            Font.Color := clNavy;
+            TextOut(100, 100, 'Page ' + IntToStr(i));
+          end;
+          SaveToStreamDirectPageFlush; // direct writing
+        end;
+        SaveToStreamDirectEnd;
+      finally
+        Stream.Free;
+      end;
+    finally
+      Free;
+    end
+  else
+  with TPdfDocumentGDI.Create do
+    try
+      for i := 1 to 9 do
+      begin
+        AddPage;
+        with VCLCanvas do
+        begin
+          Font.Name := 'Times new roman';
+          Font.Size := 120;
+          Font.Style := [fsBold, fsItalic];
+          Font.Color := clNavy;
+          TextOut(100, 100, 'Page ' + IntToStr(i));
+        end;
+      end;
+      SaveToFile(ExeVersion.ProgramFilePath + 'multipages.pdf');
+    finally
+      Free;
+    end;
+end;
+{
+var
+  xRect: TRect;
+const
+  Text: WideString = 'RERERERE:';
+begin
+  with TPdfDocumentGDI.Create do
+  try
+    PDFA1 := true;
+    AddPage;
+    UseUniScribe := false; //uniscribe does not change anything about the problem
+    with VCLCanvas do begin
+      Font.Name := 'Tahoma';
+      Font.Size := 8;
+      Font.Style := [fsBold];
+      Pen.Color := $AAAAAA;
+
+      xRect := Rect(0, 0, TextWidth(Text), TextHeight(Text));
+      OffsetRect(xRect, 100, 100);
+
+      Rectangle(xRect);
+
+      Windows.ExtTextOutW(Handle, xRect.Left, xRect.Top, ETO_CLIPPED,
+        @xRect, PWideChar(Text), Length(Text), nil);
+
+      Font.Size := 24;
+
+      xRect := Rect(0, 0, TextWidth(Text), TextHeight(Text));
+      OffsetRect(xRect, 100, 200);
+
+      Rectangle(xRect);
+
+      Windows.ExtTextOutW(Handle, xRect.Left, xRect.Top, ETO_CLIPPED,
+        @xRect, PWideChar(Text), Length(Text), nil);
+
+    end;
+    SaveToFile('TestVcl.pdf');
+    ShellExecute(Handle,nil,'TestVcl.pdf',nil,nil,SW_SHOWNORMAL);
+  finally
+    Free;
+  end;
+end;
+}
+
+end.
+

contrib/mORMot/SQLite3/Samples/06 - Remote JSON REST Service/Project06Client.dpr

@@ -0,0 +1,19 @@
+program Project06Client;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  Project06ClientMain in 'Project06ClientMain.pas' {Form1};
+
+{$ifndef FPC}
+{$R *.res}
+{$endif FPC}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/06 - Remote JSON REST Service/Project06ClientMain.dfm

@@ -0,0 +1,70 @@
+object Form1: TForm1
+  Left = 334
+  Top = 330
+  Width = 322
+  Height = 280
+  Caption = 'Form1'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnDestroy = FormDestroy
+  PixelsPerInch = 96
+  TextHeight = 16
+  object lblA: TLabel
+    Left = 56
+    Top = 50
+    Width = 17
+    Height = 16
+    Caption = 'A='
+  end
+  object lblB: TLabel
+    Left = 56
+    Top = 98
+    Width = 16
+    Height = 16
+    Caption = 'B='
+  end
+  object lblResult: TLabel
+    Left = 76
+    Top = 200
+    Width = 184
+    Height = 16
+    Caption = 'Enter numbers, then Call Server'
+  end
+  object edtA: TEdit
+    Left = 80
+    Top = 48
+    Width = 153
+    Height = 24
+    TabOrder = 0
+  end
+  object edtB: TEdit
+    Left = 80
+    Top = 96
+    Width = 153
+    Height = 24
+    TabOrder = 1
+  end
+  object btnCall: TButton
+    Left = 56
+    Top = 152
+    Width = 97
+    Height = 25
+    Caption = 'Call Server'
+    TabOrder = 2
+    OnClick = btnCallClick
+  end
+  object btnCancel: TButton
+    Left = 168
+    Top = 152
+    Width = 97
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 3
+    OnClick = btnCancelClick
+  end
+end

contrib/mORMot/SQLite3/Samples/06 - Remote JSON REST Service/Project06ClientMain.pas

@@ -0,0 +1,74 @@
+unit Project06ClientMain;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls,
+  SynCommons, mORMot;
+
+type
+  TForm1 = class(TForm)
+    edtA: TEdit;
+    edtB: TEdit;
+    lblA: TLabel;
+    lblB: TLabel;
+    btnCall: TButton;
+    btnCancel: TButton;
+    lblResult: TLabel;
+    procedure btnCancelClick(Sender: TObject);
+    procedure btnCallClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    Model: TSQLModel;
+    Client: TSQLRestClientURINamedPipe;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+{$ifndef FPC}
+  {$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
+{$endif FPC}
+
+procedure TForm1.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.btnCallClick(Sender: TObject);
+var a,b: double;
+    err: integer;
+begin
+  val(edtA.Text,a,err);
+  if err<>0 then begin
+    edtA.SetFocus;
+    exit;
+  end;
+  val(edtB.Text,b,err);
+  if err<>0 then begin
+    edtB.SetFocus;
+    exit;
+  end;
+  if Client=nil then begin
+    if Model=nil then
+      Model := TSQLModel.Create([],'service');
+    Client := TSQLRestClientURINamedPipe.Create(Model,'RestService');
+  end;
+  lblResult.Caption := UTF8ToString(Client.CallBackGetResult('sum',['a',a,'b',b]));
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Client.Free;
+  Model.Free;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/06 - Remote JSON REST Service/Project06Server.dpr

@@ -0,0 +1,55 @@
+program Project06Server;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SynCommons,
+  mORMot,
+  SysUtils;
+
+type
+  // TSQLRestServerFullMemory kind of server is light and enough for our purpose
+  TServiceServer = class(TSQLRestServerFullMemory)
+  published
+    procedure Sum(Ctxt: TSQLRestServerURIContext);
+  end;
+
+
+{ TServiceServer }
+
+procedure TServiceServer.Sum(Ctxt: TSQLRestServerURIContext);
+// begin // the following would be faster to write, a bit slower to execute:
+//   Ctxt.Results([Ctxt['a']+Ctxt['b']]);
+// end;
+var a,b: double;
+begin
+  if UrlDecodeNeedParameters(Ctxt.Parameters,'A,B') then begin
+    while Ctxt.Parameters<>nil do begin
+      UrlDecodeDouble(Ctxt.Parameters,'A=',a);
+      UrlDecodeDouble(Ctxt.Parameters,'B=',b,@Ctxt.Parameters);
+    end;
+    Ctxt.Results([a+b]);
+  end else
+    Ctxt.Error('Missing Parameter');
+end;
+
+var
+  aModel: TSQLModel;
+begin
+  aModel := TSQLModel.Create([],'service');
+  try
+    with TServiceServer.Create(aModel) do
+    try
+      if ExportServerNamedPipe('RestService') then
+        writeln('Background server is running.'#10) else
+        writeln('Error launching the server'#10);
+      write('Press [Enter] to close the server.');
+      readln;
+    finally
+      Free;
+    end;
+  finally
+    aModel.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/07 - SynTest/SynTest.dpr

@@ -0,0 +1,17 @@
+program SynTest;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SynTestTest;
+
+begin
+  with TTestSuit.Create do
+  try
+    Run;
+    readln;
+  finally
+    Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/07 - SynTest/SynTestTest.pas

@@ -0,0 +1,117 @@
+unit SynTestTest;
+
+interface
+
+uses
+  SynCommons,
+  SynTests;
+
+function Adding(A,B: double): Double; overload;
+function Adding(A,B: integer): integer; overload;
+
+function Multiply(A,B: double): Double; overload;
+function Multiply(A,B: integer): integer; overload;
+
+
+type
+  TTestNumbersAdding = class(TSynTestCase)
+  published
+    procedure TestIntegerAdd;
+    procedure TestDoubleAdd;
+  end;
+
+  TTestNumbersMultiplying = class(TSynTestCase)
+  published
+    procedure TestIntegerMultiply;
+    procedure TestDoubleMultiply;
+  end;
+
+  TTestSuit = class(TSynTestsLogged)
+  published
+    procedure MyTestSuit;
+  end;
+
+
+implementation
+
+function Adding(A,B: double): Double; overload;
+begin
+  result := A+B;
+end;
+
+function Adding(A,B: integer): integer; overload;
+begin
+  result := A+B;
+end;
+
+function Multiply(A,B: double): Double; overload;
+begin
+  result := A*B;
+end;
+
+function Multiply(A,B: integer): integer; overload;
+begin
+  result := A*B;
+end;
+
+
+{ TTestSuit }
+
+procedure TTestSuit.MyTestSuit;
+begin
+  AddCase([TTestNumbersAdding,TTestNumbersMultiplying]);
+end;
+
+{ TTestNumbersAdding }
+
+procedure TTestNumbersAdding.TestDoubleAdd;
+var A,B: double;
+    i: integer;
+begin
+  for i := 1 to 1000 do
+  begin
+    A := Random;
+    B := Random;
+    Check(SameValue(A+B,Adding(A,B)));
+  end;
+end;
+
+procedure TTestNumbersAdding.TestIntegerAdd;
+var A,B: integer;
+    i: integer;
+begin
+  for i := 1 to 1000 do
+  begin
+    A := Random(maxInt);
+    B := Random(maxInt);
+    Check(A+B=Adding(A,B));
+  end;
+end;
+
+{ TTestNumbersMultiplying }
+
+procedure TTestNumbersMultiplying.TestDoubleMultiply;
+var A,B: double;
+    i: integer;
+begin
+  for i := 1 to 1000 do
+  begin
+    A := Random;
+    B := Random;
+    Check(SameValue(A*B,Multiply(A,B)));
+  end;
+end;
+
+procedure TTestNumbersMultiplying.TestIntegerMultiply;
+var A,B: integer;
+    i: integer;
+begin
+  for i := 1 to 1000 do
+  begin
+    A := Random(maxInt);
+    B := Random(maxInt);
+    Check(A*B=Multiply(A,B));
+  end;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/08 - TaskDialog/TaskDialogTest.dpr

@@ -0,0 +1,146 @@
+program TaskDialogTest;
+
+{$I Synopse.inc} // define HASINLINE CPU32 CPU64
+
+uses
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  Forms,
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  {$ifdef FPC}
+  SynTaskDialog in '..\..\Samples\ThirdPartyDemos\Ondrej\SynTaskDialog4Lazarus\SynTaskDialog.pas',
+  {$IFDEF MSWINDOWS}
+  win32extra,  // for TaskDialogIndirect
+  {$ENDIF}
+  {$else}
+  SynTaskDialog,
+  {$endif}
+  SynCommons,
+  mORMot,
+  mORMotUILogin;
+
+{$ifndef FPC}
+{$R *.res}
+
+{$R Vista.res} // to enable XP/Vista/Seven theming
+{$endif}
+
+var
+  MainCounter: integer;
+
+type
+  TCallBack = class
+  public
+    class procedure TaskDialogButtonClicked(Sender: PTaskDialog; AButtonID: Integer; var ACanClose: Boolean);
+  end;
+
+class procedure TCallBack.TaskDialogButtonClicked(Sender: PTaskDialog;
+  AButtonID: Integer; var ACanClose: Boolean);
+begin
+  if AButtonID=100 then begin
+    inc(MainCounter);
+    Sender^.SetElementText(tdeContent,IntToStr(MainCounter));
+    ACanClose := False;
+  end;
+end;
+
+procedure Test;
+var aUserName, aPassWord: string;
+    Task: TTaskDialog;
+    TaskEx: TTaskDialogEx;
+    res: boolean;
+    Enum: TTaskDialogIcon;
+begin
+  ShowMessage('This is just a message');
+  Task.Inst := 'Do you want to see the new dialog?';
+  Task.Content := 'This is the content';
+  Task.Buttons := 'Exit application without saving\nThis is not a good idea'#10+
+    'Exit application with saving';
+  Task.Footer := 'Made with Synopse SynTaskDialog unit';
+  case Task.Execute([],100,[tdfUseCommandLinks],tiQuestion,tfiInformation) of
+    101: ShowMessage('Saving settings','Blabla',false);
+    100: ShowMessage('You should better save your data. You should better save your data.'+
+      'You should better save your data.','Please RTFM instructions',true);
+    else assert(false);
+  end;
+  Task.Footer := '';
+  aUserName := 'user';
+  res := InputQuery('Prompt','Edit the user name',aUserName);
+  ShowMessage(aUserName,'You entered:',not res);
+  Enum := tiQuestion;
+  if InputSelectEnum('Enumeration selection','Please pick up one',
+     TypeInfo(TTaskDialogIcon),Enum) then
+    ShowMessage(GetEnumCaption(TypeInfo(TTaskDialogIcon),Enum),'You selected:') else
+    ShowMessage('You pressed Cancel',true);
+  ShowMessage('You selected Item #'+IntToStr(
+    Choose('','Select one item,First,Second,Last one')+1));
+  Task.Inst := 'Save file to disk ?';
+  Task.Content := 'If you do not save changes, these will be lost';
+  Task.Buttons := 'Save'#10'Don''t Save';
+  Task.Execute([],100,[],tiQuestion);
+  Task.Inst := 'Saving application settings';
+  Task.Content := 'This is the content';
+  Task.Buttons := '';
+  Task.Radios := 'Store settings in registry'#10'Store settings in XML file';
+  Task.Verify := 'Do no ask for this setting next time';
+  Task.VerifyChecked := true;
+  Task.Footer := 'XML file is perhaps a better choice';
+  Task.Execute([],0,[],tiBlank,tfiInformation,200);
+  ShowMessage(IntToStr(Task.RadioRes));
+  if Task.VerifyChecked then
+    ShowMessage(Task.Verify);
+  TaskEx.Init; // or TaskEx := DefaultTaskDialog;
+  TaskEx.Base.Title := 'Task Dialog Test';
+  TaskEx.Base.Inst := 'Callback Test';
+  MainCounter := 0;
+  TaskEx.Base.Content := '0';
+  TaskEx.Base.Buttons := 'Increment Counter';
+  TaskEx.CommonButtons := [cbCancel];
+  TaskEx.ButtonDef := 100;
+  TaskEx.Flags := [tdfUseCommandLinks];
+  TaskEx.DialogIcon := tiQuestion;
+  TaskEx.OnButtonClicked := TCallBack.TaskDialogButtonClicked;
+  TaskEx.Execute;
+  ShowMessage(FormatString('User=% Password=%',[aUserName,aPassword]),
+    not TLoginForm.Login('Title','Please login',aUserName,aPassWord,true,''));
+  ShowMessage(FormatString('User=% Password=%',[aUserName,aPassword]),
+    not TLoginForm.Login('Title','Please login again',aUserName,aPassWord,true,''));
+end;
+
+procedure Test2;
+var
+  vDialogue : TTaskDialog;
+begin
+  vDialogue.Title   := 'My Title';
+  vDialogue.Inst    := 'Lorem ipsum dolor sit amet consectetuer';
+  vDialogue.Content := 'Libero interdum "' +
+                       'necVestibulumidsedetwisinequetinciduntMorbiAliquampedetinciduntSedsempercursusorciipsumipsumegestasProinTortortempus' +
+                       '" (' +
+                       'neque libero Curabitur Donec non Morbi et odio ' +
+                       'Praesent. Felis tincidunt vitae turpis malesuada fames\n\n'+
+                       'sodales ac Suspendisse augue Aenean. Euismod Aenean non\n\n' +
+                       'Morbi et vitae at hendrerit Quisque vitae accumsan. Tellus pretium adipiscing leo Curabitur\n\n' +
+                       'Pellentesque turpis lacus Nulla.\n\n' +
+                       'Curabitur faucibus risus eget nisl Lorem libero augue dui Nullam urna. Convallis';
+  vDialogue.Buttons := 'Button1'#10'Button2';
+
+  vDialogue.Verify        := 'Ne plus afficher ce message';
+  vDialogue.VerifyChecked := False;
+
+  vDialogue.Execute([], 100, [tdfUseCommandLinks], tiWarning);
+end;
+
+begin
+  {$ifdef FPC}
+  Application.Initialize;
+  {$endif}
+  Test;
+  if @TaskDialogIndirect<>nil then
+  begin
+    ShowMessage('Now displaying the dialogs using TaskDialogIndirect');
+    @TaskDialogIndirect := nil;
+    Test;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/09 - HttpApi web server/HttpApiServer.dpr

@@ -0,0 +1,140 @@
+/// sample program which will serve C:\ content on http://localhost:888/root
+program HttpApiServer;
+
+{$APPTYPE CONSOLE}
+
+{$I Synopse.inc}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  SynCommons,
+  SynZip,
+  SynCrtSock;
+
+type
+  TTestServer = class
+  protected
+    fPath: TFileName;
+    fServer: THttpApiServer;
+    function Process(Ctxt: THttpServerRequest): cardinal;
+  public
+    constructor Create(const Path: TFileName);
+    destructor Destroy; override;
+  end;
+
+
+{ TTestServer }
+
+constructor TTestServer.Create(const Path: TFileName);
+begin
+  fPath := IncludeTrailingPathDelimiter(Path);
+  fServer := THttpApiServer.Create(false);
+  fServer.AddUrl('root','888',false,'+',true);
+  fServer.RegisterCompress(CompressDeflate); // our server will deflate html :)
+  fServer.OnRequest := Process;
+  fServer.Clone(31); // will use a thread pool of 32 threads in total
+end;
+
+destructor TTestServer.Destroy;
+begin
+  fServer.Free;
+  inherited;
+end;
+
+{$WARN SYMBOL_PLATFORM OFF}
+
+function TTestServer.Process(Ctxt: THttpServerRequest): cardinal;
+var W: TTextWriter;
+    FileName: TFileName;
+    FN, SRName, href: RawUTF8;
+    i: integer;
+    SR: TSearchRec;
+    
+  procedure hrefCompute;
+  begin
+    SRName := StringToUTF8(SR.Name);
+    href := FN+StringReplaceChars(SRName,'\','/');
+  end;
+
+begin
+  writeln(Ctxt.Method,' ',Ctxt.URL);
+  if not IdemPChar(pointer(Ctxt.URL),'/ROOT')  then begin
+    result := 404;
+    exit;
+  end;
+  FN := StringReplaceChars(UrlDecode(copy(Ctxt.URL,7,maxInt)),'/','\');
+  if PosEx('..',FN)>0 then begin
+    result := 404; // circumvent obvious potential security leak
+    exit;
+  end;
+  while (FN<>'') and (FN[1]='\') do
+    delete(FN,1,1);
+  while (FN<>'') and (FN[length(FN)]='\') do
+    delete(FN,length(FN),1);
+  FileName := fPath+UTF8ToString(FN);
+  if DirectoryExists(FileName) then begin
+    // reply directory listing as html
+    W := TTextWriter.CreateOwnedStream;
+    try
+      W.Add('<html><body style="font-family: Arial">'+
+        '<h3>%</h3><p><table>',[FN]);
+      FN := StringReplaceChars(FN,'\','/');
+      if FN<>'' then
+        FN := FN+'/';
+      if FindFirst(FileName+'\*.*',faDirectory,SR)=0 then begin
+        repeat
+          if (SR.Attr and faDirectory<>0) and (SR.Name<>'.') then begin
+            hrefCompute;
+            if SRName='..' then begin
+              i := length(FN);
+              while (i>0) and (FN[i]='/') do dec(i);
+              while (i>0) and (FN[i]<>'/') do dec(i);
+              href := copy(FN,1,i);
+            end;
+            W.Add('<tr><td><b><a href="/root/%">[%]</a></b></td></tr>',[href,SRName]);
+          end;
+        until FindNext(SR)<>0;
+        FindClose(SR);
+      end;
+      if FindFirst(FileName+'\*.*',faAnyFile-faDirectory-faHidden,SR)=0 then begin
+        repeat
+          hrefCompute;
+          if SR.Attr and faDirectory=0 then
+            W.Add('<tr><td><b><a href="/root/%">%</a></b></td><td>%</td><td>%</td></td></tr>',
+              [href,SRName,KB(SR.Size),DateTimeToStr(
+                {$ifdef ISDELPHIXE2}SR.TimeStamp{$else}FileDateToDateTime(SR.Time){$endif})]);
+        until FindNext(SR)<>0;
+        FindClose(SR);
+      end;
+      W.AddShort('</table></p><p><i>Powered by mORMot''s <strong>');
+
+      W.AddClassName(Ctxt.Server.ClassType);
+
+      W.AddShort('</strong></i> - '+
+
+        'see <a href=https://synopse.info>https://synopse.info</a></p></body></html>');
+      Ctxt.OutContent := W.Text;
+      Ctxt.OutContentType := HTML_CONTENT_TYPE;
+      result := 200;
+    finally
+      W.Free;
+    end;
+  end else begin
+    // http.sys will send the specified file from kernel mode
+    Ctxt.OutContent := StringToUTF8(FileName);
+    Ctxt.OutContentType := HTTP_RESP_STATICFILE;
+    result := 200; // THttpApiServer.Execute will return 404 if not found
+  end;
+end;
+
+begin
+  with TTestServer.Create('d:\Documents\Smart Mobile Projects\Featured Demos\Binary Data Import\www\') do
+  try
+    write('Server is now running on http://localhost:888/root'#13#10#13#10+
+      'Press [Enter] to quit');
+    readln;
+  finally
+    Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/09 - HttpApi web server/HttpApiServer.lpi

@@ -0,0 +1,75 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="HttpApiServer"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="HttpApiServer.dpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="HttpApiServer"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="..\..;..\..\..;$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\..;..\..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/10 - Background Http service/httpservice.dpr

@@ -0,0 +1,133 @@
+/// implements a background Service serving HTTP pages
+program HttpService;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Windows,
+  Classes,
+  SysUtils,
+  SynCommons,
+  SynTable,
+  SynLog,
+  mORMotService,
+  mORMot,
+  mORMotSQLite3, SynSQLite3Static,
+  mORMotHTTPServer,
+  SampleData in '..\01 - In Memory ORM\SampleData.pas';
+
+
+
+/// if we will run the service with administrator rights
+// - otherwise, ensure you registered the URI /root:8080
+{$R ..\..\..\VistaAdm.res}
+
+type
+  /// class implementing the background Service
+  TSQLite3HttpService = class(TServiceSingle)
+  public
+    /// the associated database model
+    Model: TSQLModel;
+    /// the associated DB
+    DB: TSQLRestServerDB;
+    /// the background Server processing all requests
+    Server: TSQLHttpServer;
+
+    /// event triggered to start the service
+    // - e.g. create the Server instance
+    procedure DoStart(Sender: TService);
+    /// event triggered to stop the service
+    // - e.g. destroy the Server instance
+    procedure DoStop(Sender: TService);
+
+    /// initialize the background Service
+    constructor Create; reintroduce;
+    /// launch as Console application
+    constructor CreateAsConsole; reintroduce;
+    /// release memory
+    destructor Destroy; override;
+  end;
+
+
+const
+  HTTPSERVICENAME = 'mORMotHttpServerService';
+  HTTPSERVICEDISPLAYNAME = 'mORMot Http Server Service';
+
+
+{ TSQLite3HttpService }
+
+constructor TSQLite3HttpService.Create;
+begin
+  inherited Create(HTTPSERVICENAME,HTTPSERVICEDISPLAYNAME);
+  TSQLLog.Family.Level := LOG_VERBOSE;
+  TSQLLog.Family.PerThreadLog := ptIdentifiedInOnFile;
+  TSQLLog.Enter(self);
+  OnStart := {$ifdef FPC}@{$endif}DoStart;
+  OnStop := {$ifdef FPC}@{$endif}DoStop;
+  OnResume := {$ifdef FPC}@{$endif}DoStart; // trivial Pause/Resume actions
+  OnPause := {$ifdef FPC}@{$endif}DoStop;
+end;
+
+constructor TSQLite3HttpService.CreateAsConsole;
+begin
+  // manual switch to console mode
+  AllocConsole;
+  // define the log level
+  with TSQLLog.Family do begin
+    Level := LOG_VERBOSE;
+    EchoToConsole := LOG_STACKTRACE;
+  end;
+end;
+
+destructor TSQLite3HttpService.Destroy;
+begin
+  TSQLLog.Enter(self);
+  if Server<>nil then
+    DoStop(nil); // should not happen
+  inherited Destroy;
+end;
+
+procedure TSQLite3HttpService.DoStart(Sender: TService);
+begin
+  TSQLLog.Enter(self);
+  if Server<>nil then
+    DoStop(nil); // should never happen
+  Model := CreateSampleModel;
+  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
+  DB.CreateMissingTables;
+  Server := TSQLHttpServer.Create('8080',[DB],'+',useHttpApiRegisteringURI);
+  TSQLLog.Add.Log(sllInfo,'Server % started by %',[Server.HttpServer,Server]);
+end;
+
+procedure TSQLite3HttpService.DoStop(Sender: TService);
+begin
+  TSQLLog.Enter(self);
+  if Server=nil then
+    exit;
+  TSQLLog.Add.Log(sllInfo,'Server % stopped by %',[Server.HttpServer,Server]);
+  FreeAndNil(Server);
+  FreeAndNil(DB);
+  FreeAndNil(Model);
+end;
+
+begin
+  if (ParamCount<>0) and
+     (SameText(ParamStr(1),'-c') or SameText(ParamStr(1),'/c')) then
+    with TSQLite3HttpService.CreateAsConsole do
+    try
+      DoStart(nil);
+      TextColor(ccLightGray);
+      writeln(#10'Background server is running.'#10);
+      writeln('Press [Enter] to close the server.'#10);
+      ConsoleWaitForEnterKey; // ReadLn if you do not use main thread execution
+      exit;
+    finally
+      Free;
+    end else
+    with TSQLite3HttpService.Create do
+    try
+      // launches the registered Services execution = do all the magic
+      ServicesRun;
+    finally
+      Free;
+    end;
+end.

contrib/mORMot/SQLite3/Samples/10 - Background Http service/httpservice.lpi

@@ -0,0 +1,76 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="httpservice"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="httpservice.dpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="HttpService"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="httpservice"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="..\..;..\..\..;$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\..;..\..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/10 - Background Http service/httpserviceSetup.dpr

@@ -0,0 +1,35 @@
+/// manage (install/start/stop/uninstall) HttpService sample
+program HttpServiceSetup;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Windows,
+  Classes,
+  SysUtils,
+  SynCommons,
+  SynLog,
+  mORMot,
+  mORMotService;
+
+/// if we will run the service with administrator rights
+// - otherwise, ensure you registered the URI /root:8080
+{$R ..\..\..\VistaAdm.res}
+
+const
+  HTTPSERVICE_NAME = 'mORMotHttpServerService';
+  HTTPSERVICE_DISPLAYNAME = 'mORMot Http Server Service';
+  HTTPSERVICE_DESCRIPTION = 'This is a sample mORMot HTTP Server running as Service';
+
+begin
+  ServiceLog := TSQLLog; // explicitely enable logging
+  ServiceLog.Family.Level := LOG_VERBOSE;
+  TServiceController.CheckParameters(ExeVersion.ProgramFilePath+'HttpService.exe',
+    HTTPSERVICE_NAME,HTTPSERVICE_DISPLAYNAME,HTTPSERVICE_DESCRIPTION);
+  TSQLLog.Add.Log(sllTrace,'Quitting command line');
+  with TServiceController.CreateOpenService('','',HTTPSERVICE_NAME) do
+  try
+    State; // just to log the service state after handling the /parameters
+  finally
+    Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/10 - Background Http service/httpserviceSetup.lpi

@@ -0,0 +1,76 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="httpserviceSetup"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="httpserviceSetup.dpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="HttpServiceSetup"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="httpserviceSetup"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="..\..;..\..\..;$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\..;..\..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/11 - Exception logging/LibraryTest.dpr

@@ -0,0 +1,13 @@
+program LibraryTest;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils;
+
+procedure Test; external 'MyLibrary.dll';
+
+begin
+  Test;
+end.

contrib/mORMot/SQLite3/Samples/11 - Exception logging/LogView.dpr

@@ -0,0 +1,26 @@
+/// sample program able to visualize .log files as created by TSynLog
+program LogView;
+
+{ Revision History:
+
+  Version 1.18
+  - Introducing thread identification
+  - Added "Search Previous" button
+  - Incremental search will now remain on the same line if it matches the entry
+  - "Server Launch" button allow the tool to run as a HTTP server, ready to
+    display remote logs, echoed from mORMot HTTP clients 
+  
+}
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  LogViewMain in 'LogViewMain.pas' {MainLogView};
+
+{$R *.res}
+{$R Vista.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TMainLogView, MainLogView);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/11 - Exception logging/LogView.lpi

@@ -0,0 +1,205 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="LogView"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <BuildModes Count="4">
+      <Item1 Name="Default" Default="True"/>
+      <Item2 Name="win64">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="exe\LogView"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);..\..\.."/>
+            <OtherUnitFiles Value="..\..\..;..\.."/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <SyntaxMode Value="Delphi"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="x86_64"/>
+            <TargetOS Value="win64"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <StripSymbols Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item2>
+      <Item3 Name="linux64">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);..\..\.."/>
+            <OtherUnitFiles Value="..\..\..;..\.."/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <SyntaxMode Value="Delphi"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="x86_64"/>
+            <TargetOS Value="linux"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <StripSymbols Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item3>
+      <Item4 Name="darwin32">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);..\..\.."/>
+            <OtherUnitFiles Value="..\..\..;..\.."/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <SyntaxMode Value="Delphi"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="i386"/>
+            <TargetOS Value="darwin"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <StripSymbols Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item4>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default"/>
+      </Modes>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="LogView.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="LogViewMain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="MainLogView"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\ThirdPartyDemos\Ondrej\SynTaskDialog4Lazarus\SynTaskDialog.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="exe\LogView"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir);..\..\.."/>
+      <OtherUnitFiles Value="..\..\..;..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <SyntaxMode Value="Delphi"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="5">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+      <Item4>
+        <Name Value="EHttpApiServer"/>
+      </Item4>
+      <Item5>
+        <Name Value="EHttpServerException"/>
+      </Item5>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/11 - Exception logging/LogView.lpr

@@ -0,0 +1,19 @@
+program LogView;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Interfaces, // this includes the LCL widgetset
+  Forms,
+  SynTaskDialog in '..\..\Samples\ThirdPartyDemos\Ondrej\SynTaskDialog4Lazarus\SynTaskDialog.pas',
+  LogViewMain in 'LogViewMain.pas' {MainLogView};
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Initialize;
+  Application.CreateForm(TMainLogView, MainLogView);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/11 - Exception logging/LogViewMain.dfm

@@ -0,0 +1,588 @@
+object MainLogView: TMainLogView
+  Left = 359
+  Top = 232
+  Width = 860
+  Height = 639
+  Caption = ' Synopse LogView %s -'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  KeyPreview = True
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnKeyDown = FormKeyDown
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Splitter2: TSplitter
+    Left = 0
+    Top = 549
+    Width = 852
+    Height = 4
+    Cursor = crVSplit
+    Align = alBottom
+  end
+  object Splitter3: TSplitter
+    Left = 805
+    Top = 0
+    Width = 4
+    Height = 549
+    Visible = False
+  end
+  object Splitter1: TSplitter
+    Left = 649
+    Top = 0
+    Width = 4
+    Height = 549
+    Visible = False
+  end
+  object Splitter4: TSplitter
+    Left = 801
+    Top = 0
+    Width = 4
+    Height = 549
+    Visible = False
+  end
+  object PanelLeft: TPanel
+    Left = 225
+    Top = 0
+    Width = 150
+    Height = 549
+    Align = alLeft
+    Constraints.MinWidth = 150
+    TabOrder = 0
+    OnResize = PanelLeftResize
+    DesignSize = (
+      150
+      549)
+    object ImageLogo: TImage
+      Left = 8
+      Top = 501
+      Width = 137
+      Height = 32
+      Anchors = [akLeft, akRight, akBottom]
+      Center = True
+      Picture.Data = {
+        07544269746D617076090000424D760900000000000076000000280000008900
+        0000200000000100040000000000000900000000000000000000100000000000
+        00000504180004A6FC00444446000704C400918FB000D1D1DF001D26E0005454
+        5600726FA000046EFC00B2B0CD0031323300FCFEFC005A53D1003731CF004446
+        FC00CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCC555A5555CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCC54444CCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCA77778777785CCCCCCCCCCCCC5444ACCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCC533338C
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC58274A555555A877ACCCCCCCCCCCD3333
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+        CCCCCCCCCC63333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA774A472BBBB74AA82
+        4CCCCCCCCCCD3333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+        0000CCCCCCCCCCCCCCCCCCCCCCA3333ACCCCCCCCCCCCCCCCCCCCCCCCCCCCC428
+        4700000000000244775CCCCCCCCD3333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCC3333ECCCCCCCCCCCCCCCC
+        CCCCCCCCCCCC4278B0000000000000078775CCCCCCCD3336CCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCC54E3333EACCCCCCCCC83333
+        CCCCCCCC888D5CCCC488DACCCCC4277000000000000000002727CCCCCCCD3336
+        CD63E4CCCCCCCAF333368CCCCCCCCC5863333FACCCCCC0000000CCCC83333333
+        3334CCCCCCCE3333DCCCCCCC3333ACCCC3333FCCCCA277000000000000000000
+        0B728CCCCCCD333333333365CCC53333333333FCCCCC5E3333333333ACCCC000
+        0000CCCCD333333333334CCCCC5333333CCCCCCC3333ACCCC6333DCCCC748000
+        000033333333000000287ACCCCCD333333333333CCC533333333333ECCC53333
+        33333333ACCCC0000000CCCCD3EACCCC83333CCCCCD3333334CCCCCC3333ACCC
+        C6333DCCC48AB0000033333333333000000847CCCCCD33335AAD3333DCC53345
+        CCCA33335CC333338A5C5463ACCCC0000000CCCC4ACCCCCC43333CCCCC333333
+        36CCCCCC3333ACCCC6333DCCC7AA000003333333333333000002A75CCCCD3336
+        CCCCD33335C58CCCCCC533334CA3333ACCCCCCC85CCCC0000000CCCCCCC5A8E3
+        33333CCCCA3333E3335CCCCC3333ACCCC6333DCC5BA700003333333333333330
+        0000587CCCCD3333CCCC53333ACCCCCA8F333333AC8333FCCCCCCCCCCCCCC000
+        0000CCCCCCD333333333FCCCC63338A333DCCCCC3333ACCCC6333DCC42400000
+        33333333333333330000442CCCCD3333CCCCC33334CCC43333333333CCD3333F
+        EEEEEEE68CCCC0000000CCCCC3333333333DCCCC533335C3333CCCCC3333ACCC
+        C6333DCC227000033333333333333333000028B5CCCD3333CCCCC33338CC8333
+        33333335CCD3333333333333FCCCC0000000CCCC53333333E45CCCCC83336CCE
+        3334CCCC3333ACCCC3333DCCB77000033333333333333333000008B5CCCD3333
+        CCCCC33334CC33333336D5CCCCD3333333333333DCCCC0000000CCCC43333ACC
+        CCCCCCCC33334CCA3333CCCC3333ACCCC3333DCC07B000033333336193333333
+        000007BACCCD3336CCCCA3333ACC33338CCCCCC5CCA333DCCCCC63334CCCC000
+        0000CCCCA3333CCCCC538CCA3333CCCC33335CCC333338AAF33334CC07B00003
+        3333336193333333000007BACCCD3333ACC5333335CC3333ACCCC5D3CCC33335
+        CCCC33335CCCC0000000CCCCC333333633334CC3333ECCCCD3336CCC33333333
+        333335CC077000033333633333333333000007BACCCD333333333333DCCCD333
+        33633333CCCA3333F4D3333FCCCCC0000000CCCCC533333333338C53333ACCCC
+        A3333CCC3333F3333333FCCCB7700B03333F6333336663330000B8B5CCCD3333
+        63333333CCCCCE3333333333CCCC43333333333CCCCCC0000000CCCCCCC46333
+        3368CC4366ECCCCCCE6634CCE6635CD33338CCCC828004003333333333336333
+        00B077BCCCC8366DC83333DCCCCCCCAE333333FACCCCCCD3333338CCCCCCC000
+        0000CCCCCCCCCC555CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC55CCCCCC5B4B0A20
+        DD3333EFF333336B0040872CCCCCCCCCCCC55CCCCCCCCCCCCC55CCCCCCCCCCCC
+        5555CCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCC7440BB00333333333333372088B42ACCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCA4AB00000333EEEEE3330000B0847CCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC4440000000384A48300000
+        007445CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+        0000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC574800
+        000B0000000BB0000244ACCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCC474400085555555554B007487CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCC72A4B0028A5C5A470008A825CCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC77AA8000000000007AA
+        8B5CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+        0000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA7
+        4A5A8BB0BB7455478CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCC5474A55555555487ACCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA44AAAAA4445CCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC555555CCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+        0000}
+      Transparent = True
+      OnClick = ImageLogoClick
+    end
+    object lblServerRoot: TLabel
+      Left = 16
+      Top = 48
+      Width = 62
+      Height = 13
+      Caption = 'Server Root:'
+    end
+    object lblServerPort: TLabel
+      Left = 16
+      Top = 90
+      Width = 59
+      Height = 13
+      Caption = 'Server Port:'
+    end
+    object BtnBrowse: TButton
+      Left = 16
+      Top = 8
+      Width = 107
+      Height = 25
+      Anchors = [akTop, akRight]
+      Caption = 'Select File'
+      TabOrder = 0
+      OnClick = BtnBrowseClick
+    end
+    object EventsList: TCheckListBox
+      Left = 16
+      Top = 72
+      Width = 118
+      Height = 105
+      Hint = 'Selection of Events - right click for shortcuts'
+      OnClickCheck = EventsListClickCheck
+      ItemHeight = 13
+      ParentShowHint = False
+      PopupMenu = FilterMenu
+      ShowHint = True
+      Style = lbOwnerDrawFixed
+      TabOrder = 3
+      OnDblClick = EventsListDblClick
+      OnDrawItem = EventsListDrawItem
+    end
+    object EditSearch: TEdit
+      Left = 16
+      Top = 40
+      Width = 85
+      Height = 21
+      Hint = 'Search (Ctrl+F, F3 for next) '
+      Anchors = [akLeft, akTop, akRight]
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 1
+      OnChange = BtnSearchNextClick
+    end
+    object BtnSearchNext: TButton
+      Left = 105
+      Top = 38
+      Width = 20
+      Height = 23
+      Hint = 'Search Next (F3)'
+      Anchors = [akTop, akRight]
+      Caption = '?'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 2
+      OnClick = BtnSearchNextClick
+    end
+    object BtnStats: TButton
+      Left = 16
+      Top = 304
+      Width = 57
+      Height = 25
+      Caption = 'Stats'
+      TabOrder = 6
+      OnClick = BtnStatsClick
+    end
+    object BtnMapSearch: TButton
+      Left = 80
+      Top = 304
+      Width = 59
+      Height = 25
+      Hint = 'Search for an address in a .map file'
+      Caption = '.map'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 7
+      OnClick = BtnMapSearchClick
+    end
+    object MergedProfile: TCheckBox
+      Left = 22
+      Top = 283
+      Width = 121
+      Height = 17
+      Caption = 'Merge method calls'
+      TabOrder = 5
+      OnClick = MergedProfileClick
+    end
+    object ProfileGroup: TRadioGroup
+      Left = 16
+      Top = 192
+      Width = 118
+      Height = 89
+      Caption = ' Methods profiler '
+      ParentShowHint = False
+      ShowHint = False
+      TabOrder = 4
+      OnClick = ProfileGroupClick
+    end
+    object ThreadGroup: TGroupBox
+      Left = 16
+      Top = 336
+      Width = 118
+      Height = 97
+      Caption = ' Threads '
+      TabOrder = 8
+      object BtnThreadNext: TButton
+        Left = 8
+        Top = 13
+        Width = 33
+        Height = 25
+        Hint = 'Goto Next Thread'
+        Caption = 'Next'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 0
+        OnClick = BtnThreadNextClick
+      end
+      object BtnThreadShow: TButton
+        Left = 8
+        Top = 39
+        Width = 97
+        Height = 25
+        Caption = 'View threads'
+        TabOrder = 1
+        OnClick = BtnThreadShowClick
+      end
+      object btnThread0: TButton
+        Left = 8
+        Top = 66
+        Width = 25
+        Height = 25
+        Hint = 'Select No Thread'
+        Caption = '0'
+        Enabled = False
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 2
+        OnClick = BtnThreadClick
+      end
+      object btnThread1: TButton
+        Left = 40
+        Top = 66
+        Width = 25
+        Height = 25
+        Hint = 'Select Only This Thread'
+        Caption = '1'
+        Enabled = False
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 3
+        OnClick = BtnThreadClick
+      end
+      object btnThreadAll: TButton
+        Left = 72
+        Top = 66
+        Width = 33
+        Height = 25
+        Hint = 'Select All Threads'
+        Caption = 'All'
+        Enabled = False
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 4
+        OnClick = BtnThreadClick
+      end
+      object btnThreadDown: TButton
+        Left = 56
+        Top = 13
+        Width = 25
+        Height = 25
+        Hint = 'Goto Next  Row'
+        Caption = 'v'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 5
+        OnClick = btnThreadDownClick
+      end
+      object btnThreadUp: TButton
+        Left = 80
+        Top = 13
+        Width = 25
+        Height = 25
+        Hint = 'Goto Previous Row'
+        Caption = '^'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 6
+        OnClick = btnThreadUpClick
+      end
+    end
+    object BtnSearchPrevious: TButton
+      Left = 127
+      Top = 38
+      Width = 20
+      Height = 23
+      Hint = 'Search Previous (Shift F3)'
+      Anchors = [akTop, akRight]
+      Caption = '^'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 9
+      OnClick = BtnSearchNextClick
+    end
+    object btnServerLaunch: TButton
+      Left = 16
+      Top = 132
+      Width = 107
+      Height = 25
+      Hint = 'Lauch a HTTP server  for remote logging'
+      Anchors = [akTop, akRight]
+      Caption = 'Server Launch'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 10
+      OnClick = btnServerLaunchClick
+    end
+    object edtServerRoot: TEdit
+      Left = 16
+      Top = 64
+      Width = 121
+      Height = 21
+      TabOrder = 11
+      Text = 'LogService'
+    end
+    object edtServerPort: TEdit
+      Left = 16
+      Top = 106
+      Width = 121
+      Height = 21
+      TabOrder = 12
+      Text = '8091'
+    end
+    object btnListClear: TButton
+      Left = 16
+      Top = 160
+      Width = 105
+      Height = 25
+      Caption = 'Clear List'
+      TabOrder = 13
+      Visible = False
+      OnClick = btnListClearClick
+    end
+    object btnListSave: TButton
+      Left = 16
+      Top = 192
+      Width = 105
+      Height = 25
+      Caption = 'Save List'
+      TabOrder = 14
+      Visible = False
+      OnClick = btnListSaveClick
+    end
+    object lstDays: TListBox
+      Left = 16
+      Top = 440
+      Width = 121
+      Height = 57
+      ItemHeight = 13
+      TabOrder = 15
+      OnDblClick = lstDaysDblClick
+    end
+  end
+  object PanelBottom: TPanel
+    Left = 0
+    Top = 553
+    Width = 852
+    Height = 52
+    Align = alBottom
+    TabOrder = 3
+    OnResize = PanelBottomResize
+  end
+  object List: TDrawGrid
+    Left = 809
+    Top = 0
+    Width = 43
+    Height = 549
+    Align = alClient
+    ColCount = 3
+    DefaultColWidth = 100
+    DefaultRowHeight = 14
+    FixedCols = 0
+    RowCount = 1
+    FixedRows = 0
+    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goRowSelect, goThumbTracking]
+    PopupMenu = ListMenu
+    TabOrder = 2
+    Visible = False
+    OnClick = ListClick
+    OnDblClick = ListDblClick
+    OnDrawCell = ListDrawCell
+  end
+  object ProfileList: TDrawGrid
+    Left = 375
+    Top = 0
+    Width = 274
+    Height = 549
+    Align = alLeft
+    ColCount = 2
+    DefaultColWidth = 100
+    DefaultRowHeight = 14
+    FixedCols = 0
+    FixedRows = 0
+    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect, goThumbTracking]
+    TabOrder = 1
+    Visible = False
+    OnClick = ProfileListClick
+    OnDrawCell = ProfileListDrawCell
+  end
+  object PanelThread: TPanel
+    Left = 653
+    Top = 0
+    Width = 148
+    Height = 549
+    Align = alLeft
+    TabOrder = 4
+    Visible = False
+    object ThreadListBox: TCheckListBox
+      Left = 1
+      Top = 1
+      Width = 146
+      Height = 507
+      OnClickCheck = ThreadListBoxClickCheck
+      Align = alClient
+      ItemHeight = 13
+      TabOrder = 0
+      OnClick = ThreadListBoxClick
+      OnDblClick = ThreadListBoxDblClick
+    end
+    object pnlThreadBottom: TPanel
+      Left = 1
+      Top = 508
+      Width = 146
+      Height = 40
+      Align = alBottom
+      TabOrder = 1
+      DesignSize = (
+        146
+        40)
+      object lblThreadName: TLabel
+        Left = 3
+        Top = 3
+        Width = 141
+        Height = 33
+        Anchors = [akLeft, akTop, akRight, akBottom]
+        AutoSize = False
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -11
+        Font.Name = 'Tahoma'
+        Font.Style = []
+        ParentFont = False
+        WordWrap = True
+      end
+    end
+  end
+  object PanelBrowse: TPanel
+    Left = 0
+    Top = 0
+    Width = 225
+    Height = 549
+    Align = alLeft
+    Constraints.MinWidth = 80
+    TabOrder = 5
+    Visible = False
+    DesignSize = (
+      225
+      549)
+    object Drive: TDriveComboBox
+      Left = 8
+      Top = 8
+      Width = 210
+      Height = 19
+      Anchors = [akLeft, akTop, akRight]
+      DirList = Directory
+      TabOrder = 0
+    end
+    object Directory: TDirectoryListBox
+      Left = 8
+      Top = 33
+      Width = 210
+      Height = 220
+      Anchors = [akLeft, akTop, akRight]
+      FileList = Files
+      ItemHeight = 16
+      TabOrder = 1
+    end
+    object Files: TFileListBox
+      Left = 8
+      Top = 264
+      Width = 210
+      Height = 268
+      Anchors = [akLeft, akTop, akRight, akBottom]
+      ItemHeight = 13
+      Mask = '*.log;*.synlz;*.txt'
+      TabOrder = 2
+      OnClick = FilesClick
+    end
+  end
+  object FilterMenu: TPopupMenu
+    Left = 320
+    Top = 136
+  end
+  object OpenDialog: TOpenDialog
+    DefaultExt = '.log'
+    Filter = 'Log|*.log;*.txt;*.synlz'
+    Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+    Left = 344
+    Top = 72
+  end
+  object ListMenu: TPopupMenu
+    Left = 816
+    Top = 120
+    object ListMenuCopy: TMenuItem
+      Caption = '&Copy'
+      OnClick = ListMenuCopyClick
+    end
+  end
+  object tmrRefresh: TTimer
+    Enabled = False
+    Interval = 200
+    OnTimer = tmrRefreshTimer
+    Left = 345
+    Top = 336
+  end
+  object dlgSaveList: TSaveDialog
+    DefaultExt = '.log'
+    Filter = 'log|*.log|txt|*.txt|synlz|*.synlz'
+    Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+    Left = 345
+    Top = 200
+  end
+end

contrib/mORMot/SQLite3/Samples/11 - Exception logging/LogViewMain.lfm

@@ -0,0 +1,584 @@
+object MainLogView: TMainLogView
+  Left = 454
+  Height = 639
+  Top = 95
+  Width = 860
+  Caption = ' Synopse LogView  %s -'
+  ClientHeight = 639
+  ClientWidth = 860
+  Color = clBtnFace
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  KeyPreview = True
+  OnCreate = FormCreate
+  OnKeyDown = FormKeyDown
+  OnShow = FormShow
+  LCLVersion = '2.0.8.0'
+  object Splitter2: TSplitter
+    Cursor = crVSplit
+    Left = 0
+    Height = 4
+    Top = 635
+    Width = 860
+    Align = alBottom
+    ResizeAnchor = akBottom
+  end
+  object Splitter3: TSplitter
+    Left = 837
+    Height = 635
+    Top = 0
+    Width = 4
+    Visible = False
+  end
+  object Splitter1: TSplitter
+    Left = 829
+    Height = 635
+    Top = 0
+    Width = 4
+    Visible = False
+  end
+  object Splitter4: TSplitter
+    Left = 833
+    Height = 635
+    Top = 0
+    Width = 4
+    Visible = False
+  end
+  object PanelLeft: TPanel
+    Left = 257
+    Height = 635
+    Top = 0
+    Width = 150
+    Align = alLeft
+    ClientHeight = 635
+    ClientWidth = 150
+    Constraints.MinWidth = 150
+    TabOrder = 0
+    object ImageLogo: TImage
+      Left = 8
+      Height = 32
+      Top = 591
+      Width = 137
+      Anchors = [akLeft, akRight, akBottom]
+      Center = True
+      OnClick = ImageLogoClick
+      Picture.Data = {
+        07544269746D617076090000424D760900000000000076000000280000008900
+        0000200000000100040000000000000900000000000000000000100000000000
+        00000504180004A6FC00444446000704C400918FB000D1D1DF001D26E0005454
+        5600726FA000046EFC00B2B0CD0031323300FCFEFC005A53D1003731CF004446
+        FC00CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCC555A5555CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCC54444CCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCA77778777785CCCCCCCCCCCCC5444ACCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCC533338C
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC58274A555555A877ACCCCCCCCCCCD3333
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+        CCCCCCCCCC63333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA774A472BBBB74AA82
+        4CCCCCCCCCCD3333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+        0000CCCCCCCCCCCCCCCCCCCCCCA3333ACCCCCCCCCCCCCCCCCCCCCCCCCCCCC428
+        4700000000000244775CCCCCCCCD3333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCC3333ECCCCCCCCCCCCCCCC
+        CCCCCCCCCCCC4278B0000000000000078775CCCCCCCD3336CCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCC54E3333EACCCCCCCCC83333
+        CCCCCCCC888D5CCCC488DACCCCC4277000000000000000002727CCCCCCCD3336
+        CD63E4CCCCCCCAF333368CCCCCCCCC5863333FACCCCCC0000000CCCC83333333
+        3334CCCCCCCE3333DCCCCCCC3333ACCCC3333FCCCCA277000000000000000000
+        0B728CCCCCCD333333333365CCC53333333333FCCCCC5E3333333333ACCCC000
+        0000CCCCD333333333334CCCCC5333333CCCCCCC3333ACCCC6333DCCCC748000
+        000033333333000000287ACCCCCD333333333333CCC533333333333ECCC53333
+        33333333ACCCC0000000CCCCD3EACCCC83333CCCCCD3333334CCCCCC3333ACCC
+        C6333DCCC48AB0000033333333333000000847CCCCCD33335AAD3333DCC53345
+        CCCA33335CC333338A5C5463ACCCC0000000CCCC4ACCCCCC43333CCCCC333333
+        36CCCCCC3333ACCCC6333DCCC7AA000003333333333333000002A75CCCCD3336
+        CCCCD33335C58CCCCCC533334CA3333ACCCCCCC85CCCC0000000CCCCCCC5A8E3
+        33333CCCCA3333E3335CCCCC3333ACCCC6333DCC5BA700003333333333333330
+        0000587CCCCD3333CCCC53333ACCCCCA8F333333AC8333FCCCCCCCCCCCCCC000
+        0000CCCCCCD333333333FCCCC63338A333DCCCCC3333ACCCC6333DCC42400000
+        33333333333333330000442CCCCD3333CCCCC33334CCC43333333333CCD3333F
+        EEEEEEE68CCCC0000000CCCCC3333333333DCCCC533335C3333CCCCC3333ACCC
+        C6333DCC227000033333333333333333000028B5CCCD3333CCCCC33338CC8333
+        33333335CCD3333333333333FCCCC0000000CCCC53333333E45CCCCC83336CCE
+        3334CCCC3333ACCCC3333DCCB77000033333333333333333000008B5CCCD3333
+        CCCCC33334CC33333336D5CCCCD3333333333333DCCCC0000000CCCC43333ACC
+        CCCCCCCC33334CCA3333CCCC3333ACCCC3333DCC07B000033333336193333333
+        000007BACCCD3336CCCCA3333ACC33338CCCCCC5CCA333DCCCCC63334CCCC000
+        0000CCCCA3333CCCCC538CCA3333CCCC33335CCC333338AAF33334CC07B00003
+        3333336193333333000007BACCCD3333ACC5333335CC3333ACCCC5D3CCC33335
+        CCCC33335CCCC0000000CCCCC333333633334CC3333ECCCCD3336CCC33333333
+        333335CC077000033333633333333333000007BACCCD333333333333DCCCD333
+        33633333CCCA3333F4D3333FCCCCC0000000CCCCC533333333338C53333ACCCC
+        A3333CCC3333F3333333FCCCB7700B03333F6333336663330000B8B5CCCD3333
+        63333333CCCCCE3333333333CCCC43333333333CCCCCC0000000CCCCCCC46333
+        3368CC4366ECCCCCCE6634CCE6635CD33338CCCC828004003333333333336333
+        00B077BCCCC8366DC83333DCCCCCCCAE333333FACCCCCCD3333338CCCCCCC000
+        0000CCCCCCCCCC555CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC55CCCCCC5B4B0A20
+        DD3333EFF333336B0040872CCCCCCCCCCCC55CCCCCCCCCCCCC55CCCCCCCCCCCC
+        5555CCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCC7440BB00333333333333372088B42ACCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCA4AB00000333EEEEE3330000B0847CCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC4440000000384A48300000
+        007445CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+        0000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC574800
+        000B0000000BB0000244ACCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCC474400085555555554B007487CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCC72A4B0028A5C5A470008A825CCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC77AA8000000000007AA
+        8B5CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+        0000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA7
+        4A5A8BB0BB7455478CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCC5474A55555555487ACCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA44AAAAA4445CCCCCCCCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC555555CCCCC
+        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+        0000
+      }
+      Transparent = True
+    end
+    object lblServerRoot: TLabel
+      Left = 16
+      Height = 12
+      Top = 48
+      Width = 70
+      Caption = 'Server Root:'
+      ParentColor = False
+    end
+    object lblServerPort: TLabel
+      Left = 16
+      Height = 12
+      Top = 90
+      Width = 67
+      Caption = 'Server Port:'
+      ParentColor = False
+    end
+    object BtnBrowse: TButton
+      Left = 16
+      Height = 25
+      Top = 8
+      Width = 107
+      Anchors = [akTop, akRight]
+      Caption = 'Select File'
+      OnClick = BtnBrowseClick
+      TabOrder = 0
+    end
+    object EventsList: TCheckListBox
+      Left = 16
+      Height = 105
+      Top = 72
+      Width = 118
+      ItemHeight = 13
+      OnClickCheck = EventsListClickCheck
+      OnDblClick = EventsListDblClick
+      OnDrawItem = EventsListDrawItem
+      PopupMenu = FilterMenu
+      Style = lbOwnerDrawFixed
+      TabOrder = 3
+      TopIndex = -1
+    end
+    object EditSearch: TEdit
+      Left = 16
+      Height = 30
+      Hint = 'Search (Ctrl+F, F3 for next) '
+      Top = 40
+      Width = 85
+      Anchors = [akTop, akLeft, akRight]
+      OnChange = BtnSearchNextClick
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 1
+    end
+    object BtnSearchNext: TButton
+      Left = 105
+      Height = 21
+      Hint = 'Search Next (F3)'
+      Top = 40
+      Width = 20
+      Anchors = [akTop, akRight]
+      Caption = 'v'
+      OnClick = BtnSearchNextClick
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 2
+    end
+    object BtnStats: TButton
+      Left = 16
+      Height = 25
+      Top = 304
+      Width = 57
+      Caption = 'Stats'
+      OnClick = BtnStatsClick
+      TabOrder = 6
+    end
+    object BtnMapSearch: TButton
+      Left = 80
+      Height = 25
+      Hint = 'Search for an address in a .map file'
+      Top = 304
+      Width = 59
+      Caption = '.map'
+      OnClick = BtnMapSearchClick
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 7
+    end
+    object MergedProfile: TCheckBox
+      Left = 22
+      Height = 23
+      Top = 283
+      Width = 134
+      Caption = 'Merge method calls'
+      OnClick = MergedProfileClick
+      TabOrder = 5
+    end
+    object ProfileGroup: TRadioGroup
+      Left = 16
+      Height = 89
+      Top = 192
+      Width = 118
+      AutoFill = True
+      Caption = ' Methods profiler '
+      ChildSizing.LeftRightSpacing = 6
+      ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+      ChildSizing.EnlargeVertical = crsHomogenousChildResize
+      ChildSizing.ShrinkHorizontal = crsScaleChilds
+      ChildSizing.ShrinkVertical = crsScaleChilds
+      ChildSizing.Layout = cclLeftToRightThenTopToBottom
+      ChildSizing.ControlsPerLine = 1
+      OnClick = ProfileGroupClick
+      TabOrder = 4
+    end
+    object ThreadGroup: TGroupBox
+      Left = 16
+      Height = 96
+      Top = 336
+      Width = 118
+      Caption = ' Threads '
+      ClientHeight = 81
+      ClientWidth = 116
+      TabOrder = 8
+      object BtnThreadNext: TButton
+        Left = 8
+        Height = 25
+        Top = 0
+        Width = 41
+        Caption = 'Next'
+        OnClick = BtnThreadNextClick
+        TabOrder = 0
+      end
+      object BtnThreadShow: TButton
+        Left = 8
+        Height = 25
+        Top = 24
+        Width = 97
+        Caption = 'View threads'
+        OnClick = BtnThreadShowClick
+        TabOrder = 1
+      end
+      object btnThread0: TButton
+        Left = 8
+        Height = 25
+        Hint = 'Select No Thread'
+        Top = 48
+        Width = 25
+        Caption = '0'
+        Enabled = False
+        OnClick = BtnThreadClick
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 2
+      end
+      object btnThread1: TButton
+        Left = 40
+        Height = 25
+        Hint = 'Select Only This Thread'
+        Top = 48
+        Width = 25
+        Caption = '1'
+        Enabled = False
+        OnClick = BtnThreadClick
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 3
+      end
+      object btnThreadAll: TButton
+        Left = 72
+        Height = 25
+        Hint = 'Select All Threads'
+        Top = 48
+        Width = 33
+        Caption = 'All'
+        Enabled = False
+        OnClick = BtnThreadClick
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 4
+      end
+      object btnThreadDown: TButton
+        Left = 56
+        Height = 25
+        Hint = 'Goto Next  Row'
+        Top = 0
+        Width = 25
+        Caption = 'v'
+        OnClick = btnThreadDownClick
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 5
+      end
+      object btnThreadUp: TButton
+        Left = 80
+        Height = 25
+        Hint = 'Goto Previous Row'
+        Top = 0
+        Width = 25
+        Caption = '^'
+        OnClick = btnThreadUpClick
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 6
+      end
+    end
+    object BtnSearchPrevious: TButton
+      Left = 125
+      Height = 21
+      Hint = 'Search Previous (Shift F3)'
+      Top = 40
+      Width = 20
+      Anchors = [akTop, akRight]
+      Caption = '^'
+      OnClick = BtnSearchNextClick
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 9
+    end
+    object btnServerLaunch: TButton
+      Left = 16
+      Height = 25
+      Hint = 'Lauch a HTTP server  for remote logging'
+      Top = 132
+      Width = 107
+      Anchors = [akTop, akRight]
+      Caption = 'Server Launch'
+      OnClick = btnServerLaunchClick
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 10
+    end
+    object edtServerRoot: TEdit
+      Left = 16
+      Height = 30
+      Top = 64
+      Width = 121
+      TabOrder = 11
+      Text = 'LogService'
+    end
+    object edtServerPort: TEdit
+      Left = 16
+      Height = 30
+      Top = 106
+      Width = 121
+      TabOrder = 12
+      Text = '8091'
+    end
+    object btnListClear: TButton
+      Left = 16
+      Height = 25
+      Top = 160
+      Width = 105
+      Caption = 'Clear List'
+      OnClick = btnListClearClick
+      TabOrder = 13
+      Visible = False
+    end
+    object btnListSave: TButton
+      Left = 16
+      Height = 25
+      Top = 192
+      Width = 105
+      Caption = 'Save List'
+      OnClick = btnListSaveClick
+      TabOrder = 14
+      Visible = False
+    end
+    object lstDays: TListBox
+      Left = 16
+      Height = 57
+      Top = 440
+      Width = 121
+      ItemHeight = 0
+      OnDblClick = lstDaysDblClick
+      ScrollWidth = 119
+      TabOrder = 15
+      TopIndex = -1
+    end
+  end
+  object List: TDrawGrid
+    Left = 841
+    Height = 635
+    Top = 0
+    Width = 19
+    Align = alClient
+    ColCount = 3
+    DefaultColWidth = 100
+    DefaultRowHeight = 14
+    ExtendedSelect = False
+    FixedCols = 0
+    FixedRows = 0
+    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goRowSelect, goThumbTracking]
+    PopupMenu = ListMenu
+    RowCount = 1
+    TabOrder = 2
+    TitleFont.Color = clWindowText
+    TitleFont.Height = -11
+    TitleFont.Name = 'Tahoma'
+    Visible = False
+    OnClick = ListClick
+    OnDblClick = ListDblClick
+    OnDrawCell = ListDrawCell
+  end
+  object ProfileList: TDrawGrid
+    Left = 407
+    Height = 635
+    Top = 0
+    Width = 274
+    Align = alLeft
+    ColCount = 2
+    DefaultColWidth = 100
+    DefaultRowHeight = 14
+    ExtendedSelect = False
+    FixedCols = 0
+    FixedRows = 0
+    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect, goThumbTracking]
+    TabOrder = 1
+    TitleFont.Color = clWindowText
+    TitleFont.Height = -11
+    TitleFont.Name = 'Tahoma'
+    Visible = False
+    OnClick = ProfileListClick
+    OnDrawCell = ProfileListDrawCell
+  end
+  object PanelThread: TPanel
+    Left = 681
+    Height = 635
+    Top = 0
+    Width = 148
+    Align = alLeft
+    ClientHeight = 635
+    ClientWidth = 148
+    TabOrder = 3
+    Visible = False
+    object ThreadListBox: TCheckListBox
+      Left = 1
+      Height = 593
+      Top = 1
+      Width = 146
+      Align = alClient
+      ItemHeight = 0
+      OnClick = ThreadListBoxClick
+      OnClickCheck = ThreadListBoxClickCheck
+      OnDblClick = ThreadListBoxDblClick
+      TabOrder = 0
+      TopIndex = -1
+    end
+    object pnlThreadBottom: TPanel
+      Left = 1
+      Height = 40
+      Top = 594
+      Width = 146
+      Align = alBottom
+      ClientHeight = 40
+      ClientWidth = 146
+      TabOrder = 1
+      object lblThreadName: TLabel
+        Left = 3
+        Height = 33
+        Top = 3
+        Width = 141
+        Anchors = [akTop, akLeft, akRight, akBottom]
+        ParentColor = False
+        ParentFont = False
+        WordWrap = True
+      end
+    end
+  end
+  object PanelBrowse: TPanel
+    Left = 0
+    Height = 635
+    Top = 0
+    Width = 257
+    Align = alLeft
+    ClientHeight = 635
+    ClientWidth = 257
+    Constraints.MinWidth = 80
+    TabOrder = 4
+    Visible = False
+    object Directory: TShellTreeView
+      Left = 8
+      Height = 344
+      Top = 8
+      Width = 240
+      FileSortType = fstNone
+      HideSelection = False
+      ReadOnly = True
+      TabOrder = 0
+      Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
+      ObjectTypes = [otFolders]
+      ShellListView = Files
+    end
+    object Files: TShellListView
+      Left = 8
+      Height = 207
+      Top = 368
+      Width = 240
+      Color = clDefault
+      HideSelection = False
+      ReadOnly = True
+      TabOrder = 1
+      OnClick = FilesClick
+      ObjectTypes = [otNonFolders]
+      ShellTreeView = Directory
+    end
+  end
+  object FilterMenu: TPopupMenu
+    Left = 88
+    Top = 16
+  end
+  object OpenDialog: TOpenDialog
+    DefaultExt = '.log'
+    Filter = 'Log|*.log;*.txt;*.synlz'
+    Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+    Left = 40
+    Top = 80
+  end
+  object ListMenu: TPopupMenu
+    Left = 40
+    Top = 16
+    object ListMenuCopy: TMenuItem
+      Caption = '&Copy'
+      OnClick = ListMenuCopyClick
+    end
+  end
+  object tmrRefresh: TTimer
+    Enabled = False
+    Interval = 200
+    OnTimer = tmrRefreshTimer
+    Left = 88
+    Top = 80
+  end
+  object dlgSaveList: TSaveDialog
+    DefaultExt = '.log'
+    Filter = 'log|*.log|txt|*.txt|synlz|*.synlz'
+    Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+    Left = 136
+    Top = 16
+  end
+end

contrib/mORMot/SQLite3/Samples/11 - Exception logging/LoggingTest.dpr

@@ -0,0 +1,251 @@
+{
+  Synopse mORMot framework
+
+  Sample 11 - Exception logging
+    purpose of this sample is to show basic logging mechanism of the framework
+
+  TO HAVE LINE NUMBERS IN THE LOG FILE:
+  - Go to Project/Options then set the Linker/File map setting to "Detailed"
+
+  Version 1.0 - April 14, 2011
+    - Initial Release
+
+  Version 1.18
+    - Kylix support
+
+}
+program LoggingTest;
+
+{$AppType console}
+
+{$I Synopse.inc} // all expected conditionals
+
+{$ifndef DELPHI5OROLDER} // mORMot.pas doesn't compile under Delphi 5
+  {$define WITHMORMOT}
+{$endif}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  {$ifdef MSWINDOWS}
+  Windows,
+  ComObj,
+  {$endif}
+  SysUtils,
+  {$ifdef WITHMORMOT}
+  mORMot,
+  {$endif}
+  SynCommons,
+  SynLog;
+
+type
+  /// a class just to show how methods are handled
+  TTestLogClass = class
+  protected
+    procedure TestLog;
+  end;
+
+  /// a custom exception used to show how Delphi exception are handled and
+  // can be ignored on request
+  ECustomException = class(Exception);
+
+{$ifdef WITHMORMOT}
+  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;
+{$else}
+  // mORMot.pas doesn't compile under Delphi 5 (yet)
+  TSQLLog = TSynLog;
+{$endif}
+
+var
+  TestLevel: TSynLogInfo = high(TSynLogInfo);
+
+procedure TTestLogClass.TestLog;
+var ILog: ISynLog;
+    S: TSynLogInfos;
+begin
+  ILog := TSQLLog.Enter(self);
+  // do some stuff
+  ILog.Log(sllCustom1);
+  ILog.Log(sllInfo,'TestLevel',TypeInfo(TSynLogInfo),TestLevel,nil);
+  ILog.Log(sllInfo,'set',TypeInfo(TSynLogInfos),S,nil);
+  ILog.Log(sllDebug,ILog.Instance);
+  ILog.Log(sllExceptionOS, 'Some error with stacktrace from %', [ExeVersion.ProgramName], self);
+  if TestLevel=low(TestLevel) then
+    TTestLogClass(nil).ClassName; // will raise an access violation
+  dec(TestLevel);
+  TestLog;
+end;
+
+procedure TestLogProc;
+var ILog: ISynLog;
+begin
+  ILog := TSQLLog.Enter;
+  ILog.Log(sllDebug,'GarbageCollector',GarbageCollector);
+  ILog.Log(sllDebug,GarbageCollector);
+end;
+
+
+procedure TestsLog;
+
+{$ifdef WITHMORMOT}
+  procedure TestPeopleProc;
+  var People: TSQLRecordPeople;
+      Log: ISynLog;
+  begin
+    Log := TSQLLog.Enter;
+    People := TSQLRecordPeople.Create;
+    try
+      People.IDValue := 16;
+      People.FirstName := 'Louis';
+      People.LastName := 'Croivebaton';
+      People.YearOfBirth := 1754;
+      People.YearOfDeath := 1793;
+      Log.Log(sllInfo,People);
+    finally
+      People.Free;
+    end;
+  end;
+{$endif}
+
+  procedure Proc2(n1, n2: Integer); forward; // test nested
+
+  procedure Proc1(n1, n2: Integer);
+  begin
+    if n1 = 0 then
+    try
+      TTestLogClass(nil).ClassName; // will raise an access violation
+    except
+      on E: Exception do
+        TSQLLog.Add.Log(sllInfo,'^^^^^^^^ recursion test Proc1',e);
+    end else
+    Proc2(n1 - 1, n2);
+  end;
+
+  procedure Proc2(n1, n2: Integer);
+  begin
+    if n2 = 0 then
+      try
+        TTestLogClass(nil).ClassName; // will raise an access violation
+      except
+        on E: Exception do
+          TSQLLog.Add.Log(sllInfo,'^^^^^^^^ recursion test Proc2',e);
+      end else
+      Proc1(n1, n2 - 1);
+  end;
+
+var i: integer;
+    f: system.TextFile;
+    info: TSynLogExceptionInfoDynArray;
+begin
+  i := 1; // we need this to circumvent the FPC compiler :)
+  // first, set the TSQLLog family parameters
+  with TSQLLog.Family do begin
+    Level := LOG_VERBOSE;
+    //Level := [sllException,sllExceptionOS];
+    //PerThreadLog := true;
+    //HighResolutionTimeStamp := true;
+    //AutoFlushTimeOut := 5;
+    OnArchive := EventArchiveSynLZ;
+    //OnArchive := EventArchiveZip;
+    ArchiveAfterDays := 1; // archive after one day
+  end;
+  TSQLLog.Add.Log(sllInfo,'Starting');
+  writeln(' try some low-level common exceptions');
+  try
+    dec(i);
+    if 10 div i=0 then; // will raise EDivByZero
+  except
+    on E: exception do
+      TSQLLog.Add.Log(sllStackTrace,'^^^^^^^^ the first sample, divide by 0',E);
+  end;
+  try
+    closefile(f);
+    readln(f); // will raise EIOError (no console is available to read from)
+  except
+    on E: exception do
+      TSQLLog.Add.Log(sllStackTrace,'^^^^^^^^ the next sample, I/O error',E);
+  end;
+  writeln(' try EAccessViolation in nested procedure calls (see stack trace)');
+  Proc1(5,7);
+  Proc2(7,5);
+  writeln(' try a method recursive call, with an EAccessViolation raised within');
+  with TTestLogClass.Create do
+  try
+    try
+      TestLog;
+    except
+      on Exception do; // just ignore now
+    end;
+  finally
+    Free;
+  end;
+  writeln(' try a procedure call with Enter/Auto-Leave');
+  TestLogProc;
+  {$ifdef WITHMORMOT}
+  writeln(' try a procedure call with Enter/Auto-Leave and a TSQLRecordPeople logging');
+  TestPeopleProc;
+  {$endif}
+  writeln(' try a custom Delphi exception');
+  try
+    raise ECustomException.Create('Test exception'); // logged to TSQLLog
+  except
+    on E: Exception do
+      TSQLLog.Add.Log(sllInfo,'^^^^^^^^  custom exception type',E);
+  end;
+  writeln(' try a custom Delphi exception after been marked as to be ignored');
+  TSQLLog.Family.ExceptionIgnore.Add(ECustomException);
+  try
+    raise ECustomException.Create('Test exception');
+  except
+    on E: Exception do
+      TSQLLog.Add.Log(sllInfo,'^^^^^^^^  nothing should be logged just above',E);
+  end;
+  writeln(' try an Exception with message='' - see ticket [388c2768b6]');
+  try
+    raise Exception.Create('');
+  except
+    on E: Exception do
+      TSQLLog.Add.Log(sllInfo,'^^^^^^^^  Exception.Message=""',E);
+  end;
+  writeln(' try an ESynException');
+  try
+    raise ESynException.CreateUTF8('testing %.CreateUTF8',[ESynException]);
+  except
+    on E: ESynException do begin
+      TSQLLog.Add.Log(sllInfo,'^^^^^^^^  ESynException',E);
+      {$ifdef WITHMORMOT}
+      TSQLLog.Add.Log(sllDebug,'ObjectToJSONDebug(E) = %',[ObjectToJSONDebug(E)],E);
+      {$endif}
+      TSQLLog.Add.Log(sllDebug,'FindLocation(E) = %',[TSynMapFile.FindLocation(E)],E);
+    end;
+  end;
+  {$ifdef MSWINDOWS}
+  writeln(' try a EOleSysError, as if it was triggered from the .Net CLR');
+  try
+    raise EOleSysError.Create('Test',HRESULT($80004003),0);
+  except
+    on E: Exception do
+      TSQLLog.Add.Log(sllInfo,'^^^^^^^^  should be recognized as NullReferenceException',E);
+  end;
+  {$endif}
+  writeln('GetLastExceptions = ');
+  GetLastExceptions(info);
+  for i := 0 to high(info) do
+    writeln(ToText(info[i]));
+end;
+
+begin
+  TestsLog;
+  writeln('------ finished');
+end.
+

contrib/mORMot/SQLite3/Samples/11 - Exception logging/Map2Mab.dpr

@@ -0,0 +1,66 @@
+/// sample program to create .mab files from existing .map files
+// - if some .map file name is specified (you can use wild chars), will
+// process all those .map files, then create the corresponding .mab files
+// - if some .exe/.dll file name is specified (you can use wild chars), will
+// process all matching .exe/.dll files with an associated .map file, and will
+// create the .mab files, then embedd the .mab content to the .exe/.dll
+// - if no file name is specified, will process '*.map' into '*.mab'
+// - you can make map2mapb.exe file small if you define LVCL as conditional in
+// the Project options and set the ..\lib\LVCL directories as expected
+program Map2Mab;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  SynCommons,
+  SynLog;
+
+procedure Process(const FileName: TFileName);
+var SR: TSearchRec;
+    Path, FN: TFileName;
+    Ext: integer;
+    AllOk: boolean;
+begin
+  AllOk := True;
+  Ext := GetFileNameExtIndex(FileName,'map,exe,dll,ocx,bpl');
+  if (Ext>=0) and (FindFirst(FileName,faAnyFile,SR)=0) then
+  try
+    Path := ExtractFilePath(FileName);
+    repeat
+      FN := Path+SR.Name;
+      if (SR.Name[1]<>'.') and (faDirectory and SR.Attr=0) then
+      try
+        with TSynMapFile.Create(FN,true) do // true = .map -> .mab
+        try
+          if not HasDebugInfo then begin
+            WriteLn('Error: no Debug Info found on ',FN);
+            AllOk := False;            
+          end else if (Ext>0) then // has debug info and is not a map
+            SaveToExe(FN);
+        finally
+          Free;
+        end;
+      except
+        on E: Exception do begin // ignore any problem here: just print it and process next file
+          WriteLn('Error: ', E.ClassName,' ',E.Message);
+          AllOk := False;
+        end;
+      end;
+    until FindNext(SR)<>0;
+  finally
+    FindClose(SR);
+  end else begin
+    WriteLn('Error: cant find any file to process matching: ', FileName);
+    ExitCode := 2;
+  end;
+  if not AllOk then
+    ExitCode := 1;
+end;
+
+begin
+  if paramCount>0 then
+    Process(paramstr(1)) else
+    Process('*.map');
+end.

contrib/mORMot/SQLite3/Samples/11 - Exception logging/MyLibrary.dpr

@@ -0,0 +1,25 @@
+/// library sample code, which makes use of the logging feature
+library MyLibrary;
+
+{
+  In the Project / Options / Linker tab, the Map files option should be set
+  to detailed, in order to demonstrate how libraries can have their own
+  symbols file (we need a .map to have this information and create its .mab)
+
+}
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SynCommons,
+  SynLog;
+
+{$R *.res}
+
+procedure Test;
+begin
+   TSynLog.Family.Level := LOG_VERBOSE;
+   TSynLog.Enter.Log(sllDebug, 'Called from Test exported procedure');
+end;
+
+exports Test;
+
+end.

contrib/mORMot/SQLite3/Samples/11 - Exception logging/RemoteLogMain.dfm

@@ -0,0 +1,131 @@
+object MainForm: TMainForm
+  Left = 229
+  Top = 236
+  BorderStyle = bsDialog
+  Caption = ' Remote logger'
+  ClientHeight = 285
+  ClientWidth = 346
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  PixelsPerInch = 96
+  TextHeight = 13
+  object grpEvent: TGroupBox
+    Left = 8
+    Top = 136
+    Width = 313
+    Height = 129
+    Caption = ' Single Event  '
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -11
+    Font.Name = 'Tahoma'
+    Font.Style = []
+    ParentFont = False
+    TabOrder = 0
+    Visible = False
+    object cbbEvent: TComboBox
+      Left = 16
+      Top = 24
+      Width = 145
+      Height = 21
+      Style = csDropDownList
+      DropDownCount = 50
+      ItemHeight = 13
+      TabOrder = 0
+    end
+    object edtText: TEdit
+      Left = 16
+      Top = 56
+      Width = 281
+      Height = 21
+      TabOrder = 1
+      Text = 'Message'
+    end
+    object btnEventSend: TButton
+      Left = 16
+      Top = 88
+      Width = 75
+      Height = 25
+      Caption = 'Send'
+      TabOrder = 2
+      OnClick = btnEventSendClick
+    end
+    object btnDisconnect: TButton
+      Left = 222
+      Top = 88
+      Width = 75
+      Height = 25
+      Caption = 'Disconnect'
+      TabOrder = 3
+      OnClick = btnDisconnectClick
+    end
+  end
+  object grpConnection: TGroupBox
+    Left = 8
+    Top = 16
+    Width = 321
+    Height = 105
+    Caption = ' Connection To the LogView Server'
+    TabOrder = 1
+    object lblServer: TLabel
+      Left = 8
+      Top = 27
+      Width = 78
+      Height = 13
+      Alignment = taRightJustify
+      Caption = 'Server Address:'
+    end
+    object lblPort: TLabel
+      Left = 27
+      Top = 51
+      Width = 59
+      Height = 13
+      Alignment = taRightJustify
+      Caption = 'Server Port:'
+    end
+    object lblInfoConnect: TLabel
+      Left = 16
+      Top = 80
+      Width = 269
+      Height = 13
+      Caption = 'Please ensure that the LogView tool is running as server'
+      Font.Charset = DEFAULT_CHARSET
+      Font.Color = clWindowText
+      Font.Height = -11
+      Font.Name = 'Tahoma'
+      Font.Style = [fsItalic]
+      ParentFont = False
+    end
+    object edtServer: TEdit
+      Left = 88
+      Top = 24
+      Width = 121
+      Height = 21
+      TabOrder = 1
+      Text = '127.0.0.1'
+    end
+    object edtPort: TEdit
+      Left = 88
+      Top = 48
+      Width = 121
+      Height = 21
+      TabOrder = 2
+      Text = '8091'
+    end
+    object btnConnect: TButton
+      Left = 222
+      Top = 40
+      Width = 75
+      Height = 33
+      Caption = 'Connect'
+      TabOrder = 0
+      OnClick = btnConnectClick
+    end
+  end
+end

contrib/mORMot/SQLite3/Samples/11 - Exception logging/RemoteLogMain.pas

@@ -0,0 +1,88 @@
+unit RemoteLogMain;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, SynCommons, SynLog, mORMot, mORMotHttpClient;
+
+type
+  TMainForm = class(TForm)
+    grpEvent: TGroupBox;
+    cbbEvent: TComboBox;
+    edtText: TEdit;
+    btnEventSend: TButton;
+    grpConnection: TGroupBox;
+    edtServer: TEdit;
+    lblServer: TLabel;
+    lblPort: TLabel;
+    edtPort: TEdit;
+    lblInfoConnect: TLabel;
+    btnConnect: TButton;
+    btnDisconnect: TButton;
+    procedure btnConnectClick(Sender: TObject);
+    procedure btnEventSendClick(Sender: TObject);
+    procedure btnDisconnectClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    fNumber: integer;
+  public
+    { Public declarations }
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
+
+{$R *.dfm}
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+  PTypeInfo(TypeInfo(TSynLogInfo))^.EnumBaseType^.AddCaptionStrings(cbbEvent.Items);
+  SQLite3Log.Family.Level := LOG_VERBOSE;
+end;
+
+procedure TMainForm.btnConnectClick(Sender: TObject);
+begin
+  try
+    Screen.Cursor := crHourGlass;
+    try
+      TSQLHttpClient.CreateForRemoteLogging(
+        AnsiString(edtServer.Text),SQLite3Log,StrToInt(edtPort.Text));
+    finally
+      Screen.Cursor := crDefault;
+    end;
+  except
+    on E: Exception do begin
+      MessageDlg(E.Message,mtError,[mbOk],0);
+      exit;
+    end;
+  end;
+  grpConnection.Enabled := false;
+  btnConnect.Enabled := false;
+  cbbEvent.ItemIndex := Ord(sllInfo);
+  grpEvent.Show;
+  btnEventSend.SetFocus;
+end;
+
+procedure TMainForm.btnEventSendClick(Sender: TObject);
+begin
+  SQLite3Log.Add.Log(TSynLogInfo(cbbEvent.ItemIndex),
+    FormatUTF8('% - %',[edtText.Text,fNumber]));
+  inc(fNumber);
+end;
+
+procedure TMainForm.btnDisconnectClick(Sender: TObject);
+begin
+  SQLite3Log.Family.EchoRemoteStop;
+  grpConnection.Enabled := true;
+  btnConnect.Enabled := true;
+  cbbEvent.ItemIndex := Ord(sllInfo);
+  grpEvent.Hide;
+  btnConnect.SetFocus;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/11 - Exception logging/RemoteLoggingTest.dpr

@@ -0,0 +1,14 @@
+program RemoteLoggingTest;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  RemoteLogMain in 'RemoteLogMain.pas' {MainForm};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TMainForm, MainForm);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/11 - Exception logging/UnSynLz.dpr

@@ -0,0 +1,45 @@
+/// sample program able to uncompres .log.synlz archived files into visualizable
+// .log files as created by TSynLog
+// - if some .synlz file name or wildchar pattern is specified as command line
+// parameter, it will process all matching files
+// - if no file name nor pattern is specified in the command line, will search
+// for '*.synlz' in the current folder
+// - uncompression will be stored in the same directory as the original .synlz
+// - you can make unsynlz.exe file small if you define LVCL as conditional in
+// the Project options and set the ..\lib\LVCL directories as expected
+program UnSynLz;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  SynCommons,
+  SynLog;
+
+procedure Process(const FileName: TFileName);
+var SR: TSearchRec;
+    Path: TFileName;
+begin
+  if (GetFileNameExtIndex(FileName,'synlz')=0) and
+     (FindFirst(FileName,faAnyFile,SR)=0) then
+  try
+    Path := ExtractFilePath(FileName);
+    repeat
+      if (SR.Name[1]='.') or (faDirectory and SR.Attr<>0) then
+        Continue;
+      write(SR.Name);
+      if FileUnSynLZ(Path+SR.Name,Path+copy(SR.Name,1,length(SR.Name)-6),LOG_MAGIC) then
+        writeln(' OK') else
+        writeln(' Error');
+    until FindNext(SR)<>0;
+  finally
+    FindClose(SR);
+  end;
+end;
+
+begin
+  if paramCount>0 then
+    Process(paramstr(1)) else
+    Process('*.synlz');
+end.

contrib/mORMot/SQLite3/Samples/11 - Exception logging/thread512.dpr

@@ -0,0 +1,70 @@
+// test logging when 6000 threads are created (per chunks of 20)
+program thread512;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$ifdef MSWINDOWS}
+  Windows,
+  {$endif}
+  SynCommons,
+  SynLog,
+  mORMot,
+  Classes,
+  SysUtils;
+
+type
+  TMyThread = class(TThread)
+  protected
+    procedure Execute; override;
+  end;
+
+var
+  n: integer;
+
+procedure SubProc;
+begin
+  InterlockedIncrement(n);
+  TSynLog.Enter(nil,'SubProc').Log(sllDebug,'Thread #% (%)',[n,pointer(GetCurrentThreadID)]);
+  sleep(0);
+end;
+
+procedure TMyThread.Execute;
+var n: TThreadID;
+    log: TSynLog;
+begin
+  n := GetCurrentThreadId;
+  log := TSynLog.Add;
+  log.Log(sllTrace,'Entering thread %',[pointer(n)]);
+  SubProc;
+  log.Log(sllTrace,'Leaving thread %',[pointer(n)]);
+  log.NotifyThreadEnded;
+end;
+
+procedure Test;
+var i,j: Integer;
+    t: array[1..20] of TMyThread;
+begin
+  TSynLog.Enter;
+  for i := 1 to 300 do begin
+    for j := Low(t) to high(t) do
+      t[j] := TMyThread.Create(false);
+    for j := high(t) downto low(t) do
+      t[j].WaitFor;
+    for j := Low(t) to high(t) do
+      t[j].Free;
+  end;
+end;
+
+var Timer: TPrecisionTimer;
+begin
+  TSynLog.Family.Level := LOG_VERBOSE;
+  TSynLog.Family.PerThreadLog := ptIdentifiedInOnFile;
+  TSynLog.Family.EchoToConsole := LOG_STACKTRACE;
+  Timer.Start;
+  Test;
+  writeln(n,' threads created in ',Timer.Stop);
+  {$ifdef MSWINDOWS}
+  readln;
+  {$endif}
+end.

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/DBSynLZ.dpr

@@ -0,0 +1,81 @@
+/// command-line tool for compressing/uncompressing .dbsynlz files
+program DBSynLZ;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SynCommons,
+  SysUtils;
+
+{$R SynDBExplorer.res}
+
+const
+  /// the "magic" number used to identify .dbsynlz compressed files, as
+  // created by TSQLDataBase.BackupSynLZ() or if SynLZCompress parameter is TRUE
+  // for the TSQLDataBase.BackupBackground() method
+  // - note that the SynDBExplorer tool is able to recognize such files, and
+  // open them directly - or use this DBSynLZ.dpr command-line sample tool
+  SQLITE3_MAGIC = $ABA5A5AB;
+
+function IsSQLite3File(const FileName: TFileName): boolean;
+var F: integer;
+    Header: array[0..15] of AnsiChar;
+begin
+  F := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
+  if F<0 then
+    result := false else begin
+    result := (FileRead(F,Header,sizeof(Header))=SizeOf(Header)) and
+      (Header='SQLite format 3');
+    FileClose(F);
+  end;
+end;
+
+procedure Process(const FN: TFileName);
+var f, dest: TFileName;
+    timer: TPrecisionTimer;
+begin
+  timer.Start;
+  f := ExtractFileName(FN);
+  if ParamCount = 2 then
+    dest := ParamStr(2);
+  if FileIsSynLZ(FN, SQLITE3_MAGIC) then begin
+    if dest = '' then
+      dest := ChangeFileExt(FN, '.db');
+    write('Decompressing ', f, #13#10' into ', ExtractFileName(dest), '...');
+    if FileExists(dest) then
+      writeln(' FAILED: already existing')
+    else if FileUnSynLZ(FN, dest, SQLITE3_MAGIC) then
+      writeln(' OK in ', timer.Stop)
+    else
+      writeln(' FAILED');
+  end else
+  if IsSQlite3File(FN) then begin
+    if dest = '' then
+      dest := ChangeFileExt(FN, '.dbsynlz');
+    write('Compressing ', f, #13#10' into ', ExtractFileName(dest), '...');
+    if FileExists(dest) then
+      writeln(' FAILED: already existing')
+    else if FileSynLZ(FN, dest, SQLITE3_MAGIC) then
+      writeln(' OK in ', timer.Stop)
+    else
+      writeln(' FAILED');
+  end else
+    writeln(f, ' is not a Sqlite3 compressed/uncompressed file');
+end;
+
+begin
+  if ParamCount < 1 then  begin
+    TextColor(ccLightGreen);
+    writeln(#13#10' SQLite3 database files compression/decompression tool via SynLZ');
+    writeln(StringOfChar('-',65));
+    TextColor(ccGreen);
+    writeln('  Using SynLZ compression from Synopse mORMot ', SYNOPSE_FRAMEWORK_VERSION);
+    TextColor(ccLightGray);
+    writeln(#13#10'  DBSynLZ filename.dbsynlz [outfilename.db]'#13#10 +
+      'or'#13#10'  DBSynLZ filename.db [outfilename.dbsynlz]');
+  end
+  else
+    Process(ParamStr(1));
+end.
+ 

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorer.dpr

@@ -0,0 +1,65 @@
+program SynDBExplorer;
+
+(*
+
+  Synopse mORMot framework
+
+  Sample 12 - SynDB explorer
+    purpose of this sample is to show SynDB classes at work
+    resulting speed is quite amazing, and available features make it useful
+
+  Version 1.15 - July 12, 2011
+  - Initial Release, handling OleDB, Oracle/OCI, and SQLite3 databases
+
+  Version 1.16
+  - SynDbExplorer now executes selected text statement (very convenient)
+  - will try to reconnect to the server in case of error triggerred
+  - added advanced Query Builder
+  - now accepts a SQLite3 database file as command line parameter
+  - fix error ORA-00932 at OCI client level
+  - added UTF-8 BOM to CSV or TXT exports
+  - now direct-to-file fast export feature (into CSV, TXT, SQLite3,
+    Synopse BigTable records or two JSON flavors)
+  - now multi tables direct export into SQLite3 DB files (e.g. for support)
+  - SQLite3 3.7.12.1 including (beta) private encryption methods
+
+  Version 1.17
+  - added Jet / MSAccess direct support (via OleDB provider)
+  - now accepts a Jet / MSAccess database file as command line parameter
+  - added ODBC providers direct support
+  - added log history of SQL requests (in SynDBExplorer.history file)
+  - SQLite3 engine updated to revision 3.7.13
+  - changed .config file format from binary to JSON (with Base64+Zip if needed)
+
+  Version 1.18
+  - SQlite3 engine updated to revision 3.21.0
+  - optimized grid content initialization speed and layout
+  - will now initialize the REGEXP function for SQLite3 (for Delphi XE+)
+  - added incremental text search in SQL history
+  - added "Exec to Tab" button (accessible with Shift+F9 shortcut)
+
+  first line of uses clause below must be {$I SynDprUses.inc} to enable FastMM4
+  conditional define should contain INCLUDE_FTS3 to handle FTS3/FTS4 in SQLite3 
+*)
+
+uses
+  {$I SynDprUses.inc}
+  Forms,
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  SynDBExplorerMain in 'SynDBExplorerMain.pas' {DbExplorerMain},
+  SynDBExplorerClasses in 'SynDBExplorerClasses.pas',
+  SynDBExplorerFrame in 'SynDBExplorerFrame.pas' {DBExplorerFrame: TFrame},
+  SynDBExplorerQueryBuilder in 'SynDBExplorerQueryBuilder.pas' {DBQueryBuilderForm},
+  SynDBExplorerExportTables in 'SynDBExplorerExportTables.pas' {DBExportTablesForm},
+  SynDBExplorerServer in 'SynDBExplorerServer.pas' {HTTPServerForm};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TDbExplorerMain, DbExplorerMain);
+  Application.CreateForm(THTTPServerForm, HTTPServerForm);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerClasses.pas

@@ -0,0 +1,43 @@
+unit SynDBExplorerClasses;
+
+interface
+
+uses
+  SysUtils, Classes,
+  SynCommons, mORMot;
+
+type
+  TExpConnectionType = (
+    ctOracleDirectOCI,
+    ctOracleOLEDB, ctOracleMSOLEDB, ctMSSQL, ctGenericOLEDB,
+    ctSqlite3,
+    ctJet_mdbOLEDB,
+    ctODBC,ctRemoteHTTP,ctZEOS);
+
+  TSQLConnection = class(TSQLRecord)
+  private
+    fUserName: RawUTF8;
+    fIdent: RawUTF8;
+    fPassword: RawUTF8;
+    fServer: RawUTF8;
+    fDataBase: RawUTF8;
+    fConnection: TExpConnectionType;
+    fForeignKeys: TSQLRawBlob;
+  public
+    fTableNames: TRawUTF8DynArray;
+  published
+    property Ident: RawUTF8 read fIdent write fIdent;
+    property Connection: TExpConnectionType read fConnection write fConnection;
+    property Server: RawUTF8 read fServer write fServer;
+    property Database: RawUTF8 read fDataBase write fDataBase;
+    property UserName: RawUTF8 read fUserName write fUserName;
+    property Password: RawUTF8 read fPassword write fPassword;
+    property TableNames: TRawUTF8DynArray read fTableNames write fTableNames;
+    property ForeignKeys: TSQLRawBlob read fForeignKeys write fForeignKeys;
+  end;
+
+implementation
+
+
+
+end.

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerExportTables.dfm

@@ -0,0 +1,82 @@
+object DBExportTablesForm: TDBExportTablesForm
+  Left = 387
+  Top = 248
+  BorderStyle = bsDialog
+  Caption = ' SynDB Explorer - Export Tables'
+  ClientHeight = 471
+  ClientWidth = 393
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  DesignSize = (
+    393
+    471)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object BtnExport: TButton
+    Left = 24
+    Top = 430
+    Width = 75
+    Height = 25
+    Anchors = [akLeft, akBottom]
+    Caption = 'Export'
+    ModalResult = 1
+    TabOrder = 0
+  end
+  object BtnCancel: TButton
+    Left = 128
+    Top = 430
+    Width = 75
+    Height = 25
+    Anchors = [akLeft, akBottom]
+    Cancel = True
+    Caption = 'Cancel'
+    ModalResult = 2
+    TabOrder = 1
+  end
+  object GroupWhere: TGroupBox
+    Left = 16
+    Top = 8
+    Width = 360
+    Height = 345
+    Anchors = [akLeft, akTop, akRight]
+    Caption = ' Per-table additional WHERE clause for export '
+    TabOrder = 2
+  end
+  object ChkUseStandardCollations: TCheckBox
+    Left = 24
+    Top = 379
+    Width = 361
+    Height = 17
+    Anchors = [akLeft, akBottom]
+    Caption = 
+      'Use standard SQLite3 format (collations not optimized for mORMot' +
+      ')'
+    TabOrder = 3
+  end
+  object ChkNoBlobExport: TCheckBox
+    Left = 24
+    Top = 362
+    Width = 361
+    Height = 17
+    Anchors = [akLeft, akBottom]
+    Caption = 'Do not export BLOB content (save space and time)'
+    Checked = True
+    State = cbChecked
+    TabOrder = 4
+  end
+  object ChkZipDBFile: TCheckBox
+    Left = 24
+    Top = 397
+    Width = 361
+    Height = 17
+    Anchors = [akLeft, akBottom]
+    Caption = 'Compress resulting SQLite3 DB file into .zip archive'
+    TabOrder = 5
+  end
+end

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerExportTables.pas

@@ -0,0 +1,180 @@
+unit SynDBExplorerExportTables;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, CheckLst, Controls, StdCtrls, Classes, Graphics,
+  Forms, ExtCtrls, mORMotUILogin,
+  SynZip, SynCommons, SynDB, SynTable, SynDBSQLite3;
+
+type
+  TDBExportTablesForm = class(TForm)
+    BtnExport: TButton;
+    BtnCancel: TButton;
+    GroupWhere: TGroupBox;
+    ChkUseStandardCollations: TCheckBox;
+    ChkNoBlobExport: TCheckBox;
+    ChkZipDBFile: TCheckBox;
+  protected
+    fProps: TSQLDBConnectionProperties;
+    fEdits: array of TLabeledEdit;
+    procedure SetTableNames(const Value: TStrings);
+  public
+    class function ExportTables(aTableNames: TStrings; aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer; overload;
+    class function ExportTables(aListBox: TListBox; aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer; overload;
+    property Props: TSQLDBConnectionProperties read fProps write fProps;
+  end;
+
+var
+  DBExportTablesForm: TDBExportTablesForm;
+
+implementation
+
+{$R *.dfm}
+
+resourcestring
+  sTableExportWhereHint = 'e.g. "ID>1000" or "RowNum<=500"';
+
+  
+{ TDBExportTablesForm }
+
+class function TDBExportTablesForm.ExportTables(aTableNames: TStrings;
+  aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer;
+var DB: TSQLDBSQLite3ConnectionProperties;
+    Conn: TSQLDBSQLite3Connection;
+    Rows: TSQLDBStatement;
+    Table,SQL: RawUTF8;
+    Fields: TSQLDBColumnDefineDynArray;
+    ExcludeTypes: TSQLDBFieldTypes;
+    ZipFileName: TFileName;
+    Tmp: TForm;
+    TmpPanel: TPanel;
+    i: integer;
+begin
+  result := 0;
+  if aDestFileName<>'' then
+  with TDBExportTablesForm.Create(Application) do
+  try
+    SetTableNames(aTableNames);
+    ActiveControl := BtnExport;
+    if ShowModal<>mrOk then
+      exit;
+    if ChkNoBlobExport.Checked then
+      ExcludeTypes := [ftBlob] else
+      ExcludeTypes := [];
+    DeleteFile(aDestFileName);
+    Tmp := CreateTempForm(BtnExport.Caption,@TmpPanel,true);
+    try
+      DB := TSQLDBSQLite3ConnectionProperties.Create(StringToUTF8(aDestFileName),'','','');
+      try
+        DB.UseMormotCollations := not ChkUseStandardCollations.Checked;
+        Conn := DB.MainConnection as TSQLDBSQLite3Connection;
+        Conn.Connect;
+        try
+          Conn.DB.ExecuteAll('PRAGMA journal_mode=MEMORY;PRAGMA journal_size_limit=16777216;'+
+            'PRAGMA synchronous=OFF;');
+          // Conn.DB.SetWALMode(true); // slower in WAL mode for huge data :(
+          assert(aTableNames.Count=length(fEdits));
+          for i := 0 to aTableNames.Count-1 do begin
+            TmpPanel.Caption := aTableNames[i];
+            Application.ProcessMessages;
+            Table := StringToUTF8(aTableNames[i]);
+            aProps.GetFields(Table,Fields);
+            SQL := Trim(StringToUTF8(fEdits[i].Text));
+            if SQL<>'' then
+              SQL := ' where '+SQL;
+            SQL := aProps.SQLSelectAll(Table,Fields,ExcludeTypes)+SQL;
+            Rows := aProps.NewThreadSafeStatement;
+            try
+              Rows.Execute(SQL,true);
+              Table := StringReplaceAll(Table,[' ','' ,'-','']);
+              inc(result,Conn.NewTableFromRows(Table,Rows,true));
+            finally
+              Rows.Free;
+            end;
+          end;
+        except
+          on E: Exception do
+            ShowMessage(E.Message,true);
+        end;
+      finally
+        DB.Free;
+      end;
+      if ChkZipDBFile.Checked then begin
+        ZipFileName := ChangeFileExt(aDestFileName,'.zip');
+        TmpPanel.Caption := ExtractFileName(ZipFileName);
+        Application.ProcessMessages;
+        with TZipWrite.Create(ZipFileName) do
+        try
+          AddDeflated(aDestFileName,true);
+        finally
+          Free;
+        end;
+        DeleteFile(aDestFileName);
+      end;
+    finally
+      Screen.Cursor := crDefault;
+      Tmp.Free;
+    end;
+  finally
+    Free;
+  end;
+end;
+
+class function TDBExportTablesForm.ExportTables(aListBox: TListBox;
+  aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer;
+var T: TStringList;
+    i: integer;
+begin
+  result := 0;
+  if (aListBox=nil) or (aListBox.SelCount=0) then
+    exit;
+  T := TStringList.Create;
+  try
+    for i := 0 to aListBox.Count-1 do
+      if aListBox.Selected[i] then
+        T.Add(aListBox.Items[i]);
+    result := ExportTables(T,aProps,aDestFileName);
+  finally
+    T.Free;
+  end;
+end;
+
+procedure TDBExportTablesForm.SetTableNames(const Value: TStrings);
+var E: TLabeledEdit;
+    max,x,y,n,i,h: integer;
+begin
+  if Value=nil then
+    n := 0 else
+    n := Value.Count;
+  SetLength(fEdits,n);
+  max := Screen.Height;
+  if n*32+132>max then
+    h := 24 else
+    h := 32;
+  x := 160;
+  n := n*h+24;
+  if n+148>max then
+    n := max-164;
+  GroupWhere.Height := n;
+  ClientHeight := n+132;
+  y := 24;
+  for i := 0 to high(fEdits) do begin
+    E := TLabeledEdit.Create(self);
+    E.Parent := GroupWhere;
+    E.LabelPosition := lpLeft;
+    E.SetBounds(x,y,180,22);
+    E.EditLabel.Caption := Value[i];
+    E.ShowHint := true;
+    E.Hint := sTableExportWhereHint;
+    inc(y,h);
+    if (h=24) and (y>=n-24) and (i<>high(fEdits)) then
+    if x<>160 then break else begin
+      y := 24;
+      inc(x,340);
+      Width := 740;
+    end;
+  end;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerFrame.dfm

@@ -0,0 +1,326 @@
+object DBExplorerFrame: TDBExplorerFrame
+  Left = 0
+  Top = 0
+  Width = 704
+  Height = 536
+  TabOrder = 0
+  OnEnter = ListTableClick
+  object Splitter1: TSplitter
+    Left = 179
+    Top = 0
+    Width = 5
+    Height = 536
+  end
+  object PanelClient: TPanel
+    Left = 184
+    Top = 0
+    Width = 520
+    Height = 536
+    Align = alClient
+    TabOrder = 0
+    object Splitter2: TSplitter
+      Left = 1
+      Top = 172
+      Width = 518
+      Height = 5
+      Cursor = crVSplit
+      Align = alTop
+    end
+    object DrawGrid: TDrawGrid
+      Left = 1
+      Top = 177
+      Width = 518
+      Height = 358
+      Align = alClient
+      ColCount = 1
+      FixedCols = 0
+      RowCount = 1
+      FixedRows = 0
+      TabOrder = 0
+    end
+    object PanelTop: TPanel
+      Left = 1
+      Top = 1
+      Width = 518
+      Height = 171
+      Align = alTop
+      TabOrder = 1
+      DesignSize = (
+        518
+        171)
+      object MemoSQL: TMemo
+        Left = 1
+        Top = 1
+        Width = 455
+        Height = 169
+        Cursor = crIBeam
+        Align = alLeft
+        Anchors = [akLeft, akTop, akRight, akBottom]
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = 'Consolas'
+        Font.Pitch = fpFixed
+        Font.Style = []
+        ParentFont = False
+        PopupMenu = PopupMenuSQL
+        ScrollBars = ssVertical
+        TabOrder = 0
+      end
+      object BtnExec: TButton
+        Left = 466
+        Top = 3
+        Width = 43
+        Height = 30
+        Hint = 'Execute the SQL statement (F9)'
+        Anchors = [akTop, akRight]
+        Caption = 'Exec'
+        Default = True
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 1
+        OnClick = BtnExecClick
+      end
+      object BtnResultToFile: TButton
+        Left = 466
+        Top = 138
+        Width = 43
+        Height = 30
+        Hint = 'Export the results'
+        Anchors = [akRight, akBottom]
+        Caption = 'Result to File'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 5
+        WordWrap = True
+        OnClick = BtnResultToFileClick
+      end
+      object BtnExecToFile: TButton
+        Left = 466
+        Top = 91
+        Width = 43
+        Height = 30
+        Hint = 'Execute the SQL statement with direct export to file'
+        Anchors = [akTop, akRight]
+        Caption = 'Exec to File'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 4
+        WordWrap = True
+        OnClick = BtnExecClick
+      end
+      object BtnExecLog: TButton
+        Left = 466
+        Top = 35
+        Width = 43
+        Height = 22
+        Hint = 'View SQL log history'
+        Anchors = [akTop, akRight]
+        Caption = 'History'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 2
+        WordWrap = True
+        OnClick = BtnExecLogClick
+      end
+      object BtnExecToTab: TButton
+        Left = 466
+        Top = 59
+        Width = 43
+        Height = 30
+        Hint = 
+          'Execute the SQL statement with direct export to a new Tab (Shift' +
+          ' F9)'
+        Anchors = [akTop, akRight]
+        Caption = 'Exec to Tab'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 3
+        WordWrap = True
+        OnClick = BtnExecClick
+      end
+    end
+  end
+  object PagesLeft: TPageControl
+    Left = 0
+    Top = 0
+    Width = 179
+    Height = 536
+    ActivePage = TabTables
+    Align = alLeft
+    TabOrder = 1
+    object TabTables: TTabSheet
+      Caption = 'Tables'
+      DesignSize = (
+        171
+        508)
+      object ImageLogo: TImage
+        Left = 2
+        Top = 474
+        Width = 169
+        Height = 32
+        Anchors = [akLeft, akRight, akBottom]
+        Center = True
+        Picture.Data = {
+          07544269746D617076090000424D760900000000000076000000280000008900
+          0000200000000100040000000000000900000000000000000000100000000000
+          00000504180004A6FC00444446000704C400918FB000D1D1DF001D26E0005454
+          5600726FA000046EFC00B2B0CD0031323300FCFEFC005A53D1003731CF004446
+          FC00CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCC555A5555CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCC54444CCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCA77778777785CCCCCCCCCCCCC5444ACCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCC533338C
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC58274A555555A877ACCCCCCCCCCCD3333
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+          CCCCCCCCCC63333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA774A472BBBB74AA82
+          4CCCCCCCCCCD3333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+          0000CCCCCCCCCCCCCCCCCCCCCCA3333ACCCCCCCCCCCCCCCCCCCCCCCCCCCCC428
+          4700000000000244775CCCCCCCCD3333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCC3333ECCCCCCCCCCCCCCCC
+          CCCCCCCCCCCC4278B0000000000000078775CCCCCCCD3336CCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCC54E3333EACCCCCCCCC83333
+          CCCCCCCC888D5CCCC488DACCCCC4277000000000000000002727CCCCCCCD3336
+          CD63E4CCCCCCCAF333368CCCCCCCCC5863333FACCCCCC0000000CCCC83333333
+          3334CCCCCCCE3333DCCCCCCC3333ACCCC3333FCCCCA277000000000000000000
+          0B728CCCCCCD333333333365CCC53333333333FCCCCC5E3333333333ACCCC000
+          0000CCCCD333333333334CCCCC5333333CCCCCCC3333ACCCC6333DCCCC748000
+          000033333333000000287ACCCCCD333333333333CCC533333333333ECCC53333
+          33333333ACCCC0000000CCCCD3EACCCC83333CCCCCD3333334CCCCCC3333ACCC
+          C6333DCCC48AB0000033333333333000000847CCCCCD33335AAD3333DCC53345
+          CCCA33335CC333338A5C5463ACCCC0000000CCCC4ACCCCCC43333CCCCC333333
+          36CCCCCC3333ACCCC6333DCCC7AA000003333333333333000002A75CCCCD3336
+          CCCCD33335C58CCCCCC533334CA3333ACCCCCCC85CCCC0000000CCCCCCC5A8E3
+          33333CCCCA3333E3335CCCCC3333ACCCC6333DCC5BA700003333333333333330
+          0000587CCCCD3333CCCC53333ACCCCCA8F333333AC8333FCCCCCCCCCCCCCC000
+          0000CCCCCCD333333333FCCCC63338A333DCCCCC3333ACCCC6333DCC42400000
+          33333333333333330000442CCCCD3333CCCCC33334CCC43333333333CCD3333F
+          EEEEEEE68CCCC0000000CCCCC3333333333DCCCC533335C3333CCCCC3333ACCC
+          C6333DCC227000033333333333333333000028B5CCCD3333CCCCC33338CC8333
+          33333335CCD3333333333333FCCCC0000000CCCC53333333E45CCCCC83336CCE
+          3334CCCC3333ACCCC3333DCCB77000033333333333333333000008B5CCCD3333
+          CCCCC33334CC33333336D5CCCCD3333333333333DCCCC0000000CCCC43333ACC
+          CCCCCCCC33334CCA3333CCCC3333ACCCC3333DCC07B000033333336193333333
+          000007BACCCD3336CCCCA3333ACC33338CCCCCC5CCA333DCCCCC63334CCCC000
+          0000CCCCA3333CCCCC538CCA3333CCCC33335CCC333338AAF33334CC07B00003
+          3333336193333333000007BACCCD3333ACC5333335CC3333ACCCC5D3CCC33335
+          CCCC33335CCCC0000000CCCCC333333633334CC3333ECCCCD3336CCC33333333
+          333335CC077000033333633333333333000007BACCCD333333333333DCCCD333
+          33633333CCCA3333F4D3333FCCCCC0000000CCCCC533333333338C53333ACCCC
+          A3333CCC3333F3333333FCCCB7700B03333F6333336663330000B8B5CCCD3333
+          63333333CCCCCE3333333333CCCC43333333333CCCCCC0000000CCCCCCC46333
+          3368CC4366ECCCCCCE6634CCE6635CD33338CCCC828004003333333333336333
+          00B077BCCCC8366DC83333DCCCCCCCAE333333FACCCCCCD3333338CCCCCCC000
+          0000CCCCCCCCCC555CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC55CCCCCC5B4B0A20
+          DD3333EFF333336B0040872CCCCCCCCCCCC55CCCCCCCCCCCCC55CCCCCCCCCCCC
+          5555CCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCC7440BB00333333333333372088B42ACCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCA4AB00000333EEEEE3330000B0847CCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC4440000000384A48300000
+          007445CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+          0000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC574800
+          000B0000000BB0000244ACCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCC474400085555555554B007487CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCC72A4B0028A5C5A470008A825CCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC77AA8000000000007AA
+          8B5CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+          0000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA7
+          4A5A8BB0BB7455478CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCC5474A55555555487ACCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA44AAAAA4445CCCCCCCCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC555555CCCCC
+          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
+          0000}
+        OnClick = ImageLogoClick
+      end
+      object EditTable: TEdit
+        Left = 2
+        Top = 8
+        Width = 167
+        Height = 21
+        Anchors = [akLeft, akTop, akRight, akBottom]
+        TabOrder = 0
+        OnChange = EditTableChange
+      end
+      object ListTable: TListBox
+        Left = 2
+        Top = 32
+        Width = 167
+        Height = 401
+        Anchors = [akLeft, akTop, akRight, akBottom]
+        ItemHeight = 13
+        MultiSelect = True
+        TabOrder = 1
+        OnClick = ListTableClick
+        OnDblClick = ListTableDblClick
+        OnKeyDown = ListTableKeyDown
+        OnKeyUp = ListTableKeyUp
+        OnMouseDown = ListTableMouseDown
+      end
+      object BtnQueryBuilder: TButton
+        Left = 2
+        Top = 434
+        Width = 84
+        Height = 20
+        Hint = 'Create a query (and potential object) from the selected tables'
+        Anchors = [akLeft, akBottom]
+        Caption = 'Query Builder'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 2
+        OnClick = BtnQueryBuilderClick
+      end
+      object BtnTablesExport: TButton
+        Left = 1
+        Top = 454
+        Width = 84
+        Height = 20
+        Hint = 'Export the selected tables into a SQLite3 DB file'
+        Anchors = [akLeft, akBottom]
+        Caption = 'Tables Export'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 3
+        OnClick = BtnTablesExportClick
+      end
+      object btnRunServer: TButton
+        Left = 87
+        Top = 454
+        Width = 84
+        Height = 20
+        Hint = 'Export the selected tables into a SQLite3 DB file'
+        Anchors = [akLeft, akBottom]
+        Caption = 'HTTP Server'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 4
+        OnClick = btnRunServerClick
+      end
+    end
+    object TabObjects: TTabSheet
+      Caption = 'Objects'
+      ImageIndex = 1
+    end
+  end
+  object PopupMenuSQL: TPopupMenu
+    OnPopup = PopupMenuSQLPopup
+    Left = 200
+    Top = 16
+    object MenuInsertFieldName: TMenuItem
+      Caption = 'Fields'
+      Hint = 'all fields'
+    end
+    object MenuInsertFieldValues: TMenuItem
+      Caption = 'Values'
+      Hint = 'all values'
+    end
+  end
+end

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerFrame.pas

@@ -0,0 +1,813 @@
+unit SynDBExplorerFrame;
+
+{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
+
+interface
+
+uses
+  Windows,
+  Messages,
+  SysUtils,
+  Classes,
+  Graphics,
+  Controls,
+  Forms,
+  Dialogs,
+  StdCtrls,
+  Grids,
+  ExtCtrls,
+  ComCtrls,
+  Types,
+  ShellAPI,
+  Menus,
+  {$ifdef ISDELPHIXE3} System.UITypes, {$endif}
+  SynCommons,
+  SynDB,
+  mORMot,
+  mORMoti18n,
+  mORMotUI,
+  mORMotUILogin,
+  mORMotToolBar,
+  mORMotReport;
+
+type
+  TDBExplorerFrame = class(TFrame)
+    Splitter1: TSplitter;
+    PanelClient: TPanel;
+    Splitter2: TSplitter;
+    DrawGrid: TDrawGrid;
+    PanelTop: TPanel;
+    MemoSQL: TMemo;
+    BtnExec: TButton;
+    BtnResultToFile: TButton;
+    PopupMenuSQL: TPopupMenu;
+    MenuInsertFieldName: TMenuItem;
+    MenuInsertFieldValues: TMenuItem;
+    BtnExecToFile: TButton;
+    PagesLeft: TPageControl;
+    TabTables: TTabSheet;
+    TabObjects: TTabSheet;
+    EditTable: TEdit;
+    ListTable: TListBox;
+    ImageLogo: TImage;
+    BtnQueryBuilder: TButton;
+    BtnTablesExport: TButton;
+    BtnExecLog: TButton;
+    BtnExecToTab: TButton;
+    btnRunServer: TButton;
+    procedure EditTableChange(Sender: TObject);
+    procedure ListTableDblClick(Sender: TObject);
+    procedure BtnExecClick(Sender: TObject);
+    procedure ListTableMouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure BtnResultToFileClick(Sender: TObject);
+    procedure PopupMenuSQLPopup(Sender: TObject);
+    procedure ImageLogoClick(Sender: TObject);
+    procedure BtnQueryBuilderClick(Sender: TObject);
+    procedure ListTableClick(Sender: TObject);
+    procedure BtnTablesExportClick(Sender: TObject);
+    procedure BtnExecLogClick(Sender: TObject);
+    procedure ListTableKeyDown(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure ListTableKeyUp(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure btnRunServerClick(Sender: TObject);
+  private
+    fHint: THintWindowDelayed;
+    fGrid: TSQLTableToGrid;
+    fJSONBuffer: RawUTF8;
+    fPreviousSQL: RawUTF8;
+    fSQLLogFile: TFileName;
+    fListTableShiftState: TShiftState;
+    function OnText(Sender: TSQLTable; FieldIndex, RowIndex: Integer; var Text: string): boolean;
+    function GetTableDescription(const TableName: string): string;
+    procedure OnGridDblClick(Sender: TObject);
+    procedure InsertMenu(Sender: TObject);
+    function GridValue(Row,Col: integer): RawUTF8;
+    function GetFileNameFromCurrentSelectedTable: TFileName;
+    procedure AddSQL(SQL: string; AndExec, AndExecInNewTab: boolean);
+    procedure LogClick(Sender: TObject);
+    procedure LogDblClick(Sender: TObject);
+    procedure LogSearch(Sender: TObject);
+  public
+    Tables: TStringList;
+    Props: TSQLDBConnectionProperties;
+    constructor Create(aOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
+resourcestring
+  sCaptionStats = '%d rows (%s) in %s';
+  sCaptionUpdated = '%d row(s) updated in %s';
+  sNothingToExport = 'No result to export';
+  sExportFilter = 'Excel file (*.csv)|*.csv|Text file (*.txt)|*.txt|'+
+    'JSON file (*.json)|*.json|Acrobat PDF report (*.pdf)|*.pdf';
+  sHugeFileExport = 'Do you want to export so much data?';
+  sExportingN = 'Exporting %s...';
+  sHugeFileConfirm = 'This could take a while to create the report';
+  sExecExportFilter = 'Excel file (*.csv)|*.csv|Text file (*.txt)|*.txt|'+
+    'Standard JSON file (*.json)|*.json|Smaller JSON file (*.json)|*.json|'+
+    'SQLite3 database file (*.db3)|*.db3|'+
+    'BigTable fixed sized record (*.rec)|*.rec|'+
+    'BigTable variable length record (*.rec)|*.rec';
+  sTableExportFilter = 'SQLite3 database file (*.db3)|*.db3';
+
+implementation
+
+uses
+  SynDBOracle,
+  SynDBExplorerMain,
+  SynDBExplorerQueryBuilder,
+  SynDBExplorerExportTables,
+  SynTaskDialog,
+  SynTable,
+  SynBigTable,
+  SynDBSQLite3,
+  SynDBExplorerServer;
+
+
+{$R *.dfm}
+
+function RowsToSynBigTableRecord(const Dest: TFileName; Rows: TSQLDBStatement;
+  VariableLength: boolean): integer;
+const
+  TOFIELD: array[Boolean,TSQLDBFieldType] of TSynTableFieldType = (
+    (tftUnknown,tftUnknown,tftInt64,tftDouble,tftCurrency,tftDouble,tftUTF8,tftBlobInternal),
+    (tftUnknown,tftUnknown,tftVarInt64,tftDouble,tftCurrency,tftDouble,tftUTF8,tftBlobInternal));
+var F, FMax: integer;
+    BT: TSynBigTableRecord;
+    Blob: RawByteString;
+    FT: TSynTableFieldType;
+    ColName: RawUTF8;
+    ColRowID: integer;
+    FieldsMap: array of Integer; // column order vary depending on access speed
+    FieldsValue: TRawByteStringDynArray;
+begin
+  result := 0;
+  if (Dest='') or (Rows=nil) or (Rows.ColumnCount=0) then
+    exit;
+  FMax := Rows.ColumnCount-1;
+  DeleteFile(Dest);
+  SetLength(FieldsValue,FMax+1);
+  BT := TSynBigTableRecord.Create(Dest,'SynDbExported');
+  try
+    while Rows.Step do begin
+      if result=0 then begin
+        // retrieve column layout (when first row of data is available)
+        ColRowID := -1; 
+        for F := 0 to FMax do begin
+          ColName := Rows.ColumnName(F);
+          FT := TOFIELD[VariableLength,Rows.ColumnType(F)];
+          if FT=tftUnknown then
+            raise Exception.CreateFmt('Invalid column type %s',[ColName]);
+          if IsRowID(pointer(ColName)) then begin
+            ColName := 'ID__'; // force accepted column name
+            ColRowID := F;
+          end;
+          if not BT.AddField(ColName,FT) then
+            raise Exception.CreateFmt('Impossible to add column %s',[ColName]);
+        end;
+        BT.AddFieldUpdate;
+        if BT.Table.FieldCount<>FMax+1 then
+          raise Exception.Create('Invalid column layout');
+        SetLength(FieldsMap,FMax+1);
+        for F := 0 to FMax do begin
+          ColName := BT.Table.Field[F].Name;
+          if (ColRowID>=0) and (ColName='ID__') then
+            FieldsMap[F] := ColRowID else
+            FieldsMap[F] := Rows.ColumnIndex(ColName);
+          if FieldsMap[F]<0 then
+            raise Exception.CreateFmt('Invalid column type %s',[ColName]);
+        end;
+      end;
+      // recreate each record from scratch (fast in practice)
+      for F := 0 to FMax do
+      with BT.Table.Field[F] do begin
+        case FieldType of
+        tftInt64, tftVarInt64:
+          FieldsValue[F] := SBF(Rows.ColumnInt(FieldsMap[F]));
+        tftDouble:
+          FieldsValue[F] := SBF(Rows.ColumnDouble(FieldsMap[F]));
+        tftCurrency:
+          FieldsValue[F] := SBFCurr(Rows.ColumnCurrency(FieldsMap[F]));
+        tftUTF8:
+          FieldsValue[F] := SBF(Rows.ColumnUTF8(FieldsMap[F]));
+        tftBlobInternal: begin
+          Blob := Rows.ColumnBlob(FieldsMap[F]);
+          FieldsValue[F] := SBF(pointer(Blob),length(Blob));
+        end;
+        end;
+      end;
+      BT.Add(RawByteStringArrayConcat(FieldsValue));
+      if BT.CurrentInMemoryDataSize>$5000000 then // write on disk every 80 MB
+        BT.UpdateToFile;
+      inc(result);
+    end;
+    assert(result=BT.Count);
+  finally
+    BT.Free;
+  end;
+end;
+
+procedure TDBExplorerFrame.EditTableChange(Sender: TObject);
+var s: string;
+    i: integer;
+begin
+  s := SysUtils.UpperCase(SysUtils.trim(EditTable.Text));
+  with ListTable.Items do
+  try
+    BeginUpdate;
+    Clear;
+    for i := 0 to Tables.Count-1 do
+      if (s='') or (Pos(s,SysUtils.UpperCase(Tables[i]))>0) then
+        Add(Tables[i]);
+  finally
+    EndUpdate;
+  end;
+  ListTableClick(nil);
+end;
+
+procedure TDBExplorerFrame.AddSQL(SQL: string; AndExec, AndExecInNewTab: boolean);
+var len: integer;
+    orig: string;
+begin
+  fHint.Hide;
+  SQL := SysUtils.Trim(SQL);
+  len := Length(SQL);
+  if len=0 then
+    exit;
+  orig := MemoSQL.Lines.Text;
+  if orig<>'' then
+    SQL := #13#10#13#10+SQL;
+  SQL := orig+SQL;
+  MemoSQL.Lines.Text := SQL;
+  MemoSQL.SelStart := length(SQL)-len;
+  MemoSQL.SelLength := len;
+  if AndExec then
+    if AndExecInNewTab then
+      BtnExecClick(BtnExecToTab) else
+      BtnExecClick(BtnExec) else
+    MemoSQL.SetFocus;
+end;
+
+procedure TDBExplorerFrame.ListTableKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  fListTableShiftState := Shift;
+end;
+
+procedure TDBExplorerFrame.ListTableKeyUp(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  fListTableShiftState := [];
+end;
+
+procedure TDBExplorerFrame.ListTableDblClick(Sender: TObject);
+var i: integer;
+begin
+  i := ListTable.ItemIndex;
+  if i>=0 then
+    AddSQL(UTF8ToString(Props.SQLSelectAll(StringToUTF8(ListTable.Items[i]),nil,[])),
+      true,ssShift in fListTableShiftState);
+end;
+
+procedure ShowException(E: Exception);
+var Dlg: TTaskDialog;
+    stack: string;
+begin
+  if E=nil then
+    exit;
+  Dlg.Content := E.Message;
+  {$ifdef UNICODE}
+  stack := sLineBreak+E.StackTrace;
+  {$endif}
+  Dlg.Info := Format('Exception class: %s%s',[E.ClassName,stack]);
+  Dlg.Execute([],0,[],tiError);
+end;
+
+procedure TDBExplorerFrame.BtnExecClick(Sender: TObject);
+var SQL, Stop: RawUTF8;
+    Table: TSQLTable;
+    Timer: TPrecisionTimer;
+    SelStart, SelLength, RowsCount, Kind, i: integer;
+    Rows: ISQLDBRows;
+    RowsSize: Int64;
+    FN: TFileName;
+    FS: TFileStream;
+    Frame: TDBExplorerFrame;
+begin
+  FreeAndNil(fGrid);
+  DrawGrid.RowCount := 0;
+  SelStart := MemoSQL.SelStart;
+  SelLength := MemoSQL.SelLength;
+  if SelLength>10 then
+    SQL := Trim(S2U(MemoSQL.SelText)) else
+    SQL := Trim(S2U(MemoSQL.Lines.Text));
+  for i := 1 to length(SQL) do
+    if SQL[i]<' ' then
+      SQL[i] := ' '; // some engines (e.g. MSSQL) don't like line feeds
+  Frame := self;
+  Screen.Cursor := crSQLWait;
+  Timer.Start;
+  try
+    try
+      Caption := '';
+      RowsCount := 0;
+      RowsSize := 0;
+      if SQL<>'' then
+        if isSelect(Pointer(SQL)) then begin
+          try
+            Rows := Props.Execute(SQL,[],nil,(Sender<>BtnExecToFile));
+          except
+            on Exception do
+            if Props.InheritsFrom(TSQLDBSQLite3ConnectionProperties) then
+              // SQLite3 engine is local -> so any failure is fatal
+              raise else begin
+              // DB error (loose remote connection?) -> retry once
+              Props.ClearConnectionPool;
+              Rows := Props.Execute(SQL,[]);
+            end;
+          end;
+          if (Sender=BtnExec) or (Sender=nil) or (Sender=BtnExecToTab) then begin
+            if Sender=BtnExecToTab then begin
+              Frame := ((Owner as TSynPage).Owner as TDbExplorerMain).CreateFrame;
+              Frame.MemoSQL.Lines.Text := U2S(SQL);
+            end;
+            with Frame do begin
+              fJSONBuffer := Rows.FetchAllAsJSON(false); 
+              Stop := Timer.Stop;
+              Table := TSQLTableJSON.Create('',pointer(fJSONBuffer),length(fJSONBuffer));
+              fGrid := TSQLTableToGrid.Create(DrawGrid,Table,nil);
+              fGrid.SetAlignedByType(sftCurrency,alRight);
+              fGrid.OnValueText := OnText;
+              fGrid.SetFieldFixedWidth(100);
+              fGrid.FieldTitleTruncatedNotShownAsHint := true;
+              DrawGrid.Options := DrawGrid.Options-[goRowSelect];
+              DrawGrid.OnDblClick := self.OnGridDblClick;
+              RowsCount := Table.RowCount;
+              RowsSize := length(fJSONBuffer);
+            end;
+          end else
+          if Sender=BtnExecToFile then begin
+            Timer.Pause;
+            with TSaveDialog.Create(self) do
+            try
+              InitialDir := GetShellFolderPath(CSIDL_DOCUMENTS);
+              Filter := sExecExportFilter; // csv,txt,json,json,record,record
+              DefaultExt := '.csv';
+              FilterIndex := 0;
+              Title := BtnExecToFile.Hint;
+              Options := [ofOverwritePrompt,ofHideReadOnly,ofPathMustExist,ofEnableSizing];
+              FileName := GetFileNameFromCurrentSelectedTable;
+              if not Execute then
+                exit;
+              Kind := FilterIndex;
+              FN := FileName;
+            finally
+              Free;
+            end;
+            Timer.Resume;
+            with CreateTempForm(format(sExportingN,[GetFileNameFromCurrentSelectedTable]),nil,True) do
+            try
+              case Kind of
+                5: Rowscount := RowsToSQLite3(FN,S2U(GetFileNameFromCurrentSelectedTable),Rows.Instance,false);
+                6: RowsCount := RowsToSynBigTableRecord(FN,Rows.Instance,False); // fixed length
+                7: RowsCount := RowsToSynBigTableRecord(FN,Rows.Instance,True);  // variable length
+              else begin
+                FS := TFileStream.Create(FN,fmCreate);
+                try
+                  case Kind of
+                  1: RowsCount := Rows.Instance.FetchAllToCSVValues(FS,False,
+                    AnsiChar({$ifdef ISDELPHIXE}FormatSettings.{$endif}ListSeparator),true);
+                  2: RowsCount := Rows.Instance.FetchAllToCSVValues(FS,true,#9,true);
+                  3: RowsCount := Rows.Instance.FetchAllToJSON(FS,true);  // expanded=true
+                  4: RowsCount := Rows.Instance.FetchAllToJSON(FS,false); // expanded=false
+                  end;
+                finally
+                  FS.Free;
+                end;
+              end;
+              end;
+              Stop := Timer.Stop;
+            finally
+              Free;
+            end;
+            RowsSize := FileSize(FN);
+          end;
+          Frame.Caption := format(sCaptionStats,
+            [RowsCount,Ansi7ToString(KB(RowsSize)),Ansi7ToString(Stop)]);
+        end else
+          Caption := Format(sCaptionUpdated,[Props.ExecuteNoResult(SQL,[]),
+            Ansi7ToString(Timer.Stop)]);
+      with Frame do begin
+        (Parent as TSynPage).Caption := Caption;
+        MemoSQL.SelStart := SelStart;
+        MemoSQL.SelLength := SelLength;
+        MemoSQL.SetFocus;
+        if SQL<>fPreviousSQL then begin
+          AppendToTextFile(SQL,fSQLLogFile);
+          fPreviousSQL := SQL;
+        end;
+      end;
+    finally
+      Screen.Cursor := crDefault;
+    end;
+  except
+    on E: Exception do
+      ShowException(E);
+  end;
+end;
+
+function TDBExplorerFrame.GetTableDescription(const TableName: string): string;
+var Fields: TRawUTF8DynArray;
+begin
+  Screen.Cursor := crSQLWait;
+  try
+    Props.GetFieldDefinitions(S2U(TableName),Fields,true);
+    result := TableName+#13#10'  '+U2S(RawUTF8ArrayToCSV(Fields,#13#10'  '));
+  finally
+    Screen.Cursor := crDefault;
+  end;
+end;
+
+procedure TDBExplorerFrame.ListTableMouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+var i: integer;
+begin
+  if Button=mbRight then begin
+    i := ListTable.ItemIndex;
+    if i>=0 then begin
+      if (fHint.Tag=i) and fHint.Visible then begin
+        fHint.Hide;
+        exit;
+      end;
+      fHint.ShowDelayedString(GetTableDescription(ListTable.Items[i]),
+        ListTable,X,Y,5000,clNavy,true);
+      fHint.Tag := i;
+    end;
+  end;
+end;
+
+procedure TDBExplorerFrame.BtnQueryBuilderClick(Sender: TObject);
+var SQL: string;
+    O: TDBQueryObject;
+begin
+  case TDBQueryBuilderForm.BuildQuery(ListTable,Props,SQL) of
+    mrOk:  AddSQL(SQL,false,false);  // Use SQL
+    mrYes: AddSQL(SQL,true,false);   // Exec SQL
+    mrRetry: begin // To Object (SQL=Object serialization)
+      O.FromIniSection(StringToUTF8(SQL));
+      assert(O.AsIniSection=SQL);
+    end;
+  end;
+end;
+
+constructor TDBExplorerFrame.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  fHint := THintWindowDelayed.Create(self);
+  fSQLLogFile := ChangeFileExt(ExeVersion.ProgramFileName,'.history');
+  PagesLeft.ActivePageIndex := 0;
+end;
+
+destructor TDBExplorerFrame.Destroy;
+begin
+  FreeAndNil(fGrid);
+  inherited;
+end;
+
+function TDBExplorerFrame.OnText(Sender: TSQLTable; FieldIndex,
+  RowIndex: Integer; var Text: string): boolean;
+begin
+  if RowIndex=0 then begin
+    Text := U2S(Sender.GetU(RowIndex,FieldIndex)); // display true column name
+    result := true;
+  end else
+    result := false;
+end;
+
+procedure TDBExplorerFrame.BtnResultToFileClick(Sender: TObject);
+var F: TStream;
+    Rep: TGdiPages;
+    Form: TCustomForm;
+    TableName: string;
+begin
+  Form := Application.MainForm;
+  if (fGrid=nil) or (fGrid.Table.RowCount=0) then
+    ShowMessage(sNothingToExport,true) else
+  with TSaveDialog.Create(Form) do
+  try
+    InitialDir := GetShellFolderPath(CSIDL_DOCUMENTS);
+    DefaultExt := 'csv';
+    Filter := sExportFilter; // csv,txt,json,pdf
+    FilterIndex := 0;
+    Title := BtnResultToFile.Hint;
+    Options := [ofOverwritePrompt,ofHideReadOnly,ofPathMustExist,ofEnableSizing];
+    TableName := GetFileNameFromCurrentSelectedTable;
+    FileName := TableName;
+    if not Execute then
+      exit;
+    with CreateTempForm(format(sExportingN,[TableName]),nil,True) do
+    try
+      if FilterIndex=4 then begin
+        if fGrid.Table.RowCount>10000 then
+          if YesNo(sHugeFileConfirm,sHugeFileExport,false,true)=mrNo then
+            exit;
+        Rep := TGDIPages.Create(Application);
+        try
+          Rep.BeginDoc;
+          Rep.Font.Size := 11;
+          Rep.DrawTitle(SysUtils.Trim(Form.Caption));
+          Rep.NewLine;
+          Rep.Font.Style := [fsBold];
+          Rep.DrawText(MemoSQL.Text);
+          Rep.Font.Style := [];
+          Rep.Font.Size := 9;
+          Rep.DrawText(self.Caption);
+          Rep.NewLine;
+          if ListTable.ItemIndex>=0 then begin
+            Rep.DrawText(GetTableDescription(TableName));
+            Rep.NewLine;
+          end;
+          Rep.WordWrapLeftCols := true;
+          TSQLRibbon(nil).AddToReport(Rep,fGrid.Table,[]);
+          Rep.EndDoc;
+          Rep.Caption := GetFileNameWithoutExt(ExtractFileName(FileName));
+          Rep.ExportPDFAuthor := U2S(ExeVersion.User);
+          Rep.ExportPDFApplication := Form.Caption;
+          Rep.ExportPDFSubject := BtnResultToFile.Hint;
+          Rep.ExportPDFKeywords := MemoSQL.Text;
+          Rep.ExportPDF(FileName,True,false)
+        finally
+          Rep.Free;
+        end;
+      end else begin
+        F := TFileStream.Create(FileName,fmCreate);
+        try
+          case FilterIndex of
+          1: fGrid.Table.GetCSVValues(F,false,
+            AnsiChar({$ifdef ISDELPHIXE}FormatSettings.{$endif}ListSeparator),true);
+          2: fGrid.Table.GetCSVValues(F,true,#9,true);
+          3: fGrid.Table.GetJSONValues(F,true);
+          end;
+        finally
+          F.Free;
+        end;
+      end;
+    finally
+      Screen.Cursor := crDefault;
+      Free;
+    end;
+    ShellExecute(Form.Handle,nil,pointer(FileName),nil,nil,SW_SHOWNORMAL);
+  finally
+    Free;
+  end;
+end;
+
+function TDBExplorerFrame.GridValue(Row, Col: integer): RawUTF8;
+begin
+  result := fGrid.Table.GetU(Row,Col);
+  if Row>0 then
+  case fGrid.Table.FieldType(Col) of
+  sftAnsiText, sftUTF8Text, sftObject:
+    result := QuotedStr(result);
+  sftDateTime, sftDateTimeMS:
+    result := Props.SQLIso8601ToDate(result);
+  sftTimeLog, sftModTime, sftCreateTime, sftUnixTime, sftUnixMSTime:
+    result := Props.SQLIso8601ToDate(DateTimeToIso8601Text(
+      fGrid.Table.GetAsDateTime(Row,Col)));
+  sftBlob, sftBlobDynArray:
+    result := ''; // BLOB won't work in SQL without parameter binding
+  end;
+end;
+
+procedure TDBExplorerFrame.OnGridDblClick(Sender: TObject);
+var R,C: integer;
+    sql: string;
+    sel: boolean;
+    selStart: integer;
+begin
+  R := DrawGrid.Row;
+  C := DrawGrid.Col;
+  if (R<=0) or (fGrid.Table=nil) then
+    exit;
+  sel := MemoSQL.SelLength>5;
+  if sel then
+    sql := MemoSQL.SelText else
+    sql := MemoSQL.Text;
+  if Pos(' WHERE ',SysUtils.UpperCase(sql))=0 then
+    sql := sql+' where ' else
+    sql := sql+' and ';
+  sql := sql+fGrid.Table.GetString(0,C)+'='+U2S(GridValue(R,C));
+  if sel then begin
+    selStart := MemoSQL.SelStart;
+    MemoSQL.SelText := sql;
+    MemoSQL.SelStart := selStart;
+    MemoSQL.SelLength := length(sql);
+    MemoSQL.SetFocus;
+  end else
+    MemoSQL.Text := sql;
+end;
+
+procedure TDBExplorerFrame.PopupMenuSQLPopup(Sender: TObject);
+  procedure Add(M: TMenuItem; Row: integer);
+    function New(caption: string; Col: integer=0; csv: PString=nil): TMenuItem;
+    begin
+      caption := SysUtils.trim(caption);
+      if caption<>'' then begin
+        result := TMenuItem.Create(self);
+        result.Caption := Caption;
+        result.Hint := ' '+Caption;
+        result.OnClick := InsertMenu;
+        M.Add(result);
+      end else begin
+        result := nil;
+        caption := 'null';
+      end;
+      if csv<>nil then begin
+        if csv^<>'' then
+          csv^ := csv^+',';
+        csv^ := csv^+caption;
+      end;
+    end;
+  var i: integer;
+      csv: string;
+  begin
+    M.Clear;
+    csv := '';
+    if (Row>=0) and (fGrid<>nil) and (fGrid.Table<>nil) then
+      with fGrid.Table do
+        for i := 0 to FieldCount-1 do
+          New(U2S(GridValue(Row,i)),i,@csv);
+    M.Enabled := M.Count>0;
+    if M.Enabled then begin
+      New('-');
+      New(csv).Caption := M.Hint;
+    end;
+  end;
+begin
+  Add(MenuInsertFieldName,0);
+  Add(MenuInsertFieldValues,DrawGrid.Row);    
+end;
+
+procedure TDBExplorerFrame.InsertMenu(Sender: TObject);
+var Ins: string;
+begin
+  if Sender.InheritsFrom(TMenuItem) then begin
+    Ins := TMenuItem(Sender).Hint;
+    MemoSQL.SelText := Ins;
+    MemoSQL.SelLength := length(Ins);
+  end;
+end;
+
+procedure TDBExplorerFrame.ImageLogoClick(Sender: TObject);
+begin
+{$WARNINGS OFF}
+  if DebugHook=0 then
+    ShellExecute(0,nil,'https://synopse.info',nil,nil,SW_SHOWNORMAL);
+{$WARNINGS ON}
+end;
+
+function TDBExplorerFrame.GetFileNameFromCurrentSelectedTable: TFileName;
+begin
+  if (ListTable.Count=0) or (ListTable.ItemIndex<0) then
+    result := 'Export' else
+    result := ListTable.Items[ListTable.ItemIndex];
+end;
+
+
+procedure TDBExplorerFrame.ListTableClick(Sender: TObject);
+var MultiSel: boolean;
+begin
+  MultiSel := ListTable.SelCount>0;
+  BtnQueryBuilder.Enabled := MultiSel;
+  BtnTablesExport.Enabled := MultiSel;
+end;
+
+procedure TDBExplorerFrame.BtnTablesExportClick(Sender: TObject);
+var RowsCount: integer;
+    Timer: TPrecisionTimer;
+    aFileName: TFileName;
+begin
+  with TSaveDialog.Create(self) do
+  try
+    InitialDir := GetShellFolderPath(CSIDL_DOCUMENTS);
+    Filter := sTableExportFilter;
+    DefaultExt := '.db3';
+    FilterIndex := 0;
+    Title := BtnTablesExport.Hint;
+    Options := [ofOverwritePrompt,ofHideReadOnly,ofPathMustExist,ofEnableSizing];
+    FileName := U2S(Props.ServerName+'_'+NowToString(false,'_'));
+    if not Execute then begin 
+      FileName := U2S(
+        TSQLDBOracleConnectionProperties.ExtractTnsName(Props.ServerName)+
+        '_'+NowToString(false,'_'));
+      if not Execute then
+        exit;
+    end;
+    aFileName := FileName;
+  finally
+    Free;
+  end;
+  Timer.Start;
+  RowsCount := TDBExportTablesForm.ExportTables(ListTable,Props,aFileName);
+  (Parent as TTabSheet).Caption := format(sCaptionStats,
+    [RowsCount,ExtractFileName(aFileName),Ansi7ToString(Timer.Stop)]);
+end;
+
+procedure TDBExplorerFrame.BtnExecLogClick(Sender: TObject);
+var F: TForm;
+    List: TListBox;
+    Search: TEdit;
+    Details: TMemo;
+begin
+  F := TForm.Create(Application);
+  try
+    F.Caption := ' '+BtnExecLog.Hint;
+    F.Font := Font;
+    F.Width := 800;
+    F.Height := Screen.Height-80;
+    F.Position := poMainFormCenter;
+    Search := TEdit.Create(F);
+    Search.Parent := F;
+    Search.Align := alTop;
+    Search.Height := 24;
+    Search.OnChange := LogSearch;
+    Details := TMemo.Create(F);
+    Details.Parent := F;
+    Details.Align := alBottom;
+    Details.Height := 200;
+    Details.ReadOnly := true;
+    List := TListBox.Create(F);
+    with List do begin
+      Parent := F;
+      Align := alClient;
+      Tag := PtrInt(Details);
+      OnClick := LogClick;
+      OnDblClick := LogDblClick;
+    end;
+    Search.Tag := PtrInt(List);
+    LogSearch(Search);
+    F.ShowModal;
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TDBExplorerFrame.LogClick(Sender: TObject);
+var List: TListBox absolute Sender;
+    ndx: integer;
+begin
+  ndx := cardinal(List.ItemIndex);
+  if ndx>=0 then
+    TMemo(List.Tag).Text := copy(List.Items[ndx],21,maxInt) else
+    TMemo(List.Tag).Clear;
+end;
+
+procedure TDBExplorerFrame.LogDblClick(Sender: TObject);
+var List: TListBox absolute Sender;
+    SQL: string;
+    ndx: integer;
+begin
+  ndx := cardinal(List.ItemIndex);
+  if ndx>=0 then begin
+    SQL := copy(List.Items[ndx],21,maxInt);
+    AddSQL(SQL,IsSelect(pointer(StringToAnsi7(SQL))),false);
+    TForm(List.Owner).Close;
+  end;
+end;
+
+procedure TDBExplorerFrame.LogSearch(Sender: TObject);
+const MAX_LINES_IN_HISTORY = 500;
+var Edit: TEdit absolute Sender;
+    List: TListBox;
+    i: integer;
+    s: RawUTF8;
+begin
+  s := SynCommons.UpperCase(StringToUTF8(Edit.Text));
+  List := pointer(Edit.Tag);
+  with TMemoryMapText.Create(fSQLLogFile) do
+  try
+    List.Items.BeginUpdate;
+    List.Items.Clear;
+    for i := Count-1 downto 0 do
+      if (s='') or LineContains(s,i) then
+        if List.Items.Add(Strings[i])>MAX_LINES_IN_HISTORY then
+          break; // read last 500 lines from UTF-8 file
+  finally
+    Free;
+    List.Items.EndUpdate;
+  end;
+  List.ItemIndex := 0;
+  LogClick(List);
+end;
+
+procedure TDBExplorerFrame.btnRunServerClick(Sender: TObject);
+begin
+  if (HTTPServerForm.Props=nil) or (HTTPServerForm.Server=nil) then
+    HTTPServerForm.Props := Props;
+  HTTPServerForm.Show;
+end;
+
+end.
+

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerMain.dfm

@@ -0,0 +1,23 @@
+object DbExplorerMain: TDbExplorerMain
+  Left = 225
+  Top = 210
+  Width = 879
+  Height = 623
+  Caption = ' SynDB Explorer'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  KeyPreview = True
+  OldCreateOrder = False
+  Position = poScreenCenter
+  Scaled = False
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnKeyDown = FormKeyDown
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 13
+end

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerMain.pas

@@ -0,0 +1,392 @@
+unit SynDBExplorerMain;
+
+{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
+
+interface
+
+{.$define USEZEOS}
+
+uses
+  Windows,
+  Messages,
+  SysUtils,
+  Variants,
+  Classes,
+  Graphics,
+  Controls,
+  Forms,
+  Grids,
+  ExtCtrls,
+  StdCtrls,
+  {$ifndef FPC}
+  Consts,
+  {$ifdef HASINLINE}  XPMan,
+  Contnrs, {$endif}
+  {$endif}
+  {$ifdef ISDELPHIXE}
+  SynSQLite3RegEx, // use direct PCRE library as available since Delphi XE
+  {$endif}
+  SynCommons,
+  SynZip,
+  mORMot,
+  SynSQLite3,
+  SynSQLite3Static,
+  mORMotUI,
+  mORMotUIEdit,
+  mORMotUILogin,
+  mORMotToolBar,
+  SynTaskDialog, // also fix QC 37403 for Delphi 6/7/2006
+  SynTable, // for TSynFilter and TSynValidate
+  SynDB,
+  SynDBOracle,
+  SynOleDB,
+  SynDBSQLite3,
+  SynDBODBC,
+  SynDBRemote,
+  {$ifdef USEZEOS}
+  SynDBZeos,
+  {$endif}
+  SynDBExplorerClasses,
+  SynDBExplorerFrame,
+  ComCtrls;
+
+type
+  TDbExplorerMain = class(TForm)
+    procedure FormDestroy(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure FormKeyDown(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+  private
+    MainCaption: string;
+    Connection: TExpConnectionType;
+    Page: TSynPager;
+    PageNew: TSynPage;
+    TempFileName: TFileName;
+    procedure PageChange(Sender: TObject);
+    procedure PageDblClick(Sender: TObject);
+  public
+    ConnectionName: string;
+    Tables: TStringList;
+    Props: TSQLDBConnectionProperties;
+    function CreateFrame: TDBExplorerFrame;
+  end;
+
+var
+  DbExplorerMain: TDbExplorerMain;
+
+  
+resourcestring
+  sSelectAConnection = 'Select a connection';
+  sNew = 'New Connection';
+  sNewOne = 'New';
+  sConnectionHints = 'Display name|Database type|Server name '+
+    '(for "Generic OLEDB", use ADO-like connection string, and ignore other fields; '+
+    'for SQLite3 or Jet, specify the full file name)|'+
+    'Database name (unneeded for Oracle/SQLite3/Jet/ODBC)|User login|'+
+    'User password (set ? for prompt)';
+  sSelectOrCreateAConnection = 'Select a connection to be used, or\n'+
+    'click on "New connection" to create one.';
+  sPleaseWaitN = 'Connecting to %s...';
+  sPleaseWaitSynLz = 'Decompressing %s...';
+  sUpdateConnection = 'Update connection settings';
+  sPassPromptN = 'Please enter password for %s@%s:';
+
+
+implementation
+
+uses
+  SynDBExplorerServer;
+
+
+{$ifndef HASINLINE}
+  {$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
+{$endif}
+
+{$R *.dfm}
+
+procedure TDbExplorerMain.FormDestroy(Sender: TObject);
+begin
+  Tables.Free;
+  Props.Free;
+  if TempFileName<>'' then
+    DeleteFile(TempFileName);
+end;
+
+function Crypt(const s: RawUTF8): RawUTF8;
+var i: integer;
+begin // just not to be written in plain ascii in .config file
+  SetLength(result,length(s));
+  for i := 0 to length(s)-1 do
+    PByteArray(result)[i] := PByteArray(s)[i] xor (i+137);
+end;
+
+procedure TDbExplorerMain.FormCreate(Sender: TObject);
+var Conns: TSQLRestStorageInMemory;
+function TryConnect(C: TSQLConnection; LoadTableNames: boolean): boolean;
+const CONN_CLASSES: array[TExpConnectionType] of TSQLDBConnectionPropertiesClass =
+  (TSQLDBOracleConnectionProperties,
+   TOleDBOracleConnectionProperties,TOleDBMSOracleConnectionProperties,
+   TOleDBMSSQLConnectionProperties,TOleDBConnectionProperties,
+   TSQLDBSQLite3ConnectionProperties,
+   {$ifdef WIN64}
+   nil, // no JET/MSAccess available under Win64
+   {$else}
+   TOleDBJetConnectionProperties,
+   {$endif}
+   TODBCConnectionProperties,
+   TSQLDBWinHTTPConnectionProperties,
+   {$ifdef USEZEOS}TSQLDBZeosConnectionProperties{$else}nil{$endif}
+  );
+var i: integer;
+    Pass: RawUTF8;
+begin
+  result := false;
+  if CONN_CLASSES[C.Connection]=nil then begin
+    {$ifndef USEZEOS}
+    if C.Connection=ctZEOS then
+      ShowMessage('USEZEOS conditional should be defined in SynDBExplorerMain.pas',
+        'Zeos/ZDBC not available',true);
+    {$endif} 
+    exit;
+  end;
+  try
+    Pass := Crypt(C.Password);
+    if Pass='?' then 
+      Pass := StringToUTF8(InputBox(Caption,format(sPassPromptN,
+        [UTF8ToString(C.UserName),UTF8ToString(C.Server)]),'',true));
+    if C.Connection=ctGenericOLEDB then begin
+      Props := TOleDBConnectionProperties.Create('','','','');
+      with TOleDBConnectionProperties(Props) do begin
+        ConnectionString := UTF8ToWideString(C.Server);
+        if LoadTableNames then begin
+          ConnectionStringDialogExecute(Handle);
+          C.Server := WideStringToUTF8(ConnectionString);
+        end;
+      end;
+    end else 
+      Props := CONN_CLASSES[C.Connection].Create(C.Server,C.Database,C.UserName,Pass);
+    ConnectionName := UTF8ToString(C.Ident);
+    with CreateTempForm(format(sPleaseWaitN,[ConnectionName]),nil,True) do
+    try
+      Connection := C.Connection;
+      MainCaption := format('%s %s (compiled with %s) - %s',
+        [MainCaption,SYNOPSE_FRAMEWORK_VERSION,GetDelphiCompilerVersion,ConnectionName]);
+      if LoadTableNames or                      // retrieve all needed info from DB
+         (C.Connection=ctRemoteHTTP) then begin
+        Props.GetTableNames(C.fTableNames);     // retrieve and set table names
+        C.ForeignKeys := CompressString(Props.ForeignKeysData); // foreign keys
+        if Conns<>nil then
+          Conns.Modified := true;
+      end else begin
+        Props.ThreadSafeConnection.Connect;
+        Props.ForeignKeysData := UncompressString(C.ForeignKeys); 
+      end;
+      for i := 0 to High(C.TableNames) do
+        Tables.Add(UTF8ToString(C.TableNames[i]));
+{$ifdef ISDELPHIXE}
+     with TSQLDBSQLite3Connection(Props.ThreadSafeConnection) do
+     if InheritsFrom(TSQLDBSQLite3Connection) then
+       CreateRegExpFunction(DB.DB);
+{$endif}
+      result := true;
+    finally
+      Screen.Cursor := crDefault;
+      Free;
+    end;
+  except
+    on E: Exception do begin
+      ShowMessage(E.Message,true);
+      FreeAndNil(Props);
+    end;
+  end;
+end;
+var Btns: TCommonButtons;
+    Task: TTaskDialog;
+    C: TSQLConnection;
+    CmdLine: TExpConnectionType;
+    FN, msg, FN2: string;
+    i, res: Integer;
+    tmp: array[0..MAX_PATH] of char;
+begin
+  Conns := nil;
+  DefaultFont.Name := 'Tahoma';
+  DefaultFont.Size := 9;
+  Tables := TStringList.Create;
+  C := nil;
+  with TSQLConnection.RecordProps do begin
+    AddFilterOrValidate('Ident',TSynFilterTrim.Create);
+    AddFilterOrValidate('Ident',TSynValidateText.Create);
+    //AddFilterOrValidate('Server',TSynValidateText.Create);
+  end;
+  MainCaption := Caption;
+  if (ParamCount=1) and FileExists(paramstr(1)) then begin
+    FN := paramstr(1);
+    CmdLine := ctOracleDirectOCI;
+    if IsJetFile(FN) then
+      CmdLine := ctJet_mdbOLEDB else
+    if IsSQLite3File(FN) then
+      CmdLine := ctSqlite3 else
+    if TSQLDataBase.IsBackupSynLZFile(FN) then begin
+      FN2 := ExtractFileName(FN);
+      SetString(TempFileName, tmp, GetTempPath(SizeOf(tmp), tmp));
+      TempFileName := TempFileName+FN2+'.db';
+      DeleteFile(TempFileName);
+      with CreateTempForm(format(sPleaseWaitSynLz,[FN2]),nil,True) do
+      try
+        if TSQLDatabase.BackupUnSynLZ(FN, TempFileName) then begin
+          CmdLine := ctSqlite3;
+          FN := TempFileName;
+        end;
+      finally
+        Screen.Cursor := crDefault;
+        Free;
+      end;
+    end;
+    if CmdLine=ctOracleDirectOCI then begin
+      ShowMessage(FN+'?',True);
+      exit;
+    end;
+    C := TSQLConnection.Create;
+    try
+      C.Connection := CmdLine;
+      C.Ident := StringToUTF8(FN);
+      C.Server := C.Ident;
+      TryConnect(C,True);
+    finally
+      C.Free;
+    end;
+  end else begin
+    Conns := TSQLRestStorageInMemory.Create(
+      TSQLConnection,nil,ChangeFileExt(ExeVersion.ProgramFileName,'.config'),false);
+    try
+      Conns.ExpandedJSON := true; // for better human reading and modification
+      Task.Title := MainCaption;
+      Task.Inst := sSelectAConnection;
+      Task.Content := sSelectOrCreateAConnection;
+      if Conns.Count=0 then
+        Btns := [cbCancel] else begin
+        for i := 0 to Conns.Count-1 do
+          Task.Selection := Task.Selection+UTF8ToString(TSQLConnection(Conns[i]).Ident)+#10;
+        Btns := [cbOk,cbCancel];
+        Task.Query := UTF8ToString(TSQLConnection(Conns[0]).Ident);
+        Task.Verify := sUpdateConnection;
+      end;
+      Task.VerifyChecked := false;
+      Task.Buttons := sNew;
+      res := Task.Execute(Btns,0,[],tiQuestion);
+      case res of
+      mrOk:
+        if Task.VerifyChecked then begin
+          C := TSQLConnection(Conns[Task.SelectionRes]);
+          msg := Task.Verify;
+        end else
+          TryConnect(TSQLConnection(Conns[Task.SelectionRes]),false);
+      mrBtn1: begin
+        C := TSQLConnection.Create;
+        msg := sNew;
+      end;
+      end;
+      if C<>nil then
+        with TRecordEditForm.Create(self) do
+        try
+          C.Password := Crypt(C.Password);
+          SetRecord(nil,C,nil,nil,sConnectionHints,0,msg);
+          if ShowModal=mrOk then begin
+            C.Password := Crypt(C.Password);
+            if TryConnect(C,true) and (res=mrBtn1) then
+              Conns.AddOne(C,false,'') else
+              if res=mrBtn1 then
+                FreeAndNil(C);
+          end else
+            if res=mrBtn1 then
+              FreeAndNil(C);
+        finally
+          Free;
+        end;
+    finally
+      Conns.Free;
+    end;
+  end;
+  Page := TSynPager.Create(self);
+  Page.ControlStyle := Page.ControlStyle+[csClickEvents]; // enable OnDblClick
+  Page.Parent := self;
+  Page.Align := alClient;
+  PageNew := TSynPage.Create(self);
+  PageNew.Caption := sNewOne;
+  PageNew.PageControl := Page;
+  Page.OnChange := PageChange;
+  Page.OnDblClick := PageDblClick;
+end;
+
+procedure TDbExplorerMain.FormShow(Sender: TObject);
+begin
+  if Props=nil then begin
+    Close;
+    exit;
+  end;
+  Caption := MainCaption;
+  SetStyle(self);
+  CreateFrame;
+end;
+
+procedure TDbExplorerMain.FormKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  case Key of
+    ord('T'):
+      if Shift=[ssCtrl] then
+        CreateFrame;
+    VK_F9:
+      with Page.ActivePage do
+        if TObject(Tag).InheritsFrom(TDBExplorerFrame) then
+          with TDBExplorerFrame(Tag) do
+          if Shift=[] then
+            BtnExecClick(BtnExec) else
+          if ssShift in Shift then
+            BtnExecClick(BtnExecToTab);
+  end;
+end;
+
+var
+  FrameID: integer;
+  
+function TDbExplorerMain.CreateFrame: TDBExplorerFrame;
+var P: TSynPage;
+begin
+  P := TSynPage.Create(self);
+  P.PageControl := Page;
+  P.PageIndex := Page.PageCount-2;
+  result := TDBExplorerFrame.Create(P);
+  result.Parent := P;
+  result.Align := alClient;
+  result.Tables := Tables;
+  result.Props := Props;
+  result.EditTableChange(nil);
+  inc(FrameID);
+  result.Name := 'P'+IntToStr(FrameID);
+  P.Tag := PtrInt(result);
+  Page.ActivePage := P;
+  result.EditTable.SetFocus;
+  SetStyle(P);
+end;
+
+procedure TDbExplorerMain.PageChange(Sender: TObject);
+begin
+  if Page.ActivePage=PageNew then
+    CreateFrame;
+end;
+
+procedure TDbExplorerMain.PageDblClick(Sender: TObject);
+var n, i: Integer;
+begin
+  i := Page.ActivePageIndex;
+  n := Page.PageCount-2;
+  if n>0 then begin
+    Page.ActivePage.Free;
+    if i=n then
+      Page.ActivePageIndex := n-1;
+  end;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerQueryBuilder.dfm

@@ -0,0 +1,133 @@
+object DBQueryBuilderForm: TDBQueryBuilderForm
+  Left = 1019
+  Top = 265
+  BorderStyle = bsSingle
+  Caption = ' SynDB Explorer - Query Builder'
+  ClientHeight = 374
+  ClientWidth = 799
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  DesignSize = (
+    799
+    374)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object GroupJoin: TGroupBox
+    Left = 344
+    Top = 8
+    Width = 441
+    Height = 201
+    Caption = ' Select how Tables are JOINed '
+    TabOrder = 0
+  end
+  object GroupFields: TGroupBox
+    Left = 8
+    Top = 8
+    Width = 329
+    Height = 201
+    Caption = ' Select Columns to be retrieved for each table '
+    TabOrder = 1
+    DesignSize = (
+      329
+      201)
+    object FieldsTable: TListBox
+      Left = 8
+      Top = 16
+      Width = 129
+      Height = 177
+      Anchors = [akLeft, akTop, akBottom]
+      ItemHeight = 13
+      TabOrder = 0
+      OnClick = FieldsTableClick
+    end
+    object FieldsColumn: TCheckListBox
+      Left = 144
+      Top = 33
+      Width = 177
+      Height = 160
+      Anchors = [akLeft, akTop, akBottom]
+      ItemHeight = 13
+      TabOrder = 1
+      OnClick = FieldsColumnClick
+    end
+    object FieldsAll: TCheckBox
+      Left = 144
+      Top = 16
+      Width = 97
+      Height = 17
+      Caption = 'all columns (*)'
+      TabOrder = 2
+      OnClick = FieldsAllClick
+    end
+  end
+  object MemoSQL: TMemo
+    Left = 8
+    Top = 215
+    Width = 777
+    Height = 113
+    Anchors = [akLeft, akBottom]
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -11
+    Font.Name = 'Consolas'
+    Font.Style = []
+    ParentFont = False
+    ScrollBars = ssHorizontal
+    TabOrder = 2
+  end
+  object BtnUseSQL: TButton
+    Left = 24
+    Top = 335
+    Width = 75
+    Height = 25
+    Anchors = [akLeft, akBottom]
+    Caption = 'Use SQL'
+    ModalResult = 1
+    TabOrder = 3
+  end
+  object BtnCancel: TButton
+    Left = 344
+    Top = 335
+    Width = 75
+    Height = 25
+    Anchors = [akLeft, akBottom]
+    Caption = 'Cancel'
+    ModalResult = 2
+    TabOrder = 4
+  end
+  object BtnExecSQL: TButton
+    Left = 112
+    Top = 335
+    Width = 75
+    Height = 25
+    Anchors = [akLeft, akBottom]
+    Caption = 'Exec SQL'
+    ModalResult = 6
+    TabOrder = 5
+  end
+  object BtnToObject: TButton
+    Left = 232
+    Top = 335
+    Width = 75
+    Height = 25
+    Anchors = [akLeft, akBottom]
+    Caption = 'To Object'
+    PopupMenu = BtnToObjectMenu
+    TabOrder = 6
+    OnClick = BtnToObjectClick
+  end
+  object BtnToObjectMenu: TPopupMenu
+    Left = 312
+    Top = 344
+    object MenuToOneTSQLRecord: TMenuItem
+      Caption = 'To one TSQLRecord per table'
+      OnClick = MenuToOneTSQLRecordClick
+    end
+  end
+end

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerQueryBuilder.pas

@@ -0,0 +1,560 @@
+unit SynDBExplorerQueryBuilder;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, CheckLst, Controls, StdCtrls, Classes, Types,
+  Graphics, Forms, Clipbrd,
+  SynDB, SynCommons, SynTable, Menus;
+
+type
+  TDBQueryTable = object
+    Name: string;
+    NameWithoutSchema: RawUTF8;
+    NameWithSchema: RawUTF8;
+    Fields: TSQLDBColumnDefineDynArray;
+    FieldsDefinition,
+    FieldsAlias: TRawUTF8DynArray;
+    SelectedAll: boolean;
+    Selected: set of byte;
+    function FieldAlias(FieldIndex: integer): RawUTF8;
+    function FieldIndexMatch(const aTable: RawUTF8; const aField: TSQLDBColumnDefine): integer;
+    function AsIniRow: RawUTF8;
+    function AsTSQLRecordType(Props: TSQLDBConnectionProperties): RawUTF8;
+    function FromIniSection(P: PUTF8Char): PUTF8Char;
+  end;
+  TDBQueryJoin = record
+    SourceTable: integer;
+    SourceField: integer;
+    DestTable: integer;
+    DestField: integer;
+  end;
+  TDBQueryTableDynArray = array of TDBQueryTable;
+  TDBQueryJoinDynArray = array of TDBQueryJoin;
+  TDBQueryObject = object
+    Name: string;
+    Tables: TDBQueryTableDynArray;
+    JOIN: TDBQueryJoinDynArray;
+    procedure InitJOIN(Size: integer);
+    function ComputeSQLSelect: RawUTF8;
+    function AsIniSection: string;
+    function FromIniSection(P: PUTF8Char): Boolean; overload;
+    function FromIniSection(const IniContent: RawUTF8): Boolean; overload;
+  end;
+  PDBQueryTable = ^TDBQueryTable;
+  
+  TDBQueryBuilderForm = class(TForm)
+    GroupJoin: TGroupBox;
+    GroupFields: TGroupBox;
+    MemoSQL: TMemo;
+    FieldsTable: TListBox;
+    FieldsColumn: TCheckListBox;
+    FieldsAll: TCheckBox;
+    BtnUseSQL: TButton;
+    BtnCancel: TButton;
+    BtnExecSQL: TButton;
+    BtnToObject: TButton;
+    BtnToObjectMenu: TPopupMenu;
+    MenuToOneTSQLRecord: TMenuItem;
+    procedure FieldsTableClick(Sender: TObject);
+    procedure FieldsAllClick(Sender: TObject);
+    procedure FieldsColumnClick(Sender: TObject);
+    procedure BtnToObjectClick(Sender: TObject);
+    procedure MenuToOneTSQLRecordClick(Sender: TObject);
+  private
+    fProps: TSQLDBConnectionProperties;
+    fObject: TDBQueryObject;
+    fJOINUI: array of record
+      SourceTable: TComboBox;
+      SourceField: TComboBox;
+      DestTable: TComboBox;
+      DestField: TComboBox;
+    end;
+    procedure JoinTableClick(Sender: TObject);
+    procedure SetTableNames(const Value: TStrings);
+    function FieldsTableCurrent: PDBQueryTable;
+    procedure ComputeSQL(Sender: TObject);
+  public
+    class function BuildQuery(aTableNames: TStrings; aProps: TSQLDBConnectionProperties;
+      out SQL: string): integer; overload;
+    class function BuildQuery(aListBox: TListBox; aProps: TSQLDBConnectionProperties;
+      out SQL: string): integer; overload;
+    property Props: TSQLDBConnectionProperties read fProps write fProps;
+  end;
+
+resourcestring
+  sMissingJOIN = 'Missing JOIN';
+
+
+implementation
+
+{$R *.dfm}
+
+{ TDBQueryTable }
+
+function TDBQueryTable.AsIniRow: RawUTF8;
+var f: integer;
+begin
+  result := FormatUTF8('%,%,%,',[Name,length(Fields),SelectedAll]);
+  for f := 0 to high(Fields) do
+  with Fields[f] do
+    result := FormatUTF8('%%,%,%,%,',
+      [result,ColumnName,Ord(ColumnType),FieldAlias(f),f in Selected]);
+end;
+
+function TDBQueryTable.AsTSQLRecordType(Props: TSQLDBConnectionProperties): RawUTF8;
+var f, RowIDIndex: integer;
+    IdField: TSQLDBColumnCreate;
+    def: RawUTF8;
+begin
+  RowIDIndex := -1;
+  for f := 0 to high(Fields) do
+  with Fields[f] do begin
+    if IsRowID(pointer(ColumnName)) then begin
+      RowIDIndex := f;
+      if (ColumnType=ftInt64) and IdemPropNameU(ColumnName,'ID') then
+        def := FormatUTF8('%    // warning: %.% column matches TSQLRecord.ID'#13#10'//',
+          [def,NameWithoutSchema,FieldsDefinition[f]]) else
+        def := FormatUTF8('% FATAL ERROR: %.% column overrides TSQLRecord.ID: integer'#13#10'//',
+          [def,NameWithoutSchema,FieldsDefinition[f]]);
+    end;
+    def := FormatUTF8('%    f%: %;'#13#10,
+      [def,ColumnName,SQLDBFIELDTYPE_TO_DELPHITYPE[ColumnType]]);
+  end;
+  def := def+'  published'#13#10;
+  for f := 0 to high(Fields) do
+  with Fields[f] do
+    if IsRowID(pointer(ColumnName)) then
+      def := FormatUTF8('%    /// note: ignoring %.% matching TSQLRecord.ID'#13#10,
+        [def,NameWithoutSchema,ColumnName]) else
+      def := FormatUTF8('%    /// match %.%'#13#10'    %'#13#10,
+        [def,NameWithoutSchema,FieldsDefinition[f],
+         Props.GetFieldORMDefinition(Fields[f])]);
+  result := FormatUTF8('  /// % Table'#13#10+
+    '  // - type definition auto-generated by SynDBExplorer '+
+      SYNOPSE_FRAMEWORK_VERSION+' at %'#13#10'  // from %'#13#10,
+      [NameWithoutSchema,NowToString,NameWithSchema]);
+  if RowIDIndex<0 then begin
+    IdField.Name := 'ID';
+    IdField.DBType := ftUnknown;
+    IdField.PrimaryKey := true;
+    result := FormatUTF8('%  // - note that the ORM will add one missing ID field via:'#13#10+
+      '  // $ %'#13#10,[result,Props.SQLAddColumn(NameWithSchema,IdField)]);
+  end;
+  result := FormatUTF8('%  TSQL% = class(TSQLRecord)'#13#10'  protected'#13#10'%  end;',
+    [result,NameWithoutSchema,def]);
+end;
+
+function TDBQueryTable.FieldAlias(FieldIndex: integer): RawUTF8;
+begin
+  if Cardinal(FieldIndex)>=cardinal(length(FieldsAlias)) then
+    result := '' else
+    result := FieldsAlias[FieldIndex];
+end;
+
+function TDBQueryTable.FieldIndexMatch(const aTable: RawUTF8;
+  const aField: TSQLDBColumnDefine): integer;
+begin
+  for result := 0 to High(Fields) do
+    with Fields[result] do
+    if (aField.ColumnType=ColumnType) then
+      if IsRowID(pointer(ColumnName)) then begin
+        if IdemPropNameU(aField.ColumnName,aTable) then
+          exit; // Toto.Tata=Tata.ID (e.g. for SQLite3 tables)
+      end else
+      if IdemPropNameU(aField.ColumnName,ColumnName) then
+        exit; // Toto.ID_TRN=Tata.ID_TRN (most common RDRMS layouts)
+  result := -1;
+end;
+
+function TDBQueryTable.FromIniSection(P: PUTF8Char): PUTF8Char;
+var i: integer;
+begin
+  result := P;
+  Name := Ansi7ToString(GetNextItem(result));
+  SetLength(Fields,GetNextItemCardinal(result));
+  SelectedAll := GetNextItemCardinal(result)=1;
+  if result=nil then exit;
+  Selected := [];
+  SetLength(FieldsAlias,length(Fields));
+  for i := 0 to high(Fields) do
+  with Fields[i] do begin
+    ColumnName := GetNextItem(result);
+    ColumnType := TSQLDBFieldType(GetNextItemCardinal(result));
+    FieldsAlias[i] := GetNextItem(result);
+    if GetNextItemCardinal(result)=1 then
+      include(Selected,i);
+  end;
+end;
+
+
+{ TDBQueryObject }
+
+function TDBQueryObject.AsIniSection: string;
+var ini: RawUTF8;
+    t: integer;
+begin
+  ini := FormatUTF8('[%]'#13#10'TableCount=%'#13#10,
+    [Name,length(Tables)]);
+  for t := 0 to high(Tables) do
+    ini := FormatUTF8('%Table%=%'#13#10,[ini,t,Tables[t].AsIniRow]);
+  for t := 0 to high(JOIN) do
+    with JOIN[t] do
+      ini := FormatUTF8('%Join%=%,%,%,%'#13#10,
+        [ini,t,SourceTable,SourceField,DestTable,DestField]);
+  result := UTF8ToString(ini);
+end;
+
+function TDBQueryObject.ComputeSQLSelect: RawUTF8;
+var select: RawUTF8;
+    t,f: integer;
+begin
+  result := '';
+  for t := 0 to high(Tables) do
+  with Tables[t] do begin
+    if SelectedAll then
+      select := NameWithoutSchema+'.*' else begin
+      select := '';
+      for f := 0 to High(Fields) do
+      if f in Selected then begin
+        if select<>'' then
+          select := select+',';
+        select := select+NameWithoutSchema+'.'+Fields[f].ColumnName;
+        if (FieldsAlias<>nil) and (FieldsAlias[f]<>'') then
+          select := select+' '+FieldsAlias[f];
+      end;
+    end;
+    if  select<>'' then begin
+      if (result<>'') and (result[length(result)]<>',') then
+        result := result+',';
+      result := result+' '+select;
+    end;
+  end;
+  if result<>'' then begin // need at least one field retrieved
+    result := 'select'#13#10' '+result+#13#10'from'#13#10' ';
+    for t := 0 to high(Tables) do
+    with Tables[t] do begin
+      if t>0 then
+        result := result+', ';
+      result := result+NameWithSchema;
+      if NameWithSchema<>NameWithoutSchema then
+        result := result+' '+NameWithoutSchema;
+    end;
+    select := '';
+    for t := 0 to high(JOIN) do
+    with JOIN[t] do
+      if (SourceField<0) or (SourceTable<0) or
+         (DestField<0) or (DestTable<0) then begin
+        result := StringToUTF8(sMissingJOIN);
+        exit;
+      end else begin
+        if select<>'' then
+          select := select+' and ' else
+          select := #13#10'where'#13#10' ';
+        select := select+Tables[SourceTable].NameWithoutSchema+'.'+
+          Tables[SourceTable].Fields[SourceField].ColumnName+'=';
+        select := select+Tables[DestTable].NameWithoutSchema+'.'+
+          Tables[DestTable].Fields[DestField].ColumnName;
+      end;
+    result := result+select;
+  end;
+end;
+
+function TDBQueryObject.FromIniSection(P: PUTF8Char): Boolean;
+var t: integer;
+begin
+  result := false;
+  if P=nil then exit;
+  while P^=' ' do inc(P);
+  if P^<>'[' then exit;
+  inc(P);
+  Name := Ansi7ToString(GetNextItem(P,']'));
+  inc(P); while P^<=' ' do if P^=#0 then exit else inc(P);
+  if not IdemPChar(P,'TABLECOUNT=') then exit else inc(P,11);
+  SetLength(Tables,GetNextItemCardinal(P,#13));
+  if P=nil then exit;
+  for t := 0 to high(Tables) do begin
+    while P^<=' ' do if P^=#0 then exit else inc(P);
+    if not IdemPChar(P,'TABLE') then
+      exit else begin
+      inc(P,5);
+      if (GetNextItemCardinal(P,'=')<>cardinal(t)) or (P=nil) then exit;
+      P := Tables[t].FromIniSection(P);
+      if P=nil then exit;
+    end;
+  end;
+  SetLength(JOIN,length(Tables)-1);
+  for t := 0 to high(JOIN) do begin
+    if P=nil then exit;
+    while P^<=' ' do if P^=#0 then exit else inc(P);
+    if not IdemPChar(P,'JOIN') then
+      exit else begin
+      inc(P,4);
+      if (GetNextItemCardinal(P,'=')<>cardinal(t)) or (P=nil) then exit;
+      with JOIN[t] do begin
+        SourceTable := GetNextItemCardinal(P);
+        SourceField := GetNextItemCardinal(P);
+        DestTable := GetNextItemCardinal(P);
+        DestField := GetNextItemCardinal(P,#13);
+      end;
+    end;
+  end;
+  result := True;
+end;
+
+function TDBQueryObject.FromIniSection(const IniContent: RawUTF8): Boolean;
+var P: PUTF8Char;
+begin
+  P := pointer(IniContent);
+  result := FromIniSection(P);
+end;
+
+procedure TDBQueryObject.InitJOIN(Size: integer);
+begin
+  SetLength(JOIN,Size);
+  fillchar(JOIN[0],Size*sizeof(JOIN[0]),255); // fill all to -1
+end;
+
+
+{ TDBQueryBuilderForm }
+
+class function TDBQueryBuilderForm.BuildQuery(aTableNames: TStrings;
+  aProps: TSQLDBConnectionProperties; out SQL: string): integer;
+begin
+  result := mrCancel;
+  if (aProps<>nil) and (aTableNames<>nil) then
+  with TDBQueryBuilderForm.Create(Application) do
+  try
+    Props := aProps;
+    SetTableNames(aTableNames);
+    result := ShowModal;
+    case result of
+    mrOk,mrYes:
+      SQL := MemoSQL.Text;
+    mrRetry:
+      SQL := fObject.AsIniSection; 
+    end;
+  finally
+    Free;
+  end;
+end;
+
+class function TDBQueryBuilderForm.BuildQuery(aListBox: TListBox;
+  aProps: TSQLDBConnectionProperties; out SQL: string): integer;
+var T: TStringList;
+    i: integer;
+begin
+  result := mrCancel;
+  if (aListBox=nil) or (aListBox.SelCount=0) then
+    exit;
+  T := TStringList.Create;
+  try
+    for i := 0 to aListBox.Count-1 do
+      if aListBox.Selected[i] then
+        T.Add(aListBox.Items[i]);
+    result := BuildQuery(T,aProps,SQL);
+  finally
+    T.Free;
+  end;
+end;
+
+procedure TDBQueryBuilderForm.SetTableNames(const Value: TStrings);
+var t,j,f,k,Y: Integer;
+  function CreateCombo(X: integer; Table: integer=-1): TComboBox;
+  var k: Integer;
+  begin
+    result := TComboBox.Create(self);
+    result.Parent := GroupJoin;
+    result.SetBounds(X,Y,100,20);
+    result.Style := csDropDownList;
+    result.Font.Size := 7;
+    if Table>=0 then begin
+      for k := 0 to High(fObject.Tables) do
+        result.Items.Add(Ansi7ToString(fObject.Tables[k].NameWithoutSchema));
+      result.OnClick := JoinTableClick;
+    end else
+      result.OnClick := ComputeSQL;
+  end;
+begin
+  FieldsTable.Clear;
+  Screen.Cursor := crHourGlass;
+  try
+    // fill fObject.Tables[]
+    SetLength(fObject.Tables,Value.Count);
+    for t := 0 to high(fObject.Tables) do
+    with fObject.Tables[t] do begin
+      Name := Value[t];
+      NameWithoutSchema := StringToAnsi7(Name);
+      Props.GetFields(NameWithoutSchema,Fields);
+      NameWithSchema := Props.SQLTableName(NameWithoutSchema);
+      NameWithoutSchema := TrimLeftSchema(NameWithoutSchema);
+      SetLength(FieldsDefinition,length(Fields));
+      for f := 0 to high(Fields) do
+        FieldsDefinition[f] := Props.GetFieldDefinition(Fields[f]);
+      FieldsTable.Items.Add(Name);
+    end;
+    // create JOIN controls on form
+    SetLength(fJOINUI,length(fObject.Tables)-1);
+    Y := 20;
+    for t := 0 to high(fJOINUI) do
+    with fJOINUI[t] do begin
+      SourceTable := CreateCombo(8,t);
+      SourceField := CreateCombo(112);
+      SourceTable.Tag := PtrInt(SourceField);
+      JoinTableClick(SourceTable);
+      DestTable := CreateCombo(224,t+1);
+      DestField := CreateCombo(328);
+      DestTable.Tag := PtrInt(DestField);
+      JoinTableClick(DestTable);
+      with TLabel.Create(self) do begin
+        Parent := GroupJoin;
+        SetBounds(214,Y+3,8,20);
+        Font.Style := [fsBold];
+        Caption := '=';
+      end;
+      inc(Y,24);
+    end;
+    inc(Y,8);
+    if Y>GroupJoin.ClientHeight then begin
+      ClientHeight := ClientHeight+Y-GroupJoin.ClientHeight;
+      GroupJoin.ClientHeight := Y;
+      GroupFields.ClientHeight := Y;
+    end;
+    // guess column JOIN criteria
+    fObject.InitJOIN(length(fJOINUI));
+    for t := 0 to high(fJOINUI) do
+    with fObject.JOIN[t], fObject.Tables[t] do begin
+      for f := 0 to high(Fields) do begin
+        for j := 0 to high(fObject.Tables) do
+        if j<>t then begin
+          k := fObject.Tables[j].FieldIndexMatch(NameWithoutSchema,Fields[f]);
+          if k>=0 then begin // get first matching field (name+type) in tables
+            SourceTable := t;
+            SourceField := f;
+            DestTable := j;
+            DestField := k;
+            break;
+          end;
+        end;
+        if DestTable>=0 then
+          break;
+      end;
+    end;
+    // refresh UI
+    for f := 0 to high(fJOINUI) do
+    with fJOINUI[f] do begin
+      SourceTable.ItemIndex := fObject.JOIN[f].SourceTable;
+      JoinTableClick(SourceTable);
+      SourceField.ItemIndex := fObject.JOIN[f].SourceField;
+      DestTable.ItemIndex := fObject.JOIN[f].DestTable;
+      JoinTableClick(DestTable);
+      DestField.ItemIndex := fObject.JOIN[f].DestField;
+    end;
+  finally
+    Screen.Cursor := crDefault;
+  end;
+  if Value.Count>0 then begin
+    FieldsTable.ItemIndex := 0;
+    FieldsTableClick(nil);
+  end;
+end;
+
+procedure TDBQueryBuilderForm.FieldsTableClick(Sender: TObject);
+var i: integer;
+    T: PDBQueryTable;
+begin
+  FieldsColumn.Clear;
+  T := FieldsTableCurrent;
+  if T=nil then
+    exit;
+  for i := 0 to High(T^.FieldsDefinition) do
+    FieldsColumn.Items.Add(Ansi7ToString(T^.FieldsDefinition[i]));
+  FieldsAll.Checked := T^.SelectedAll;
+  FieldsAllClick(nil);
+end;
+
+procedure TDBQueryBuilderForm.FieldsAllClick(Sender: TObject);
+var T: PDBQueryTable;
+    i: integer;
+begin
+  FieldsColumn.Enabled := not FieldsAll.Checked;
+  T := FieldsTableCurrent;
+  if T=nil then
+    exit;
+  T^.SelectedAll := FieldsAll.Checked;
+  for i := 0 to High(T^.Fields) do
+    FieldsColumn.Checked[i] := i in T^.Selected;
+  ComputeSQL(nil);
+end;
+
+function TDBQueryBuilderForm.FieldsTableCurrent: PDBQueryTable;
+var i: cardinal;
+begin
+  i := FieldsTable.ItemIndex;
+  if i<cardinal(length(fObject.Tables)) then
+    result := @fObject.Tables[i] else
+    result := nil;
+end;
+
+procedure TDBQueryBuilderForm.FieldsColumnClick(Sender: TObject);
+var T: PDBQueryTable;
+    i: integer;
+begin
+  T := FieldsTableCurrent;
+  if T=nil then
+    exit;
+  FillChar(T^.Selected,sizeof(T^.Selected),0);
+  for i := 0 to High(T^.Fields) do
+    if FieldsColumn.Checked[i] then
+      Include(T^.Selected,i);
+  ComputeSQL(nil);
+end;
+
+procedure TDBQueryBuilderForm.ComputeSQL(Sender: TObject);
+var f: integer;
+begin
+  for f := 0 to high(fJOINUI) do
+  with fJOINUI[f] do begin
+    fObject.JOIN[f].SourceTable := SourceTable.ItemIndex;
+    fObject.JOIN[f].SourceField := SourceField.ItemIndex;
+    fObject.JOIN[f].DestTable := DestTable.ItemIndex;
+    fObject.JOIN[f].DestField := DestField.ItemIndex;
+  end;
+  MemoSQL.Text := Ansi7ToString(fObject.ComputeSQLSelect);
+end;
+
+procedure TDBQueryBuilderForm.JoinTableClick(Sender: TObject);
+var Table, Field: TComboBox;
+    t,f: integer;
+begin
+  Table := Sender as TComboBox;
+  Field := TComboBox(Table.Tag);
+  Field.Items.Clear;
+  t := Table.ItemIndex;
+  if t>=0 then
+    with fObject.Tables[t] do
+    for f := 0 to high(Fields) do
+      Field.Items.Add(Ansi7ToString(Fields[f].ColumnName));
+end;
+
+
+procedure TDBQueryBuilderForm.BtnToObjectClick(Sender: TObject);
+begin
+  with ClientToScreen(Point(BtnToObject.Left,BtnToObject.Top+BtnToObject.Height)) do
+      BtnToObjectMenu.Popup(X,Y);
+end;
+
+procedure TDBQueryBuilderForm.MenuToOneTSQLRecordClick(Sender: TObject);
+var s: RawUTF8;
+    txt: string;
+    i: integer;
+begin
+  s := 'type'#13#10;
+  for i := 0 to high(fObject.Tables) do
+    s := s+fObject.Tables[i].AsTSQLRecordType(Props)+#13#10#13#10;
+  txt := UTF8ToString(s);
+  MemoSQL.Text := txt;
+  Clipboard.AsText := txt;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerServer.dfm

@@ -0,0 +1,85 @@
+object HTTPServerForm: THTTPServerForm
+  Left = 148
+  Top = 129
+  BorderStyle = bsDialog
+  Caption = ' SynDBExplorer HTTP Server'
+  ClientHeight = 165
+  ClientWidth = 346
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnDestroy = FormDestroy
+  PixelsPerInch = 96
+  TextHeight = 13
+  object lbledtPort: TLabeledEdit
+    Left = 40
+    Top = 32
+    Width = 121
+    Height = 21
+    EditLabel.Width = 48
+    EditLabel.Height = 13
+    EditLabel.Caption = 'HTTP Port'
+    TabOrder = 0
+    Text = '8092'
+    OnKeyPress = lbledtPortKeyPress
+  end
+  object lbledtDatabase: TLabeledEdit
+    Left = 176
+    Top = 32
+    Width = 121
+    Height = 21
+    EditLabel.Width = 75
+    EditLabel.Height = 13
+    EditLabel.Caption = 'Database name'
+    TabOrder = 1
+    Text = 'syndbremote'
+    OnKeyPress = lbledtDatabaseKeyPress
+  end
+  object lbledtUser: TLabeledEdit
+    Left = 40
+    Top = 72
+    Width = 121
+    Height = 21
+    EditLabel.Width = 52
+    EditLabel.Height = 13
+    EditLabel.Caption = 'User Name'
+    TabOrder = 2
+    Text = 'synopse'
+    OnKeyPress = lbledtDatabaseKeyPress
+  end
+  object lbledtPassword: TLabeledEdit
+    Left = 176
+    Top = 72
+    Width = 121
+    Height = 21
+    EditLabel.Width = 46
+    EditLabel.Height = 13
+    EditLabel.Caption = 'Password'
+    TabOrder = 3
+    Text = 'synopse'
+    OnKeyPress = lbledtDatabaseKeyPress
+  end
+  object btnConnect: TButton
+    Left = 72
+    Top = 120
+    Width = 75
+    Height = 25
+    Caption = 'Start'
+    TabOrder = 4
+    OnClick = btnConnectClick
+  end
+  object btnDisconnect: TButton
+    Left = 160
+    Top = 120
+    Width = 75
+    Height = 25
+    Caption = 'Stop'
+    Enabled = False
+    TabOrder = 5
+    OnClick = btnDisconnectClick
+  end
+end

contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerServer.pas

@@ -0,0 +1,82 @@
+unit SynDBExplorerServer;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, SynCommons, SynDB, SynDBRemote;
+
+type
+  THTTPServerForm = class(TForm)
+    lbledtPort: TLabeledEdit;
+    lbledtDatabase: TLabeledEdit;
+    lbledtUser: TLabeledEdit;
+    lbledtPassword: TLabeledEdit;
+    btnConnect: TButton;
+    btnDisconnect: TButton;
+    procedure lbledtPortKeyPress(Sender: TObject; var Key: Char);
+    procedure lbledtDatabaseKeyPress(Sender: TObject; var Key: Char);
+    procedure btnConnectClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure btnDisconnectClick(Sender: TObject);
+  private
+  public
+    Props: TSQLDBConnectionProperties;
+    Server: TSQLDBServerHttpApi;
+  end;
+
+var
+  HTTPServerForm: THTTPServerForm;
+
+implementation
+
+uses
+  mORMotUILogin; // for ShowMessage()
+  
+{$R *.dfm}
+
+procedure THTTPServerForm.lbledtPortKeyPress(Sender: TObject;
+  var Key: Char);
+begin
+  if not (AnsiChar(Key) in ['0'..'9']) then
+    Key := #0
+end;
+
+procedure THTTPServerForm.lbledtDatabaseKeyPress(Sender: TObject;
+  var Key: Char);
+begin
+  if not (AnsiChar(Key) in ['A'..'Z','a'..'z','_']) then
+    Key := #0
+end;
+
+procedure THTTPServerForm.btnConnectClick(Sender: TObject);
+begin
+  if (Server<>nil) or (Props=nil) then
+    exit;
+  try
+    Server := TSQLDBServerHttpApi.Create(Props,StringToUTF8(lbledtDatabase.Text),
+      StringToUTF8(lbledtPort.Text),StringToUTF8(lbledtUser.Text),
+      StringToUTF8(lbledtPassword.Text));
+  except
+    on E: Exception do
+      ShowMessage(E.ClassName,E.Message,true);
+  end;
+  btnConnect.Enabled := false;
+  btnDisconnect.Enabled := true;
+end;
+
+procedure THTTPServerForm.FormDestroy(Sender: TObject);
+begin
+  FreeAndNil(Server);
+end;
+
+procedure THTTPServerForm.btnDisconnectClick(Sender: TObject);
+begin
+  if Server<>nil then
+    FreeAndNil(Server);
+  Props := nil;
+  btnDisconnect.Enabled := false;
+  btnConnect.Enabled := true;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/13 - StandAlone JSON SQL server/JSONSQLClient.dpr

@@ -0,0 +1,33 @@
+/// receive SQLite3 results from JSON/SQL HTTP server
+program JSONSQLClient;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  SynCrtSock,
+  SynCommons;
+
+function Client(const SQL: RawUTF8): RawUTF8;
+var Http: THttpClientSocket;
+    URI: AnsiString;
+begin
+  if ParamCount<>0 then
+    URI := AnsiString(ParamStr(1)) else
+    URI := 'localhost';
+  Http := OpenHttp(URI,'888');
+  if Http<>nil then
+  try
+    Http.Post('root',SQL,TEXT_CONTENT_TYPE);
+    result := Http.Content;
+  finally
+    Http.Free;
+  end else
+    result := '';
+end;
+
+begin
+  writeln(Client('select * from People where LastName=''Schubert'''));
+  readln;
+end.

contrib/mORMot/SQLite3/Samples/13 - StandAlone JSON SQL server/JSONSQLServer.dpr

@@ -0,0 +1,121 @@
+/// serve SQLite3 results from SQL using HTTP server
+program JSONSQLServer;
+
+{
+
+  This "13 - StandAlone JSON SQL server" sample's aim is to directly
+    serve SQLite3 JSON results from SQL using HTTP server.
+
+  It will expect the incoming SQL statement to be POSTED as HTTP body, which
+  will be executed and returned as JSON.
+
+  This default implementation will just serve the test.db3 file as generated
+  by our regression tests.
+
+  SETUP NOTE: Ensure you first copied in the sample exe folder the test.db3 file
+  as generated by TestSQL3.exe.
+
+  But it is a very rough mechanism:
+  - No security is included;
+  - You can make your process run out of memory if the request returns too much rows;
+  - All incoming inputs will not be checked;
+  - No statement cache is used;
+  - No test was performed;
+  - Consider using SynDBRemote unit instead, for remote SQL access.
+
+  Therefore, this method is much less efficient than the one implemented by mORMot.
+  This is just a rough sample - do not use it in production - you shall better
+  use the mORMot framework instead.
+
+  Using SynDB classes instead of directly SynSQLite3 will allow to use any other DB,
+  not only SQlite3.
+
+  see https://synopse.info/forum/viewtopic.php?id=607 for the initial request
+  
+}
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynZip,
+  SynDB,
+  SynDBSQLite3, SynSQLite3Static,
+  SynCrtSock;
+
+type
+  TJSONServer = class
+  protected
+    fProps: TSQLDBConnectionProperties;
+    fServer: THttpApiServer;
+    function Process(Ctxt: THttpServerRequest): cardinal;
+  public
+    constructor Create(Props: TSQLDBConnectionProperties);
+    destructor Destroy; override;
+  end;
+
+
+{ TJSONServer }
+
+const
+  DEFAULT_PORT = {$ifdef LINUX} '8888' {$else} '888' {$endif};
+
+constructor TJSONServer.Create(Props: TSQLDBConnectionProperties);
+var Conn: TSQLDBConnection;
+begin
+  fProps := Props;
+  Conn := fProps.ThreadSafeConnection;
+  if not Conn.Connected then
+    Conn.Connect; // ensure we can connect to the DB
+  fServer := THttpApiServer.Create(false);
+  fServer.AddUrl('root',DEFAULT_PORT,false,'+',true);
+  fServer.RegisterCompress(CompressDeflate); // our server will deflate JSON :)
+  fServer.OnRequest := Process;
+  fServer.Clone(31); // will use a thread pool of 32 threads in total
+end;
+
+destructor TJSONServer.Destroy;
+begin
+  fServer.Free;
+  inherited;
+end;
+
+function TJSONServer.Process(Ctxt: THttpServerRequest): cardinal;
+begin
+  try
+    if length(Ctxt.InContent)<5 then
+      raise ESynException.CreateUTF8('Invalid request % %',[Ctxt.Method,Ctxt.URL]);
+    Ctxt.OutContentType := JSON_CONTENT_TYPE;
+    Ctxt.OutContent := fProps.Execute(Ctxt.InContent,[]).FetchAllAsJSON(true);
+    result := 200;
+  except
+    on E: Exception do begin
+      Ctxt.OutContentType := TEXT_CONTENT_TYPE;
+      Ctxt.OutContent := StringToUTF8(E.ClassName+': '+E.Message)+#13#10+Ctxt.InContent;
+      result := 504;
+    end;
+  end;
+end;
+
+var Props: TSQLDBConnectionProperties;
+begin
+  // copy in the sample exe folder the test.db3 file as generated by TestSQL3.exe 
+  Props := TSQLDBSQLite3ConnectionProperties.Create('test.db3','','','');
+  try
+    with TJSONServer.Create(Props) do
+    try
+      write('Server is now running on http://localhost:',
+        DEFAULT_PORT,'/root'#13#10'and will serve ',
+        ExpandFileName(UTF8ToString(Props.ServerName)),
+        ' content'#13#10#13#10'Press [Enter] to quit');
+      readln;
+    finally
+      Free;
+    end;
+  finally
+    Props.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14Client.dpr

@@ -0,0 +1,28 @@
+program Project14Client;
+
+{$ifdef Linux}
+  {$ifdef FPC_CROSSCOMPILING}
+    {$linklib libc_nonshared.a}
+  {$endif}
+{$endif}
+
+{$I Synopse.inc}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  Project14ClientMain in 'Project14ClientMain.pas' {Form1},
+  Project14Interface in 'Project14Interface.pas';
+
+{$ifndef FPC}
+{$R *.res}
+{$endif}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14Client.lpi

@@ -0,0 +1,83 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Project14Client"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="Project14Client.dpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="Project14ClientMain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="Project14Interface.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="Project14Client"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="D:\DEV\lib\SQLite3\;D:\DEV\lib\;$(ProjOutDir)"/>
+      <OtherUnitFiles Value="D:\DEV\lib\SQLite3\;D:\DEV\lib\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <TargetCPU Value="x86_64"/>
+      <TargetOS Value="linux"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ClientMain.dfm

@@ -0,0 +1,83 @@
+object Form1: TForm1
+  Left = 334
+  Top = 330
+  Caption = 'Form1'
+  ClientHeight = 242
+  ClientWidth = 306
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnDestroy = FormDestroy
+  PixelsPerInch = 96
+  TextHeight = 16
+  object lblA: TLabel
+    Left = 56
+    Top = 50
+    Width = 17
+    Height = 16
+    Caption = 'A='
+  end
+  object lblB: TLabel
+    Left = 56
+    Top = 98
+    Width = 16
+    Height = 16
+    Caption = 'B='
+  end
+  object lblResult: TLabel
+    Left = 76
+    Top = 200
+    Width = 184
+    Height = 16
+    Caption = 'Enter numbers, then Call Server'
+  end
+  object edtA: TEdit
+    Left = 80
+    Top = 48
+    Width = 153
+    Height = 24
+    TabOrder = 0
+  end
+  object edtB: TEdit
+    Left = 80
+    Top = 96
+    Width = 153
+    Height = 24
+    TabOrder = 1
+  end
+  object btnCall: TButton
+    Left = 56
+    Top = 152
+    Width = 97
+    Height = 25
+    Caption = 'Call Server'
+    TabOrder = 2
+    OnClick = btnCallClick
+  end
+  object btnCancel: TButton
+    Left = 168
+    Top = 152
+    Width = 97
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 3
+    OnClick = btnCancelClick
+  end
+  object ComboProtocol: TComboBox
+    Left = 80
+    Top = 16
+    Width = 153
+    Height = 24
+    Style = csDropDownList
+    TabOrder = 4
+    OnChange = ComboProtocolChange
+    Items.Strings = (
+      'HTTP / TCP-IP'
+      'Named Pipe'
+      'Weak HTTP / TCP-IP')
+  end
+end

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ClientMain.pas

@@ -0,0 +1,109 @@
+unit Project14ClientMain;
+
+{
+
+ By definition, you need the proper server to run:
+ - Project14Server.dpr for Named Pipes
+ - Project14ServerHttp.dpr for HTTP
+ - Project14ServerHttpWeak.dpr for HTTP/weak
+
+}
+
+interface
+
+uses
+  {$IFDEF WINDOWS}  Windows, Messages, {$ENDIF}
+  SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls,
+  SynCommons, mORMot, mORMotHttpClient,
+  Project14Interface;
+
+type
+  TForm1 = class(TForm)
+    edtA: TEdit;
+    edtB: TEdit;
+    lblA: TLabel;
+    lblB: TLabel;
+    btnCall: TButton;
+    btnCancel: TButton;
+    lblResult: TLabel;
+    ComboProtocol: TComboBox;
+    procedure btnCancelClick(Sender: TObject);
+    procedure btnCallClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure ComboProtocolChange(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    Model: TSQLModel;
+    Client: TSQLRestClientURI;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+{$ifndef FPC}
+  {$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
+{$endif}
+
+procedure TForm1.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.btnCallClick(Sender: TObject);
+var a,b: integer;
+    err: integer;
+    I: ICalculator;
+begin
+  val(edtA.Text,a,err);
+  if err<>0 then begin
+    edtA.SetFocus;
+    exit;
+  end;
+  val(edtB.Text,b,err);
+  if err<>0 then begin
+    edtB.SetFocus;
+    exit;
+  end;
+  if Client=nil then begin
+    if Model=nil then
+      Model := TSQLModel.Create([],ROOT_NAME);
+    case ComboProtocol.ItemIndex of
+    0,2: Client := TSQLHttpClient.Create('localhost', PORT_NAME,Model);
+    {$IFDEF WINDOWS}
+    1: Client := TSQLRestClientURINamedPipe.Create(Model,APPLICATION_NAME);
+    {$ENDIF}
+    else exit;
+    end;
+    if not Client.ServerTimeStampSynchronize then begin
+      ShowMessage(UTF8ToString(Client.LastErrorMessage));
+      exit;
+    end;
+    case ComboProtocol.ItemIndex of
+    2:   TSQLRestServerAuthenticationNone.ClientSetUser(Client,'User','');
+    else Client.SetUser('User','synopse');
+    end;
+    Client.ServiceDefine([ICalculator],sicShared);
+  end;
+  if Client.Services['Calculator'].Get(I) then
+    lblResult.Caption := IntToStr(I.Add(a,b));
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Client.Free;
+  Model.Free;
+end;
+
+procedure TForm1.ComboProtocolChange(Sender: TObject);
+begin
+  FreeAndNil(Client);
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14Interface.pas

@@ -0,0 +1,25 @@
+/// some common definitions shared by both client and server side
+unit Project14Interface;
+
+interface
+
+type
+  ICalculator = interface(IInvokable)
+    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
+    function Add(n1,n2: integer): integer;
+  end;
+
+const
+  ROOT_NAME = 'root';
+  PORT_NAME = '8888';
+  APPLICATION_NAME = 'RestService';
+
+implementation
+
+uses
+  mORMot;
+
+initialization
+  // so that we could use directly ICalculator instead of TypeInfo(ICalculator)
+  TInterfaceFactory.RegisterInterfaces([TypeInfo(ICalculator)]);
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14Server.dpr

@@ -0,0 +1,47 @@
+program Project14Server;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  SynCommons, SynLog, mORMot,
+  mORMotSQLite3, SynSQLite3Static,
+  Project14Interface;
+
+type
+  TServiceCalculator = class(TInterfacedObject, ICalculator)
+  public
+    function Add(n1,n2: integer): integer;
+  end;
+
+function TServiceCalculator.Add(n1, n2: integer): integer;
+begin
+  result := n1+n2;
+end;
+
+var
+  aModel: TSQLModel;
+begin
+  with TSQLLog.Family do begin
+    Level := LOG_VERBOSE;
+    EchoToConsole := LOG_VERBOSE; // log all events to the console
+  end;
+  aModel := TSQLModel.Create([],ROOT_NAME);
+  try
+    with TSQLRestServerDB.Create(aModel,ChangeFileExt(ExeVersion.ProgramFileName,'.db'),true) do
+    try
+      CreateMissingTables; // we need AuthGroup and AuthUser tables
+      ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
+      if ExportServerNamedPipe(APPLICATION_NAME) then
+        writeln('Background server is running.'#10) else
+        writeln('Error launching the server'#10);
+      write('Press [Enter] to close the server.');
+      readln;
+    finally
+      Free;
+    end;
+  finally
+    aModel.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ServerExternal.dpr

@@ -0,0 +1,60 @@
+program Project14ServerExternal;
+
+{ this sample will create the main SQLite3 DB as in-memory, but will define all
+  tables as external, in the same .db file than Project14Server
+  -> just to demonstrate VirtualTableExternalRegisterAll() function and
+  reproduce the https://synopse.info/forum/viewtopic.php?id=1008 issue }
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  mORMot,
+  mORMotSQLite3,
+  SynCommons, SynLog,
+  SynDB,
+  SynDBSQLite3, SynSQLite3, SynSQLite3Static,
+  mORMotDB,
+  Project14Interface;
+
+type
+  TServiceCalculator = class(TInterfacedObject, ICalculator)
+  public
+    function Add(n1,n2: integer): integer;
+  end;
+
+function TServiceCalculator.Add(n1, n2: integer): integer;
+begin
+  result := n1+n2;
+end;
+
+var
+  aModel: TSQLModel;
+  aProps: TSQLDBSQLite3ConnectionProperties;
+begin
+  aProps := TSQLDBSQLite3ConnectionProperties.Create(
+    StringToUtf8(ChangeFileExt(ExeVersion.ProgramFileName,'.db')),'','','');
+  try
+    aModel := TSQLModel.Create([TSQLAuthGroup,TSQLAuthUser],ROOT_NAME);
+    VirtualTableExternalRegisterAll(aModel,aProps);
+    try
+      with TSQLRestServerDB.Create(aModel,SQLITE_MEMORY_DATABASE_NAME,true) do
+      try
+        CreateMissingTables; // we need AuthGroup and AuthUser tables
+        ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
+        if ExportServerNamedPipe(APPLICATION_NAME) then
+          writeln('Background server is running.'#10) else
+          writeln('Error launching the server'#10);
+        write('Press [Enter] to close the server.');
+        readln;
+      finally
+        Free;
+      end;
+    finally
+      aModel.Free;
+    end;
+  finally
+    aProps.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ServerHttp.dpr

@@ -0,0 +1,71 @@
+/// this server will use TSQLRestServerFullMemory over HTTP
+program Project14ServerHttp;
+
+{$APPTYPE CONSOLE}
+
+{$ifdef Linux}
+  {$ifdef FPC_CROSSCOMPILING}
+    {$linklib libc_nonshared.a}
+  {$endif}
+{$endif}
+
+{$I Synopse.inc}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynLog,
+  mORMot,
+  mORMotHttpServer,
+  Project14Interface in 'Project14Interface.pas';
+
+type
+  TServiceCalculator = class(TInterfacedObject, ICalculator)
+  public
+    function Add(n1,n2: integer): integer;
+  end;
+
+function TServiceCalculator.Add(n1, n2: integer): integer;
+begin
+  result := n1+n2;
+end;
+
+
+var
+  aModel: TSQLModel;
+  aServer: TSQLRestServer;
+  aHTTPServer: TSQLHttpServer;
+begin
+  // define the log level
+  with TSQLLog.Family do begin
+    PerThreadLog := ptIdentifiedInOnFile;
+    Level := LOG_VERBOSE;
+    EchoToConsole := LOG_VERBOSE; // log all events to the console
+  end;
+  // create a Data Model
+  aModel := TSQLModel.Create([],ROOT_NAME);
+  try
+    // initialize a TObjectList-based database engine
+    aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,true);
+    try
+      // register our ICalculator service on the server side
+      aServer.ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
+      // launch the HTTP server
+      aHTTPServer := TSQLHttpServer.Create(PORT_NAME,[aServer],'+' {$ifndef ONLYUSEHTTPSOCKET},useHttpApiRegisteringURI{$endif});
+      try
+        aHTTPServer.AccessControlAllowOrigin := '*'; // for AJAX requests to work
+        writeln(#10'Background server is running.'#10);
+        writeln('Press [Enter] to close the server.'#10);
+        readln;
+      finally
+        aHTTPServer.Free;
+      end;
+    finally
+      aServer.Free;
+    end;
+  finally
+    aModel.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ServerHttp.lpi

@@ -0,0 +1,79 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Project14ServerHttp"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="Project14ServerHttp.dpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="Project14ServerHttp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="D:\DEV\lib\SQLite3\;D:\DEV\lib\;$(ProjOutDir)"/>
+      <OtherUnitFiles Value="D:\DEV\lib\SQLite3\;D:\DEV\lib\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <TargetCPU Value="x86_64"/>
+      <TargetOS Value="linux"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>