/// Common ORM and SOA classes for mORMot
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit mORMot;

(*
    This file is part of Synopse mORMot framework.

    Synopse mORMot framework. Copyright (C) 2020 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse mORMot framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2020
  the Initial Developer. All Rights Reserved.

  Contributor(s):
    Alexander (chaa)
    Alfred Glaenzer (alf)
    Daniel Kuettner
    DigDiver
    EgorovAlex
    Emanuele (lele9)
    Esmond
    Goran Despalatovic (gigo)
    Jordi Tudela
    Jean-Baptiste Roussia (jbroussia)
    Lagodny
    Maciej Izak (hnb)
    Martin Suer
    Michalis Kamburelis
    MilesYou
    Ondrej
    Pavel Mashlyakovskii (mpv)
    Sabbiolina
    Svetozar Belic (transmogrifix)
    Uian2000
    Vadim Orel

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

*)


{$I Synopse.inc} // define HASINLINE CPU32 CPU64

{.$define PUREPASCAL}  // define for debugg, not on production

{$ifdef MSWINDOWS}

  {.$define ANONYMOUSNAMEDPIPE}
  // if defined, the security attributes of the named pipe will use an
  // anonymous connection - it should allow access to a service initialized
  // named pipe on a remote computer.
  // - I tried to implement the code as detailed in this Microsoft article:
  // http://support.microsoft.com/kb/813414 but it didn't work as
  // expected: see our forum https://synopse.info/forum/viewtopic.php?id=43
  // - don't define it, because it's still buggy, and consider using HTTP
  // connection for remote access over the network
    {$define NOSECURITYFORNAMEDPIPECLIENTS}
    // define this may avoid issues with Delphi XE+ for obscure reasons


  {$define SSPIAUTH}
  // if defined, the Windows built-in authentication will be used
  // along with the usual one
  // - If you pass to TSQLRestClientURI.SetUser an empty string as user name,
  // the Windows authentication will be performed
  // - In this case, in table TSQLAuthUser should be an entry for the
  // windows user, with the LoginName in form 'DomainName\UserName'
  // - Setting NOSSPIAUTH conditional will disable this feature

{$else}

  {$define GSSAPIAUTH}
  // if defined, the Kerberos authentication (using gssapi library) will be used
  // along with the usual one
  // - In this case, in table TSQLAuthUser should be an entry for the
  // domain user, with the LoginName in form 'username@DOMAIN.TLD'
  // - Linux server should joind a domain before using this
  // - KRB5_KTNAME environment variable or ServerForceKeytab shoud point
  // to valid readable keytab file with correct server credentials
  // - For more information on how to prepare server read an article on how to
  // configure MS SQL Server on Linux to use Windows authentication
  // https://www.mssqltips.com/sqlservertip/5075/configure-sql-server-on-linux-to-use-windows-authentication
  // - Setting NOGSSAPIAUTH conditional will disable this feature
  // Limitations:
  //  - no NTLM support - this is a deprecated and vulnerable protocol
{$endif}


{$ifdef KYLIX3}
  {$define NOGSSAPIAUTH} // SynGSSAPI.pas unit is not Kylix-compatible
{$endif}

{$ifdef Android}
  {$define NOGSSAPIAUTH} // SynGSSAPI.pas unit is not Android-compatible [anymore]
{$endif}

{$ifdef SSPIAUTH}
  {$undef GSSAPIAUTH} // exclusive
  {$ifdef NOSSPIAUTH}
    {$undef SSPIAUTH} // force disable
    {$undef DOMAINAUTH}
  {$else}
    {$define DOMAINAUTH}
  {$endif}
{$endif}
{$ifdef GSSAPIAUTH}
  {$undef SSPIAUTH} // exclusive
  {$ifdef NOGSSAPIAUTH}
    {$undef GSSAPIAUTH} // force disable
    {$undef DOMAINAUTH}
  {$else}
    {$define DOMAINAUTH}
  {$endif}
{$endif}

interface

uses
{$ifdef MSWINDOWS}
  Windows,
  Messages,
{$endif}
{$ifdef KYLIX3}
  Types,
  LibC,
  SynKylix,
{$endif}
{$ifdef UNICODE}
  Generics.Collections,
{$endif}
  Classes,
  SynZip, // use crc32 for TSQLRestClientURI.SetUser
{$ifndef LVCL}
  SyncObjs, // for TEvent
  Contnrs,  // for TObjectList
  {$ifndef NOVARIANTS}
  Variants,
  {$endif}
{$endif LVCL}
  SysUtils,
{$ifdef SSPIAUTH}
  SynSSPI,
  SynSSPIAuth,
{$endif}
{$ifdef GSSAPIAUTH}
  SynGSSAPI,
  SynGSSAPIAuth,
{$endif}
{$ifdef FPC}
  SynFPCTypInfo, // small wrapper unit around FPC's TypInfo.pp
{$endif}
  SynCommons,
  SynTable, // for SynTable, TSynFilter and TSynValidate
  SynLog,
  SynCrypto, // SHA-256 and IProtocol
  SynTests;  // for mocks integration




{ ************ low level types and constants for handling JSON and fields }

  { Why use JSON? (extracted from the main framework documentation)
    - The JavaScript Object Notation (JSON) is a lightweight computer data
     interchange format
    - Like XML, it's a text-based, human-readable format for representing
     simple data structures and associative arrays (called objects)
    - It's easier to read, quicker to implement and smaller in size than XML
    - It's a very efficient format for cache
    - It's natively supported by the JavaScript language, making it a perfect
     serialization format for any Ajax application
    - The JSON format is specified in http://tools.ietf.org/html/rfc4627
    - The default text encoding for both JSON and SQLite3 is UTF-8, which
     allows the full Unicode charset to be stored and communicated
    - It is the default data format used by ASP.NET AJAX services created in
     Windows Communication Foundation (WCF) since .NET framework 3.5
    - For binary blob transmission, we simply encode the binary data as hexa
     using the SQLite3 BLOB literals format : hexadecimal data preceded by
     a single "x" or "X" character (for example: X'53514C697465'), or Base64
     encoding - see BlobToTSQLRawBlob() function }


const
  /// maximum number of Tables in a Database Model
  // - this constant is used internaly to optimize memory usage in the
  // generated asm code
  // - you should not change it to a value lower than expected in an existing
  // database (e.g. as expected by TSQLAccessRights or such)
  MAX_SQLTABLES = 256;


type
  /// this is the type to be used for our ORM primary key, i.e. TSQLRecord.ID
  // - it maps the SQLite3 RowID definition
  // - when converted to plain TSQLRecord published properties, you may loose
  // some information under Win32 when stored as a 32-bit pointer
  // - could be defined as value in a TSQLRecord property as such:
  // ! property AnotherRecord: TID read fAnotherRecord write fAnotherRecord;
  TID = type Int64;

  /// a pointer to a ORM primary key, i.e. TSQLRecord.ID: TID
  PID = ^TID;

  /// used to store a dynamic array of ORM primary keys, i.e. TSQLRecord.ID
  TIDDynArray = array of TID;

  /// pointer to a dynamic array of ORM primary keys, i.e. TSQLRecord.ID
  PIDDynArray = ^TIDDynArray;

  /// used to store bit set for all available Tables in a Database Model
  TSQLFieldTables = set of 0..MAX_SQLTABLES-1;

  /// a String used to store the BLOB content
  // - equals RawByteString for byte storage, to force no implicit charset
  // conversion, whatever the codepage of the resulting string is
  // - will identify a sftBlob field type, if used to define such a published
  // property
  // - by default, the BLOB fields are not retrieved or updated with raw
  // TSQLRest.Retrieve() method, that is "Lazy loading" is enabled by default
  // for blobs, unless TSQLRestClientURI.ForceBlobTransfert property is TRUE
  // (for all tables), or ForceBlobTransfertTable[] (for a particular table);
  // so use RetrieveBlob() methods for handling BLOB fields
  // - could be defined as value in a TSQLRecord property as such:
  // ! property Blob: TSQLRawBlob read fBlob write fBlob;
  TSQLRawBlob = type RawByteString;

  /// a reference to another record in any table in the database Model
  // - stored as a 64-bit signed integer (just like the TID type)
  // - type cast any value of TRecordReference with the RecordRef object below
  // for easy access to its content
  // - use TSQLRest.Retrieve(Reference) to get a record value
  // - don't change associated TSQLModel tables order, since TRecordReference
  // depends on it to store the Table type in its highest bits
  // - when the pointed record will be deleted, this property will be set to 0
  // by TSQLRestServer.AfterDeleteForceCoherency()
  // - could be defined as value in a TSQLRecord property as such:
  // ! property AnotherRecord: TRecordReference read fAnotherRecord write fAnotherRecord;
  TRecordReference = type Int64;

  /// a reference to another record in any table in the database Model
  // - stored as a 64-bit signed integer (just like the TID type)
  // - type cast any value of TRecordReference with the RecordRef object below
  // for easy access to its content
  // - use TSQLRest.Retrieve(Reference) to get a record value
  // - don't change associated TSQLModel tables order, since TRecordReference
  // depends on it to store the Table type in its highest bits
  // - when the pointed record will be deleted, any record containg a matching
  // property will be deleted by TSQLRestServer.AfterDeleteForceCoherency()
  // - could be defined as value in a TSQLRecord property as such:
  // ! property AnotherRecord: TRecordReferenceToBeDeleted
  // !   read fAnotherRecord write fAnotherRecord;
  TRecordReferenceToBeDeleted = type TRecordReference;

  /// an Int64-encoded date and time of the latest update of a record
  // - can be used as published property field in TSQLRecord for sftModTime:
  // if any such property is defined in the table, it will be auto-filled with
  // the server timestamp corresponding to the latest record update
  // - use internally for computation an abstract "year" of 16 months of 32 days
  // of 32 hours of 64 minutes of 64 seconds - faster than TDateTime
  // - use TimeLogFromDateTime/TimeLogToDateTime/TimeLogNow/Iso8601ToTimeLog
  // functions, or type-cast the value with a TTimeLogBits memory structure for
  // direct access to its bit-oriented content (or via PTimeLogBits pointer)
  // - could be defined as value in a TSQLRecord property as such:
  // ! property LastModif: TModTime read fLastModif write fLastModif;
  TModTime = type TTimeLog;

  /// an Int64-encoded date and time of the record creation
  // - can be used as published property field in TSQLRecord for sftCreateTime:
  // if any such property is defined in the table, it will be auto-filled with
  // the server timestamp corresponding to the record creation
  // - use internally for computation an abstract "year" of 16 months of 32 days
  // of 32 hours of 64 minutes of 64 seconds - faster than TDateTime
  // - use TimeLogFromDateTime/TimeLogToDateTime/TimeLogNow/Iso8601ToTimeLog
  // functions, or type-cast the value with a TTimeLogBits memory structure for
  // direct access to its bit-oriented content (or via PTimeLogBits pointer)
  // - could be defined as value in a TSQLRecord property as such:
  // ! property CreatedAt: TModTime read fCreatedAt write fCreatedAt;
  TCreateTime = type TTimeLog;

  /// the Int64/TID of the TSQLAuthUser currently logged
  // - can be used as published property field in TSQLRecord for sftSessionUserID:
  // if any such property is defined in the table, it will be auto-filled with
  // the current TSQLAuthUser.ID value at update, or 0 if no session is running
  // - could be defined as value in a TSQLRecord property as such:
  // ! property User: TSessionUserID read fUser write fUser;
  TSessionUserID = type TID;

  /// a monotonic version number, used to track changes on a table
  // - add such a published field to any TSQLRecord will allow tracking of
  // record modifications - note that only a single field of this type should
  // be defined for a given record
  // - note that this published field is NOT part of the record "simple fields":
  // by default, the version won't be retrieved from the DB, nor will be sent
  // from a client - the Engine*() CRUD method will take care of computing the
  // monotonic version number, just before storage to the persistence engine
  // - such a field will use a separated TSQLRecordTableDeletion table to
  // track the deleted items
  // - could be defined as value in a TSQLRecord property as such:
  // ! property TrackedVersion: TRecordVersion read fVersion write fVersion;
  TRecordVersion = type Int64;

  /// the available types for any SQL field property, as managed with the
  // database driver
  // - sftUnknown: unknown or not defined field type
  // - sftAnsiText: a WinAnsi encoded TEXT, forcing a NOCASE collation
  // (TSQLRecord Delphi property was declared as AnsiString or string before
  // Delphi 2009)
  // - sftUTF8Text is UTF-8 encoded TEXT, forcing a SYSTEMNOCASE collation,
  // i.e. using UTF8IComp() (TSQLRecord property was declared as RawUTF8,
  // RawUnicode or WideString - or string in Delphi 2009+) - you may inherit
  // from TSQLRecordNoCase to use the NOCASE standard SQLite3 collation
  //- sftEnumerate is an INTEGER value corresponding to an index in any
  // enumerate Delphi type; storage is an INTEGER value (fast, easy and size
  // efficient); at display, this integer index will be converted into the
  // left-trimed lowercased chars of the enumerated type text conversion:
  // TOpenType(1) = otDone -> 'Done'
  /// - sftSet is an INTEGER value corresponding to a bitmapped set of
  // enumeration; storage is an INTEGER value (fast, easy and size efficient);
  // displayed as an integer by default, sets with an enumeration type with
  // up to 64 elements is allowed yet (stored as an Int64)
  // - sftInteger is an INTEGER (Int64 precision, as expected by SQLite3) field
  // - sftID is an INTEGER field pointing to the ID/RowID of another record of
  // a table, defined by the class type of the TSQLRecord inherited property;
  // coherency is always ensured: after a delete, all values pointing to
  // it is reset to 0
  // - sftRecord is an INTEGER field pointing to the ID/RowID of another
  // record: TRecordReference=Int64 Delphi property which can be typecasted to
  // RecordRef; coherency is always ensured: after a delete, all values
  // pointing to it are reset to 0 by the ORM
  // - sftBoolean is an INTEGER field for a boolean value: 0 is FALSE,
  // anything else TRUE (encoded as JSON 'true' or 'false' constants)
  // - sftFloat is a FLOAT (floating point double precision, cf. SQLite3)
  // field, defined as double (or single) published properties definition
  // - sftDateTime is a ISO 8601 encoded (SQLite3 compatible) TEXT field,
  // corresponding to a TDateTime Delphi property: a ISO8601 collation is
  // forced for such column, for proper date/time sorting and searching
  // - sftDateTimeMS is a ISO 8601 encoded (SQLite3 compatible) TEXT field,
  // corresponding to a TDateTimeMS Delphi property, i.e. a TDateTime with
  // millisecond resolution, serialized with '.sss' suffix: a ISO8601 collation
  // is forced for such column, for proper date/time sorting and searching
  // - sftTimeLog is an INTEGER field for coding a date and time (not SQLite3
  // compatible), which should be defined as TTimeLog=Int64 Delphi property,
  // ready to be typecasted to the TTimeLogBits optimized type for efficient
  // timestamp storage, with a second resolution
  // - sftCurrency is a FLOAT containing a 4 decimals floating point value,
  // compatible with the Currency Delphi type, which minimizes rounding errors
  // in monetary calculations which may occur with sftFloat type
  // - sftObject is a TEXT containing an ObjectToJSON serialization, able to
  // handle published properties of any not TPersistent as JSON object,
  // TStrings or TRawUTF8List as JSON arrays of strings, TCollection or
  // TObjectList as JSON arrays of JSON objects
  // - sftVariant is a TEXT containing a variant value encoded as JSON:
  // string values are stored between quotes, numerical values directly stored,
  // and JSON objects or arrays will be handled as TDocVariant custom types
  // - sftNullable is a INTEGER/DOUBLE/TEXT field containing a NULLable value,
  // stored as a local variant property, identifying TNullableInteger,
  // TNullableBoolean, TNullableFloat, TNullableCurrency,
  // TNullableDateTime, TNullableTimeLog and TNullableUTF8Text types
  // - sftBlob is a BLOB field (TSQLRawBlob Delphi property), and won't be
  // retrieved by default (not part of ORM "simple types"), to save bandwidth
  // - sftBlobDynArray is a dynamic array, stored as BLOB field: this kind of
  // property will be retrieved by default, i.e. is recognized as a "simple
  // field", and will use Base64 encoding during JSON transmission, or a true
  // JSON array, depending on the database back-end (e.g. MongoDB)
  // - sftBlobCustom is a custom property, stored as BLOB field: such
  // properties are defined by adding a TSQLPropInfoCustom instance, overriding
  // TSQLRecord.InternalRegisterCustomProperties virtual method - they will
  // be retrieved by default, i.e. recognized as "simple fields"
  // - sftUTF8Custom is a custom property, stored as JSON in a TEXT field,
  // defined by overriding TSQLRecord.InternalRegisterCustomProperties
  // virtual method, and adding a TSQLPropInfoCustom instance, e.g. via
  // RegisterCustomPropertyFromTypeName() or RegisterCustomPropertyFromRTTI();
  // they will be retrieved by default, i.e. recognized as "simple fields"
  // - sftMany is a 'many to many' field (TSQLRecordMany Delphi property);
  // nothing is stored in the table row, but in a separate pivot table: so
  // there is nothing to retrieve here; in contrast to other TSQLRecord
  // published properties, which contains an INTEGER ID, the TSQLRecord.Create
  // will instanciate a true TSQLRecordMany instance to handle this pivot table
  // via its dedicated ManyAdd/FillMany/ManySelect methods - as a result, such
  // properties won't be retrieved by default, i.e. not recognized as "simple
  // fields" unless you used the dedicated methods
  // - sftModTime is an INTEGER field containing the TModTime value, aka time
  // of the record latest update; TModTime (just like TTimeLog or TCreateTime)
  // published property can be typecasted to the TTimeLogBits memory structure;
  // the value of this field is automatically updated with the current
  // date and time each time a record is updated (with external DB, it will
  // use the Server time, as retrieved from SynDB) - see ComputeFieldsBeforeWrite
  // virtual method of TSQLRecord; note also that only RESTful PUT/POST access
  // will change this field value: manual SQL statements (like
  // 'UPDATE Table SET Column=0') won't change its content; note also that
  // this is automated on Delphi client side, so only within TSQLRecord ORM use
  // (a pure AJAX application should fill such fields explicitely before sending)
  // - sftCreateTime is an INTEGER field containing the TCreateTime time
  // of the record creation; TCreateTime (just like TTimeLog or TModTime)
  // published property can be typecasted to the TTimeLogBits memory structure;
  // the value of this field is automatically updated with the current
  // date and time when the record is created (with external DB, it will
  // use the Server time, as retrieved from SynDB) - see ComputeFieldsBeforeWrite
  // virtual method of TSQLRecord; note also that only RESTful PUT/POST access
  // will set this field value: manual SQL statements (like
  // 'INSERT INTO Table ...') won't set its content; note also that this is
  // automated on Delphi client side, so only within TSQLRecord ORM use (a
  // pure AJAX application should fill such fields explicitely before sending)
  // - sftTID is an INTEGER field containing a TID pointing to another record;
  // since regular TSQLRecord published properties (i.e. sftID kind of field)
  // can not be greater than 2,147,483,647 (i.e. a signed 32-bit value) under
  // Win32, defining TID published properties will allow to store the ID
  // as signed 64-bit, e.g. up to 9,223,372,036,854,775,808; despite to
  // sftID kind of record, coherency is NOT ensured: after a deletion, all
  // values pointing to are NOT reset to 0 - it is up to your business logic
  // to ensure data coherency as expected
  // - sftRecordVersion is an INTEGER field containing a TRecordVersion
  // monotonic number: adding such a published field to any TSQLRecord will
  // allow tracking of record modifications, at storage level; by design,
  // such a field won't be part of "simple types", so won't be transmitted
  // between the clients and the server, but will be updated at any write
  // operation by the low-level Engine*() storage methods - such a field
  // will use a TSQLRecordTableDeletion table to track the deleted items
  // - sftSessionUserID is an INTEGER field containing the TSQLAuthUser.ID
  // of the record modification; the value of this field is automatically
  // updated with the current User ID of the active session; note also that
  // only RESTful PUT/POST access will change this field value: manual SQL
  // statements (like 'UPDATE Table SET Column=0') won't change its content;
  // this is automated on Delphi client side, so only within TSQLRecord ORM use
  // (a pure AJAX application should fill such fields explicitely before sending)
  // - sftUnixTime is an INTEGER field for coding a date and time as second-based
  // Unix Time (SQLite3 compatible), which should be defined as TUnixTime=Int64
  // TSQLRecord property
  // - sftUnixMSTime is an INTEGER field for coding a date and time as
  // millisecond-based Unix Time (JavaScript compatible), which should be
  // defined as TUnixMSTime=Int64 TSQLRecord property
  // - WARNING: do not change the order of items below, otherwise some methods
  // (like TSQLRecordProperties.CheckBinaryHeader) may be broken and fail
  TSQLFieldType = (
    sftUnknown,
    sftAnsiText,
    sftUTF8Text,
    sftEnumerate,
    sftSet,
    sftInteger,
    sftID,
    sftRecord,
    sftBoolean,
    sftFloat,
    sftDateTime,
    sftTimeLog,
    sftCurrency,
    sftObject,
    {$ifndef NOVARIANTS}
    sftVariant,
    sftNullable,
    {$endif}
    sftBlob,
    sftBlobDynArray,
    sftBlobCustom,
    sftUTF8Custom,
    sftMany,
    sftModTime,
    sftCreateTime,
    sftTID,
    sftRecordVersion,
    sftSessionUserID,
    sftDateTimeMS,
    sftUnixTime,
    sftUnixMSTime);

  /// set of available SQL field property types
  TSQLFieldTypes = set of TSQLFieldType;

  //// a fixed array of SQL field property types
  TSQLFieldTypeArray = array[0..MAX_SQLFIELDS] of TSQLFieldType;

  /// contains the parameters used for sorting
  // - FieldCount is 0 if was never sorted
  // - used to sort data again after a successfull data update with TSQLTableJSON.FillFrom()
  TSQLTableSortParams = record
    Comp: TUTF8Compare;
    FieldCount, FieldIndex: integer;
    FieldType: TSQLFieldType;
    Asc: boolean;
  end;

  /// used to define the triggered Event types for TNotifySQLEvent
  // - some Events can be triggered via TSQLRestServer.OnUpdateEvent when
  // a Table is modified, and actions can be authorized via overriding the
  // TSQLRest.RecordCanBeUpdated method
  // - OnUpdateEvent is called BEFORE deletion, and AFTER insertion or update; it
  // should be used only server-side, not to synchronize some clients: the framework
  // is designed around a stateless RESTful architecture (like HTTP/1.1), in which
  // clients ask the server for refresh (see TSQLRestClientURI.UpdateFromServer)
  // - is used also by TSQLRecord.ComputeFieldsBeforeWrite virtual method
  TSQLEvent = (
    seAdd,
    seUpdate,
    seDelete,
    seUpdateBlob);

  /// used to define the triggered Event types for TSQLRecordHistory
  // - TSQLRecordHistory.History will be used for heArchiveBlob
  // - TSQLRecordHistory.SentDataJSON will be used for other kind of events
  TSQLHistoryEvent = (
    heAdd,
    heUpdate,
    heDelete,
    heArchiveBlob);

  /// used to defined the CRUD associated SQL statement of a command
  // - used e.g. by TSQLRecord.GetJSONValues methods and SimpleFieldsBits[] array
  // (in this case, soDelete is never used, since deletion is global for all fields)
  // - also used for cache content notification
  TSQLOccasion = (
    soSelect,
    soInsert,
    soUpdate,
    soDelete);

  /// used to defined a set of CRUD associated SQL statement of a command
  TSQLOccasions = set of TSQLOccasion;

const
  /// kind of fields not retrieved during normal query, update or adding
  // - by definition, BLOB are excluded to save transmission bandwidth
  // - by design, TSQLRecordMany properties are stored in an external pivot table
  // - by convenience, the TRecordVersion number is for internal use only
  NOT_SIMPLE_FIELDS: TSQLFieldTypes =
    [sftUnknown,sftBlob,sftMany,sftRecordVersion];

  /// kind of fields which can be copied from one TSQLRecord instance to another
  COPIABLE_FIELDS: TSQLFieldTypes =
    [low(TSQLFieldType)..high(TSQLFieldType)] - [sftUnknown, sftMany];

  /// kind of DB fields which will contain TEXT content when converted to JSON
  TEXT_DBFIELDS: TSQLDBFieldTypes = [ftUTF8,ftDate];

  /// kind of fields which will contain pure TEXT values
  // - independently from the actual storage level
  // - i.e. will match RawUTF8, string, UnicodeString, WideString properties
  RAWTEXT_FIELDS: TSQLFieldTypes = [sftAnsiText,sftUTF8Text];

  /// kind of fields which will be stored as TEXT values
  // - i.e. RAWTEXT_FIELDS and TDateTime/TDateTimeMS
  STRING_FIELDS: TSQLFieldTypes = [sftAnsiText,sftUTF8Text,sftUTF8Custom,
    sftDateTime,sftDateTimeMS];

{$ifndef NOVARIANTS}
  /// the SQL field property types with their TNullable* equivalency
  // - those types may be stored in a variant published property, e.g.
  // ! property Int: TNullableInteger read fInt write fInt;
  // ! property Txt: TNullableUTF8Text read fTxt write fTxt;
  // ! property Txt: TNullableUTF8Text index 32 read fTxt write fTxt;
  NULLABLE_TYPES = [sftInteger,sftBoolean,sftEnumerate,sftFloat,sftCurrency,
    sftDateTime,sftTimeLog,sftUTF8Text];
{$endif NOVARIANTS}

/// similar to AddInt64() function, but for a TIDDynArray
// - some random GPF were identified with AddInt64(TInt64DynArray(Values),...)
// with the Delphi Win64 compiler
procedure AddID(var Values: TIDDynArray; var ValuesCount: integer; Value: TID); overload;

/// similar to AddInt64() function, but for a TIDDynArray
// - some random GPF were identified with AddInt64(TInt64DynArray(Values),...)
// with the Delphi Win64 compiler
procedure AddID(var Values: TIDDynArray; Value: TID); overload;

type
  /// the available options for TSQLRest.BatchStart() process
  // - boInsertOrIgnore will create 'INSERT OR IGNORE' statements instead of
  // plain 'INSERT' - by now, only the direct mORMotSQLite3 engine supports it
  // - boInsertOrUpdate will create 'INSERT OR REPLACE' statements instead of
  // plain 'INSERT' - by now, only the direct mORMotSQLite3 engine supports it
  // - boExtendedJSON will force the JSON to unquote the column names,
  // e.g. writing col1:...,col2:... instead of "col1":...,"col2"...
  // - boPostNoSimpleFields will avoid to send a TSQLRestBach.Add() with simple
  // fields as "SIMPLE":[val1,val2...] or "SIMPLE@tablename":[val1,val2...],
  // without the field names
  // - boPutNoCacheFlush won't force the associated Cache entry to be flushed:
  // it is up to the caller to ensure cache coherency
  // - boRollbackOnError will raise an exception and Rollback any transaction
  // if any step failed - default if to continue batch processs, but setting
  // a value <> 200/HTTP_SUCCESS in Results[]
  TSQLRestBatchOption = (
    boInsertOrIgnore, boInsertOrReplace,
    boExtendedJSON, boPostNoSimpleFields, boPutNoCacheFlush,
    boRollbackOnError);

  /// a set of options for TSQLRest.BatchStart() process
  // - TJSONObjectDecoder will use it to compute the corresponding SQL
  TSQLRestBatchOptions = set of TSQLRestBatchOption;

  /// define how TJSONObjectDecoder.Decode() will handle JSON string values
  TJSONObjectDecoderParams = (pInlined, pQuoted, pNonQuoted);

  /// define how TJSONObjectDecoder.FieldTypeApproximation[] is identified
  TJSONObjectDecoderFieldType = (
    ftaNumber,ftaBoolean,ftaString,ftaDate,ftaNull,ftaBlob,ftaObject,ftaArray);

  /// JSON object decoding and SQL generation, in the context of ORM process
  // - this is the main process for marshalling JSON into SQL statements
  // - used e.g. by GetJSONObjectAsSQL() function or ExecuteFromJSON and
  // InternalBatchStop methods
  {$ifdef USERECORDWITHMETHODS}TJSONObjectDecoder = record
    {$else}TJSONObjectDecoder = object{$endif}
  public
    /// contains the decoded field names
    FieldNames: array[0..MAX_SQLFIELDS-1] of RawUTF8;
    /// contains the decoded field values
    FieldValues: array[0..MAX_SQLFIELDS-1] of RawUTF8;
    /// Decode() will set each field type approximation
    // - will recognize also JSON_BASE64_MAGIC/JSON_SQLDATE_MAGIC prefix
    FieldTypeApproximation: array[0..MAX_SQLFIELDS-1] of TJSONObjectDecoderFieldType;
    /// number of fields decoded in FieldNames[] and FieldValues[]
    FieldCount: integer;
    /// set to TRUE if parameters are to be :(...): inlined
    InlinedParams: TJSONObjectDecoderParams;
    /// internal pointer over field names to be used after Decode() call
    // - either FieldNames, either Fields[] array as defined in Decode(), or
    // external names as set by TSQLRestStorageExternal.JSONDecodedPrepareToSQL
    DecodedFieldNames: PRawUTF8Array;
    /// the ID=.. value as sent within the JSON object supplied to Decode()
    DecodedRowID: TID;
    /// internal pointer over field types to be used after Decode() call
    // - to create 'INSERT INTO ... SELECT UNNEST(...)' or 'UPDATE ... FROM
    // SELECT UNNEST(...)' statements for very efficient bulk writes in a
    // PostgreSQL database
    // - as set by TSQLRestStorageExternal.JSONDecodedPrepareToSQL when
    // cPostgreBulkArray flag is detected (for SynDBPostgres)
    DecodedFieldTypesToUnnest: PSQLDBFieldTypeArray;
    /// decode the JSON object fields into FieldNames[] and FieldValues[]
    // - if Fields=nil, P should be a true JSON object, i.e. defined
    // as "COL1"="VAL1" pairs, stopping at '}' or ']'; otherwise, Fields[]
    // contains column names and expects a JSON array as "VAL1","VAL2".. in P
    // - P should be after the initial '{' or '[' character, i.e. at first field
    // - P returns the next object start or nil on unexpected end of input
    // - P^ buffer will let the JSON be decoded in-place, so consider using
    // the overloaded Decode(JSON: RawUTF8; ...) method
    // - FieldValues[] strings will be quoted and/or inlined depending on Params
    // - if RowID is set, a RowID column will be added within the returned content
    procedure Decode(var P: PUTF8Char; const Fields: TRawUTF8DynArray;
      Params: TJSONObjectDecoderParams; const RowID: TID=0; ReplaceRowIDWithID: Boolean=false); overload;
    /// decode the JSON object fields into FieldNames[] and FieldValues[]
    // - overloaded method expecting a RawUTF8 buffer, making a private copy
    // of the JSON content to avoid unexpected in-place modification, then
    // calling Decode(P: PUTF8Char) to perform the process
    procedure Decode(const JSON: RawUTF8; const Fields: TRawUTF8DynArray;
      Params: TJSONObjectDecoderParams; const RowID: TID=0; ReplaceRowIDWithID: Boolean=false); overload;
    /// can be used after Decode() to add a new field in FieldNames/FieldValues
    // - so that EncodeAsSQL() will include this field in the generated SQL
    // - caller should ensure that the FieldName is not already defined in
    // FieldNames[] (e.g. when the TRecordVersion field is forced)
    // - the caller should ensure that the supplied FieldValue will match
    // the quoting/inlining expectations of Decode(TJSONObjectDecoderParams) -
    // e.g. that string values are quoted if needed
    procedure AddFieldValue(const FieldName,FieldValue: RawUTF8;
      FieldType: TJSONObjectDecoderFieldType);
    /// encode as a SQL-ready INSERT or UPDATE statement
    // - after a successfull call to Decode()
    // - escape SQL strings, according to the official SQLite3 documentation
    // (i.e. ' inside a string is stored as '')
    // - if InlinedParams was TRUE, it will create prepared parameters like
    // 'COL1=:("VAL1"):, COL2=:(VAL2):'
    // - called by GetJSONObjectAsSQL() function or TSQLRestStorageExternal
    function EncodeAsSQL(Update: boolean): RawUTF8;
    /// encode as a SQL-ready INSERT or UPDATE statement with ? as values
    // - after a successfull call to Decode()
    // - FieldValues[] content will be ignored
    // - Occasion can be only soInsert or soUpdate
    // - for soUpdate, will create UPDATE ... SET ... where UpdateIDFieldName=?
    // - you can specify some options, e.g. boInsertOrIgnore for soInsert
    function EncodeAsSQLPrepared(const TableName: RawUTF8; Occasion: TSQLOccasion;
      const UpdateIDFieldName: RawUTF8; BatchOptions: TSQLRestBatchOptions): RawUTF8;
    /// encode the FieldNames/FieldValues[] as a JSON object
    procedure EncodeAsJSON(out result: RawUTF8);
    /// set the specified array to the fields names
    // - after a successfull call to Decode()
    procedure AssignFieldNamesTo(var Fields: TRawUTF8DynArray);
    /// returns TRUE if the specified array match the decoded fields names
    // - after a successfull call to Decode()
    function SameFieldNames(const Fields: TRawUTF8DynArray): boolean;
    /// search for a field name in the current identified FieldNames[]
    function FindFieldName(const FieldName: RawUTF8): integer;
  end;

/// set the TID (=64-bit integer) value from the numerical text stored in P^
// - just a redirection to SynCommons.SetInt64()
procedure SetID(P: PUTF8Char; var result: TID); overload;
  {$ifdef HASINLINENOTX86}inline;{$endif}

/// set the TID (=64-bit integer) value from the numerical text stored in U
// - just a redirection to SynCommons.SetInt64()
procedure SetID(const U: RawByteString; var result: TID); overload;
  {$ifdef HASINLINENOTX86}inline;{$endif}

/// TDynArraySortCompare compatible function, sorting by TSQLRecord.ID
function TSQLRecordDynArrayCompare(const Item1,Item2): integer;

/// TDynArrayHashOne compatible function, hashing TSQLRecord.ID
function TSQLRecordDynArrayHashOne(const Elem; Hasher: THasher): cardinal;

/// decode JSON fields object into an UTF-8 encoded SQL-ready statement
// - this function decodes in the P^ buffer memory itself (no memory allocation
// or copy), for faster process - so take care that it is an unique string
// - P should be after the initial '{' or '[' character, i.e. at first field
// - P contains the next object start or nil on unexpected end of input
// - if Fields is void, expects expanded "COL1"="VAL1" pairs in P^, stopping at '}' or ']'
// - otherwise, Fields[] contains the column names and expects "VAL1","VAL2".. in P^
// - returns 'COL1="VAL1", COL2=VAL2' if UPDATE is true (UPDATE SET format)
// - returns '(COL1, COL2) VALUES ("VAL1", VAL2)' otherwise (INSERT format)
// - escape SQL strings, according to the official SQLite3 documentation
// (i.e. ' inside a string is stored as '')
// - if InlinedParams is set, will create prepared parameters like
// 'COL1=:("VAL1"):, COL2=:(VAL2):'
// - if RowID is set, a RowID column will be added within the returned content
function GetJSONObjectAsSQL(var P: PUTF8Char; const Fields: TRawUTF8DynArray;
  Update, InlinedParams: boolean; RowID: TID=0; ReplaceRowIDWithID: Boolean=false): RawUTF8; overload;

/// decode JSON fields object into an UTF-8 encoded SQL-ready statement
// - is used e.g. by TSQLRestServerDB.EngineAdd/EngineUpdate methods
// - expect a regular JSON expanded object as "COL1"="VAL1",...} pairs
// - make its own temporary copy of JSON data before calling GetJSONObjectAsSQL() above
// - returns 'COL1="VAL1", COL2=VAL2' if UPDATE is true (UPDATE SET format)
// - returns '(COL1, COL2) VALUES ("VAL1", VAL2)' otherwise (INSERT format)
// - if InlinedParams is set, will create prepared parameters like 'COL2=:(VAL2):'
// - if RowID is set, a RowID column will be added within the returned content
function GetJSONObjectAsSQL(const JSON: RawUTF8; Update, InlinedParams: boolean;
  RowID: TID=0; ReplaceRowIDWithID: Boolean=false): RawUTF8; overload;

/// get the FIRST field value of the FIRST row, from a JSON content
// - e.g. useful to get an ID without converting a JSON content into a TSQLTableJSON
function UnJSONFirstField(var P: PUTF8Char): RawUTF8;

/// returns TRUE if the JSON content is in expanded format
// - i.e. as plain [{"ID":10,"FirstName":"John","LastName":"Smith"}...]
// - i.e. not as '{"fieldCount":3,"values":["ID","FirstName","LastName",...']}
function IsNotAjaxJSON(P: PUTF8Char): Boolean;

/// retrieve a JSON '{"Name":Value,....}' object
// - P is nil in return in case of an invalid object
// - returns the UTF-8 encoded JSON object, including first '{' and last '}'
// - if ExtractID is set, it will contain the "ID":203 field value, and this
// field won't be included in the resulting UTF-8 encoded JSON object unless
// KeepIDField is true
// - this function expects this "ID" property to be the FIRST in the
// "Name":Value pairs, as generated by TSQLRecord.GetJSONValues(W)
function JSONGetObject(var P: PUTF8Char; ExtractID: PID;
  var EndOfObject: AnsiChar; KeepIDField: boolean): RawUTF8;

/// retrieve the ID/RowID field of a JSON object
// - this function expects this "ID" property to be the FIRST in the
// "Name":Value pairs, as generated by TSQLRecord.GetJSONValues(W)
// - returns TRUE if a ID/RowID>0 has been found, and set ID with the value
function JSONGetID(P: PUTF8Char; out ID: TID): Boolean;

/// fill a TSQLRawBlob from TEXT-encoded blob data
// - blob data can be encoded as SQLite3 BLOB literals (X'53514C697465' e.g.) or
// or Base-64 encoded content ('\uFFF0base64encodedbinary') or plain TEXT
function BlobToTSQLRawBlob(P: PUTF8Char): TSQLRawBlob; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill a TSQLRawBlob from TEXT-encoded blob data
// - blob data can be encoded as SQLite3 BLOB literals (X'53514C697465' e.g.) or
// or Base-64 encoded content ('\uFFF0base64encodedbinary') or plain TEXT
procedure BlobToTSQLRawBlob(P: PUTF8Char; var result: TSQLRawBlob); overload;

/// fill a TSQLRawBlob from TEXT-encoded blob data
// - blob data can be encoded as SQLite3 BLOB literals (X'53514C697465' e.g.) or
// or Base-64 encoded content ('\uFFF0base64encodedbinary') or plain TEXT
function BlobToTSQLRawBlob(const Blob: RawByteString): TSQLRawBlob; overload;

/// create a TBytes from TEXT-encoded blob data
// - blob data can be encoded as SQLite3 BLOB literals (X'53514C697465' e.g.) or
// or Base-64 encoded content ('\uFFF0base64encodedbinary') or plain TEXT
function BlobToBytes(P: PUTF8Char): TBytes;

/// create a memory stream from TEXT-encoded blob data
// - blob data can be encoded as SQLite3 BLOB literals (X'53514C697465' e.g.) or
// or Base-64 encoded content ('\uFFF0base64encodedbinary') or plain TEXT
// - the caller must free the stream instance after use
function BlobToStream(P: PUTF8Char): TStream;

/// creates a TEXT-encoded version of blob data from a TSQLRawBlob
// - TEXT will be encoded as SQLite3 BLOB literals (X'53514C697465' e.g.)
function TSQLRawBlobToBlob(const RawBlob: TSQLRawBlob): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a TEXT-encoded version of blob data from a memory data
// - same as TSQLRawBlob, but with direct memory access via a pointer/byte size pair
// - TEXT will be encoded as SQLite3 BLOB literals (X'53514C697465' e.g.)
function TSQLRawBlobToBlob(RawBlob: pointer; RawBlobLength: integer): RawUTF8; overload;

/// convert a Base64-encoded content into binary hexadecimal ready for SQL
// - returns e.g. X'53514C697465'
procedure Base64MagicToBlob(Base64: PUTF8Char; var result: RawUTF8);

/// return true if the TEXT is encoded as SQLite3 BLOB literals (X'53514C697465' e.g.)
function isBlobHex(P: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// compute the SQL corresponding to a WHERE clause
// - returns directly the Where value if it starts with one the
// ORDER/GROUP/LIMIT/OFFSET/JOIN keywords
// - otherwise, append ' WHERE '+Where
function SQLFromWhere(const Where: RawUTF8): RawUTF8;

/// find out if the supplied WHERE clause starts with one of the
// ORDER/GROUP/LIMIT/OFFSET/JOIN keywords
function SQLWhereIsEndClause(const Where: RawUTF8): boolean;

/// compute 'PropName in (...)' where clause for a SQL statement
// - if Values has no value, returns ''
// - if Values has a single value, returns 'PropName="Values0"' or inlined
// 'PropName=:("Values0"):' if ValuesInlined is true
// - if Values has more than one value, returns 'PropName in ("Values0","Values1",...)'
// or 'PropName in (:("Values0"):,:("Values1"):,...)' if length(Values)<ValuesInlinedMax
// - PropName can be used as a prefix to the 'in ()' clause, in conjunction
// with optional Suffix value
function SelectInClause(const PropName: RawUTF8; const Values: array of RawUTF8;
  const Suffix: RawUTF8=''; ValuesInlinedMax: integer=0): RawUTF8; overload;

/// compute 'PropName in (...)' where clause for a SQL statement
// - if Values has no value, returns ''
// - if Values has a single value, returns 'PropName=Values0' or inlined
// 'PropName=:(Values0):' if ValuesInlined is bigger than 1
// - if Values has more than one value, returns 'PropName in (Values0,Values1,...)'
// or 'PropName in (:(Values0):,:(Values1):,...)' if length(Values)<ValuesInlinedMax
// - PropName can be used as a prefix to the 'in ()' clause, in conjunction
// with optional Suffix value
function SelectInClause(const PropName: RawUTF8; const Values: array of Int64;
  const Suffix: RawUTF8=''; ValuesInlinedMax: integer=0): RawUTF8; overload;

/// naive search of '... FROM TableName ...' pattern in the supplied SQL
function GetTableNameFromSQLSelect(const SQL: RawUTF8;
  EnsureUniqueTableInFrom: boolean): RawUTF8;

/// naive search of '... FROM Table1,Table2 ...' pattern in the supplied SQL
function GetTableNamesFromSQLSelect(const SQL: RawUTF8): TRawUTF8DynArray;

/// guess the content type of an UTF-8 encoded field value, as used in TSQLTable.Get()
// - if P if nil or 'null', return sftUnknown
// - otherwise, guess its type from its value characters
// - sftBlob is returned if the field is encoded as SQLite3 BLOB literals
// (X'53514C697465' e.g.) or with '\uFFF0' magic code
// - since P is PUTF8Char, string type is sftUTF8Text only
// - sftFloat is returned for any floating point value, even if it was
// declared as sftCurrency type
// - sftInteger is returned for any INTEGER stored value, even if it was declared
// as sftEnumerate, sftSet, sftID, sftTID, sftRecord, sftRecordVersion,
// sftSessionUserID, sftBoolean, sftModTime/sftCreateTime/sftTimeLog or
// sftUnixTime/sftUnixMSTime type
function UTF8ContentType(P: PUTF8Char): TSQLFieldType;

/// guess the number type of an UTF-8 encoded field value, as used in TSQLTable.Get()
// - if P if nil or 'null', return sftUnknown
// - will return sftInteger or sftFloat if the supplied text is a number
// - will return sftUTF8Text for any non numerical content
function UTF8ContentNumberType(P: PUTF8Char): TSQLFieldType;
  {$ifdef HASINLINE}inline;{$endif}


/// read an object properties, as saved by TINIWriter.WriteObject() method
// - i.e. only Integer, Int64, enumerates (including boolean), floating point,
// variant and (Ansi/Wide/Unicode)String properties (excluding shortstring)
// - read only the published properties of the current class level (do NOT
// read the properties content published in the parent classes)
// - "From" must point to the [section] containing the object properties
// - for integers and enumerates, if no value is stored in From (or From is ''),
// the default value from the property definition is set
procedure ReadObject(Value: TObject; From: PUTF8Char; const SubCompName: RawUTF8=''); overload;

/// read an object properties, as saved by TINIWriter.WriteObject() method
// - i.e. only Integer, Int64, enumerates (including boolean), floating point values
// and (Ansi/Wide/Unicode)String properties (excluding shortstring)
// - read only the published properties of the current class level (do NOT
// read the properties content published in the parent classes)
// - for integers, if no value is stored in FromContent, the default value is set
// - this version gets the appropriate section from [Value.ClassName]
// - this version doesn't handle embedded objects
procedure ReadObject(Value: TObject; const FromContent: RawUTF8;
  const SubCompName: RawUTF8=''); overload;

/// write an object properties, as saved by TINIWriter.WriteObject() method
// - i.e. only Integer, Int64, enumerates (including boolean), floating point values
// and (Ansi/Wide/Unicode)String properties (excluding shortstring)
// - write only the published properties of the current class level (do NOT
// write the properties content published in the parent classes)
// - direct update of INI-like content
// - for integers, value is always written, even if matches the default value
procedure WriteObject(Value: TObject; var IniContent: RawUTF8;
  const Section: RawUTF8; const SubCompName: RawUTF8=''); overload;

/// write an object properties, as saved by TINIWriter.WriteObject() method
// - i.e. only Integer, Int64, enumerates (including boolean), floating point values
// and (Ansi/Wide/Unicode)String properties (excluding shortstring)
// - write only the published properties of the current class level (do NOT
// write the properties content published in the parent classes)
// - return the properties as text Name=Values pairs, with no section
// - for integers, if the value matches the default value, it is not added to the result
function WriteObject(Value: TObject): RawUTF8; overload;

/// copy object properties
// - copy Integer, Int64, enumerates (including boolean), variant, records,
// dynamic arrays, classes and any string properties (excluding shortstring)
// - TCollection items can be copied also, if they are of the same exact class
// - object properties instances are created in aTo if the objects are not
// TSQLRecord children (in this case, these are not class instances, but
// INTEGER reference to records, so only the integer value is copied), that is
// for regular Delphi classes
procedure CopyObject(aFrom, aTo: TObject); overload;

/// create a new object instance, from an existing one
// - will create a new instance of the same class, then call the overloaded
// CopyObject() procedure to copy its values
function CopyObject(aFrom: TObject): TObject; overload;

/// copy two TStrings instances
// - will just call Dest.Assign(Source) in practice
procedure CopyStrings(Source, Dest: TStrings);

{$ifndef LVCL}
/// copy two TCollection instances
// - will call CopyObject() in loop to repopulate the Dest collection,
// which will work even if Assign() method was not overriden
procedure CopyCollection(Source, Dest: TCollection);
{$endif}

/// set any default integer or enumerates (including boolean) published
// properties values for a TPersistent/TSynPersistent
// - set only the values set as "property ... default ..." at class type level
// - will also reset the published properties of the nested classes
procedure SetDefaultValuesObject(Value: TObject);

/// returns TRUE on a nil instance or if all its published properties are default/0
// - calls internally TPropInfo.IsDefaultOrVoid()
function IsObjectDefaultOrVoid(Value: TObject): boolean;

/// will reset all the object properties to their default
// - strings will be set to '', numbers to 0
// - if FreeAndNilNestedObjects is the default FALSE, will recursively reset
// all nested class properties values
// - if FreeAndNilNestedObjects is TRUE, will FreeAndNil() all the nested
// class properties
// - for a TSQLRecord, use its ClearProperties method instead, which will
// handle the ID property, and any nested JOINed instances
procedure ClearObject(Value: TObject; FreeAndNilNestedObjects: boolean=false);

/// persist a class instance into a JSON file
// - returns TRUE on success, false on error (e.g. the file name is invalid
// or the file is existing and could not be overwritten)
function ObjectToJSONFile(Value: TObject; const JSONFile: TFileName;
  Options: TTextWriterWriteObjectOptions=[woHumanReadable]): boolean;

/// will serialize any TObject into its expanded UTF-8 JSON representation
// - includes debugger-friendly information, similar to TSynLog, i.e.
// class name and sets/enumerates as text
// - could be used to create a TDocVariant object with full information
// - wrapper around ObjectToJSON(Value,[woDontStoreDefault,woFullExpand])
// also able to serialize plain Exception as a simple '{"Exception":"Message"}',
// and append .map/.mab source code line number for ESynException
function ObjectToJSONDebug(Value: TObject; Options: TTextWriterWriteObjectOptions=
  [woDontStoreDefault,woHumanReadable,woStoreClassName,woStorePointer]): RawUTF8;

/// will serialize any TObject into a TDocVariant debugging document
// - just a wrapper around _JsonFast(ObjectToJSONDebug()) with an optional
// "Context":"..." text message
// - if the supplied context format matches '{....}' then it will be added
// as a corresponding TDocVariant JSON object
function ObjectToVariantDebug(Value: TObject;
  const ContextFormat: RawUTF8; const ContextArgs: array of const;
  const ContextName: RawUTF8='context'): variant; overload;

/// will serialize any TObject into a TDocVariant debugging document
// - just a wrapper around _JsonFast(ObjectToJSONDebug())
function ObjectToVariantDebug(Value: TObject): variant; overload;

/// add the property values of a TObject to a document-based object content
// - if Obj is a TDocVariant object, then all Values's published
// properties will be added at the root level of Obj
procedure _ObjAddProps(Value: TObject; var Obj: variant); overload;

/// is able to compare two objects by value
// - both instances may or may not be of the same class, but properties
// should match
// - will use direct RTTI access of property values, or TSQLRecord.SameValues()
// if available to make the comparison as fast and accurate as possible
// - if you want only to compare the plain fields with no getter function,
// e.g. if they are just some conversion of the same information, you can
// set ignoreGetterFields=TRUE
function ObjectEquals(Value1,Value2: TObject; ignoreGetterFields: boolean=false): boolean;

type
  /// available options for JSONToObject() parsing process
  // - by default, function will fail if a JSON field name is not part of the
  // object published properties, unless j2oIgnoreUnknownProperty is defined -
  // this option will also ignore read-only properties (i.e. with only a getter)
  // - by default, function will check that the supplied JSON value will
  // be a JSON string when the property is a string, unless j2oIgnoreStringType
  // is defined and JSON numbers are accepted and stored as text
  // - by default any unexpected value for enumerations will be marked as
  // invalid, unless j2oIgnoreUnknownEnum is defined, so that in such case the
  // ordinal 0 value is left, and loading continues
  // - by default, only simple kind of variant types (string/numbers) are
  // handled: set j2oHandleCustomVariants if you want to handle any custom -
  // in this case , it will handle direct JSON [array] of {object}: but if you
  // also define j2oHandleCustomVariantsWithinString, it will also try to
  // un-escape a JSON string first, i.e. handle "[array]" or "{object}" content
  // (may be used e.g. when JSON has been retrieved from a database TEXT column)
  // - by default, a temporary instance will be created if a published field
  // has a setter, and the instance is expected to be released later by the
  // owner class: set j2oSetterExpectsToFreeTempInstance to let JSONToObject
  // (and TPropInfo.ClassFromJSON) release it when the setter returns, and
  // j2oSetterNoCreate to avoid the published field instance creation
  // - set j2oAllowInt64Hex to let Int64/QWord fields accept hexadecimal string
  // (as generated e.g. via the woInt64AsHex option)
  TJSONToObjectOption = (
    j2oIgnoreUnknownProperty, j2oIgnoreStringType, j2oIgnoreUnknownEnum,
    j2oHandleCustomVariants, j2oHandleCustomVariantsWithinString,
    j2oSetterExpectsToFreeTempInstance, j2oSetterNoCreate, j2oAllowInt64Hex);
  /// set of options for JSONToObject() parsing process
  TJSONToObjectOptions = set of TJSONToObjectOption;

const
  /// some open-minded options for JSONToObject() parsing
  // - won't block JSON unserialization due to some minor class type definitions
  // - used e.g. by TObjArraySerializer.CustomReader and
  // TInterfacedObjectFake.FakeCall/TServiceMethodExecute.ExecuteJson methods
  JSONTOOBJECT_TOLERANTOPTIONS = [j2oHandleCustomVariants,j2oIgnoreUnknownEnum,
    j2oIgnoreUnknownProperty,j2oIgnoreStringType,j2oAllowInt64Hex];

/// read an object properties, as saved by ObjectToJSON function
// - ObjectInstance must be an existing TObject instance
// - the data inside From^ is modified in-place (unescaped and transformed):
// calling JSONToObject(pointer(JSONRawUTF8)) will change the JSONRawUTF8
// variable content, which may not be what you expect - consider using the
// ObjectLoadJSON() function instead
// - handle Integer, Int64, enumerate (including boolean), set, floating point,
// TDateTime, TCollection, TStrings, TRawUTF8List, variant, and string properties
// (excluding ShortString, but including WideString and UnicodeString under
// Delphi 2009+)
// - TList won't be handled since it may leak memory when calling TList.Clear
// - won't handle TObjectList (even if ObjectToJSON is able to serialize
// them) since has no way of knowing the object type to add (TCollection.Add
// is missing), unless: 1. you set the TObjectListItemClass property as expected,
// and provide a TObjectList object, or 2. woStoreClassName option has been
// used at ObjectToJSON() call and the corresponding classes have been previously
// registered by TJSONSerializer.RegisterClassForJSON() (or Classes.RegisterClass)
// - will clear any previous TCollection objects, and convert any null JSON
// basic type into nil - e.g. if From='null', will call FreeAndNil(Value)
// - you can add some custom (un)serializers for ANY Delphi class, via the
// TJSONSerializer.RegisterCustomSerializer() class method
// - set Valid=TRUE on success, Valid=FALSE on error, and the main function
// will point in From at the syntax error place (e.g. on any unknown property name)
// - caller should explicitely perform a SetDefaultValuesObject(Value) if
// the default values are expected to be set before JSON parsing
function JSONToObject(var ObjectInstance; From: PUTF8Char; out Valid: boolean;
  TObjectListItemClass: TClass=nil; Options: TJSONToObjectOptions=[]): PUTF8Char;

/// parse the supplied JSON with some tolerance about Settings format
// - will make a TSynTempBuffer copy for parsing, and un-comment it
// - returns true if the supplied JSON was successfully retrieved
// - returns false and set InitialJsonContent := '' on error
function JSONSettingsToObject(var InitialJsonContent: RawUTF8; Instance: TObject): boolean;

/// read an object properties, as saved by ObjectToJSON function
// - ObjectInstance must be an existing TObject instance
// - this overloaded version will make a private copy of the supplied JSON
// content (via TSynTempBuffer), to ensure the original buffer won't be modified
// during process, before calling safely JSONToObject()
// - will return TRUE on success, or FALSE if the supplied JSON was invalid
function ObjectLoadJSON(var ObjectInstance; const JSON: RawUTF8;
  TObjectListItemClass: TClass=nil; Options: TJSONToObjectOptions=[]): boolean;

/// create a new object instance, as saved by ObjectToJSON(...,[...,woStoreClassName,...]);
// - JSON input should be either 'null', either '{"ClassName":"TMyClass",...}'
// - woStoreClassName option shall have been used at ObjectToJSON() call
// - and the corresponding class shall have been previously registered by
// TJSONSerializer.RegisterClassForJSON(), in order to retrieve the class type
// from it name - or, at least, by a Classes.RegisterClass() function call
// - the data inside From^ is modified in-place (unescaped and transformed):
// don't call JSONToObject(pointer(JSONRawUTF8)) but makes a temporary copy of
// the JSON text buffer before calling this function, if want to reuse it later
function JSONToNewObject(var From: PUTF8Char; var Valid: boolean;
  Options: TJSONToObjectOptions=[]): TObject;

/// decode a specified parameter compatible with URI encoding into its original
// object contents
// - ObjectInstance must be an existing TObject instance
// - will call internaly JSONToObject() function to unserialize its content
// - UrlDecodeExtended('price=20.45&where=LastName%3D%27M%C3%B4net%27','PRICE=',P,@Next)
// will return Next^='where=...' and P=20.45
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeObject(U: PUTF8Char; Upper: PAnsiChar; var ObjectInstance; Next: PPUTF8Char=nil;
  Options: TJSONToObjectOptions=[]): boolean;

/// fill the object properties from a JSON file content
// - ObjectInstance must be an existing TObject instance
// - this function will call RemoveCommentsFromJSON() before process
function JSONFileToObject(const JSONFile: TFileName; var ObjectInstance;
  TObjectListItemClass: TClass=nil; Options: TJSONToObjectOptions=[]): boolean;



{ ************ some RTTI and SQL mapping routines }

type
  /// the class kind as handled by TClassInstance object
  TClassInstanceItemCreate = (
    cicUnknown,cicTSQLRecord,cicTObjectList,cicTPersistentWithCustomCreate,
    cicTSynPersistent,cicTInterfacedCollection,cicTInterfacedObjectWithCustomCreate,
    cicTCollection,cicTCollectionItem,cicTComponent,cicTObject);

  /// store information about a class, able to easily create new instances
  // - using this temporary storage will speed up the creation process
  // - any virtual constructor will be used, including for TCollection types
  {$ifdef USERECORDWITHMETHODS}TClassInstance = record
    {$else}TClassInstance = object{$endif}
  public
    /// the class type itself
    ItemClass: TClass;
    // how the class instance is expected to be created
    ItemCreate: TClassInstanceItemCreate;
    {$ifndef LVCL}
    /// for TCollection instances, the associated TCollectionItem class
    CollectionItemClass: TCollectionItemClass;
    {$endif}
    /// fill the internal information fields for a given class type
    procedure Init(C: TClass);
    /// create a new instance of the registered class
    function CreateNew: TObject;
    /// compute the custom JSON commentary corresponding to this class
    procedure SetCustomComment(var CustomComment: RawUTF8);
  end;
  /// points to information about a class, able to create new instances
  PClassInstance = ^TClassInstance;

{$ifdef FPC}
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} // e.g. for ARM
    {$PACKRECORDS C}
  {$else}
    {$A-}
  {$endif}
{$else}
  {$A-} // Delphi compiler use packed/unaligned structs for most internal types
{$endif FPC}

type
  {$ifndef FPC}
  PMethod = ^TMethod; // not defined on older Delphi revisions
  {$endif FPC}
  PTypeInfo = ^TTypeInfo;
  {$ifdef HASDIRECTTYPEINFO} // you should use inlined Deref() function below
  PPTypeInfo = PTypeInfo;
  {$else}
  PPTypeInfo = ^PTypeInfo;
  {$endif HASDIRECTTYPEINFO}
  PTypeInfoDynArray = array of PTypeInfo;
  PPropInfo = ^TPropInfo;
  PMethodInfo = ^TMethodInfo;
  TClassArray = array[0..MaxInt div SizeOf(TClass)-1] of TClass;
  PClassArray = ^TClassArray;

  /// used to store a chain of properties RTTI
  // - could be used e.g. by TSQLPropInfo to handled flattened properties
  PPropInfoDynArray = array of PPropInfo;

  /// pointer to TClassProp
  PClassProp = ^TClassProp;
  /// a wrapper to published properties of a class
  // - start enumeration by getting a PClassProp with ClassProp()
  // - use PropCount, P := @PropList to get the first PPropInfo, and then P^.Next
  // - this enumeration is very fast and doesn't require any temporary memory,
  //  as in the TypInfo.GetPropInfos() PPropList usage
  // - for TSQLRecord, you should better use the RecordProps.Fields[] array,
  // which is faster and contains the properties published in parent classes
  {$ifdef USERECORDWITHMETHODS}TClassProp = record
    {$else}TClassProp = object{$endif}
  public
    /// number of published properties in this object
    PropCount: Word;
    /// point to a TPropInfo packed array
    // - layout is as such, with variable TPropInfo storage size:
    // ! PropList: array[1..PropCount] of TPropInfo
    // - use TPropInfo.Next to get the next one:
    // ! P := @PropList;
    // ! for i := 1 to PropCount do begin
    // !   // ... do something with P
    // !   P := P^.Next;
    // ! end;
    PropList: record end;
    /// retrieve a Field property RTTI information from a Property Name
    function FieldProp(const PropName: shortstring): PPropInfo;
  end;

  PClassType = ^TClassType;
  /// a wrapper to class type information, as defined by the Delphi RTTI
  {$ifdef USERECORDWITHMETHODS}TClassType = record
    {$else}TClassType = object{$endif}
  public
    /// the class type
    ClassType: TClass;
    /// the parent class type information
    ParentInfo: PPTypeInfo;
    /// the number of published properties
    PropCount: SmallInt;
    /// the name (without .pas extension) of the unit were the class was defined
    // - then the PClassProp follows: use the method ClassProp to retrieve its
    // address
    UnitName: string[255];
    /// get the information about the published properties of this class
    // - stored after UnitName memory
    function ClassProp: PClassProp;
      {$ifdef HASINLINE}inline;{$endif}
    /// fast and easy find if this class inherits from a specific class type
    // - you should rather consider using TTypeInfo.InheritsFrom directly
    function InheritsFrom(AClass: TClass): boolean;
    /// return the size (in bytes) of this class type information
    // - can be used to create class types at runtime
    function RTTISize: integer;
  end;

  PEnumType = ^TEnumType;
  /// a wrapper to enumeration type information, as defined by the Delphi RTTI
  // - we use this to store the enumeration values as integer, but easily provide
  // a text equivalent, translated if necessary, from the enumeration type
  // definition itself
  {$ifdef USERECORDWITHMETHODS}TEnumType = record
    {$else}TEnumType = object{$endif}
  public
    /// specify ordinal storage size and sign
    // - is prefered to MaxValue to identify the number of stored bytes
    OrdType: TOrdType;
    {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    EnumDummy: DWORD; // needed on ARM for correct alignment !!??
    {$endif}
    { this seemingly extraneous inner record is here for alignment purposes, so
    that its data gets aligned properly (if FPC_REQUIRES_PROPER_ALIGNMENT is set) }
    {$ifdef FPC_ENUMHASINNER}
    inner:
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    {$endif}
    {$ifdef FPC_ENUMHASINNER}
      iMinValue: Longint;
      iMaxValue: Longint;
      iBaseType: PPTypeInfo;
    end;
    {$else}
    /// first value of enumeration type, typicaly 0
    MinValue: Longint;
    /// same as ord(high(type)): not the enumeration count, but the highest index
    MaxValue: Longint;
    /// the base type of this enumeration
    /// - always use PEnumType(typeinfo(TEnumType))^.BaseType or more useful
    // method PTypeInfo(typeinfo(TEnumType))^.EnumBaseType before calling
    // any of the methods below
    BaseType: PPTypeInfo;
    {$endif FPC_ENUMHASINNER}
    /// a concatenation of shortstrings, containing the enumeration names
    // - those shortstrings are not aligned whatsoever (even if
    // FPC_REQUIRES_PROPER_ALIGNMENT is set)
    NameList: string[255];
    {$ifdef FPC_ENUMHASINNER}
    function MinValue: Longint; inline;
    function MaxValue: Longint; inline;
    function BaseType: PPTypeInfo; inline;
    {$endif FPC_ENUMHASINNER}
    /// get the corresponding enumeration name
    // - return the first one if Value is invalid (>MaxValue)
    function GetEnumNameOrd(Value: Integer): PShortString;
    /// get the corresponding enumeration name
    // - return the first one if Value is invalid (>MaxValue)
    // - Value will be converted to the matching ordinal value (byte or word)
    function GetEnumName(const Value): PShortString;
       {$ifdef HASINLINE}inline;{$endif}
    /// retrieve all element names as a dynamic array of RawUTF8
    // - names could be optionally trimmed left from their initial lower chars
    procedure GetEnumNameAll(var result: TRawUTF8DynArray; TrimLeftLowerCase: boolean); overload;
    /// retrieve all element names as CSV, with optional quotes
    procedure GetEnumNameAll(var result: RawUTF8; const Prefix: RawUTF8='';
      quotedValues: boolean=false; const Suffix: RawUTF8='';
      trimedValues: boolean=false; unCamelCased: boolean=false); overload;
    /// retrieve all trimed element names as CSV
    procedure GetEnumNameTrimedAll(var result: RawUTF8; const Prefix: RawUTF8='';
      quotedValues: boolean=false; const Suffix: RawUTF8='');
    /// get all enumeration names as a JSON array of strings
    function GetEnumNameAllAsJSONArray(TrimLeftLowerCase: boolean;
      UnCamelCased: boolean=false): RawUTF8;
    /// get the corresponding enumeration ordinal value, from its name
    // - if EnumName does start with lowercases 'a'..'z', they will be searched:
    // e.g. GetEnumNameValue('sllWarning') will find sllWarning item
    // - if Value does not start with lowercases 'a'..'z', they will be ignored:
    // e.g. GetEnumNameValue('Warning') will find sllWarning item
    // - return -1 if not found (don't use directly this value to avoid any GPF)
    function GetEnumNameValue(const EnumName: ShortString): Integer; overload;
       {$ifdef HASINLINE}inline;{$endif}
    /// get the corresponding enumeration ordinal value, from its name
    // - if Value does start with lowercases 'a'..'z', they will be searched:
    // e.g. GetEnumNameValue('sllWarning') will find sllWarning item
    // - if Value does not start with lowercases 'a'..'z', they will be ignored:
    // e.g. GetEnumNameValue('Warning') will find sllWarning item
    // - return -1 if not found (don't use directly this value to avoid any GPF)
    function GetEnumNameValue(Value: PUTF8Char): Integer; overload;
       {$ifdef HASINLINE}inline;{$endif}
    /// get the corresponding enumeration ordinal value, from its name
    // - if Value does start with lowercases 'a'..'z', they will be searched:
    // e.g. GetEnumNameValue('sllWarning') will find sllWarning item
    // - if AlsoTrimLowerCase is TRUE, and EnumName does not start with
    // lowercases 'a'..'z', they will be ignored: e.g. GetEnumNameValue('Warning')
    // will find sllWarning item
    // - return -1 if not found (don't use directly this value to avoid any GPF)
    function GetEnumNameValue(Value: PUTF8Char; ValueLen: integer;
      AlsoTrimLowerCase: boolean=true): Integer; overload;
    /// get the corresponding enumeration name, without the first lowercase chars
    // (otDone -> 'Done')
    // - Value will be converted to the matching ordinal value (byte or word)
    function GetEnumNameTrimed(const Value): RawUTF8;
       {$ifdef HASINLINE}inline;{$endif}
    /// get the enumeration names corresponding to a set value
    function GetSetNameCSV(Value: integer; SepChar: AnsiChar=',';
      FullSetsAsStar: boolean=false): RawUTF8; overload;
    /// get the enumeration names corresponding to a set value
    procedure GetSetNameCSV(W: TTextWriter; Value: integer; SepChar: AnsiChar=',';
      FullSetsAsStar: boolean=false); overload;
    /// get the enumeration names corresponding to a set value, as a JSON array
    function GetSetNameAsDocVariant(Value: integer; FullSetsAsStar: boolean=false): variant;
    ///  get the corresponding caption name, without the first lowercase chars
    // (otDone -> 'Done')
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    // - internally call UnCamelCase() then System.LoadResStringTranslate() if available
    // - Value will be converted to the matching ordinal value (byte or word)
    function GetCaption(const Value): string;
    /// get all caption names, ready to be display, as lines separated by #13#10
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    // - if UsedValuesBits is not nil, only the corresponding bits set are added
    function GetCaptionStrings(UsedValuesBits: Pointer=nil): string;
    /// add caption names, ready to be display, to a TStrings class
    // - add pointer(ord(element)) as Objects[] value
    // - if UsedValuesBits is not nil, only the corresponding bits set are added
    // - can be used e.g. to populate a combo box as such:
    // ! PTypeInfo(TypeInfo(TMyEnum))^.EnumBaseType^.AddCaptionStrings(ComboBox.Items);
    procedure AddCaptionStrings(Strings: TStrings; UsedValuesBits: Pointer=nil);
    /// get the corresponding enumeration ordinal value, from its name without
    // its first lowercase chars ('Done' will find otDone e.g.)
    // - return -1 if not found (don't use directly this value to avoid any GPF)
    function GetEnumNameTrimedValue(const EnumName: ShortString): Integer; overload;
    /// get the corresponding enumeration ordinal value, from its name without
    // its first lowercase chars ('Done' will find otDone e.g.)
    // - return -1 if not found (don't use directly this value to avoid any GPF)
    function GetEnumNameTrimedValue(Value: PUTF8Char; ValueLen: integer=0): Integer; overload;
    /// compute how many bytes this type will use to be stored as a enumerate
    function SizeInStorageAsEnum: Integer;
    /// compute how many bytes this type will use to be stored as a set
    function SizeInStorageAsSet: Integer;
    /// store an enumeration value from its ordinal representation
    procedure SetEnumFromOrdinal(out Value; Ordinal: Integer);
  end;

  TRecordField = record
    TypeInfo: PPTypeInfo;
    {$ifdef FPC}
    Offset: SizeInt;
    {$else}
    Offset: Cardinal;
    {$endif FPC}
  end;
  TRecordType = record
    {$ifdef FPC_NEWRTTI}
    RecInitInfo: Pointer;
    {$endif FPC_NEWRTTI}
    Size: cardinal;
    Count: integer;
    Fields: array[word] of TRecordField;
  end;
  PRecordField = ^TRecordField;
  PRecordType = ^TRecordType;

  TIntfFlag = (ifHasGuid,ifDispInterface,ifDispatch{$ifdef FPC},ifHasStrGUID{$endif});
  TIntfFlags = set of TIntfFlag;

  /// a wrapper to interface type information, as defined by the Delphi RTTI
  TInterfaceTypeData = record
    IntfParent: PPTypeInfo; // ancestor
    IntfFlags: TIntfFlags;
    IntfGuid: TGUID;
    IntfUnit: ShortString;
  end;
  PInterfaceTypeData = ^TInterfaceTypeData;

  /// a wrapper containing type information definition
  // - user types defined as an alias don't have this type information:
  // & type NewType = OldType;
  // - user types defined as new types have this type information:
  // & type NewType = type OldType;
  {$ifdef FPC}
    {$push}
    {$PACKRECORDS 1}
  {$endif}
  {$ifdef USERECORDWITHMETHODS}TTypeInfo = record
    {$else}TTypeInfo = object{$endif}
  public
    /// the value type family
    Kind: TTypeKind;
    /// the declared name of the type ('String','Word','RawUnicode'...)
    Name: ShortString;
    /// get the class type information
    function ClassType: PClassType; {$ifdef HASINLINENOTX86}inline;{$endif}
    /// create an instance of the corresponding class
    // - will call TObject.Create, or TSQLRecord.Create virtual constructor
    // - will raise EParsingException if class cannot be constructed on the fly,
    // e.g. for a plain TCollectionItem class
    function ClassCreate: TObject;
    /// get the SQL type of this Delphi class type
    // - returns either sftObject, sftID, sftMany or sftUnknown
    function ClassSQLFieldType: TSQLFieldType;
    /// get the number of published properties in this class
    // - you can count the plain fields without any getter function, if you
    // do need only the published properties corresponding to some value
    // actually stored, and ignore e.g. any textual conversion
    function ClassFieldCount(onlyWithoutGetter: boolean): integer;
    /// for ordinal types, get the storage size and sign
    function OrdType: TOrdType; {$ifdef HASINLINE}inline;{$endif}
    /// return TRUE if the property is an unsigned 64-bit field
    function IsQWord: boolean; {$ifdef HASINLINE}inline;{$endif}
    /// for set types, get the type information of the corresponding enumeration
    function SetEnumType: PEnumType;
    /// for gloating point types, get the storage size and procision
    function FloatType: TFloatType; {$ifdef HASINLINE}inline;{$endif}
    /// get the SQL type of this Delphi type, as managed with the database driver
    function GetSQLFieldType: TSQLFieldType;
    /// fast and easy find if a class type inherits from a specific class type
    function InheritsFrom(AClass: TClass): boolean;
    /// get the enumeration type information
    function EnumBaseType: PEnumType; {$ifdef HASINLINENOTX86}inline;{$endif}
    /// get the record type information
    function RecordType: PRecordType; {$ifdef HASINLINENOTX86}inline;{$endif}
    /// get the interface type information
    function InterfaceType: PInterfaceTypeData; {$ifdef HASINLINENOTX86}inline;{$endif}
    /// get the dynamic array type information of the stored item
    function DynArrayItemType(aDataSize: PInteger=nil): PTypeInfo;
      {$ifdef HASINLINE}inline;{$endif}
    /// get the dynamic array size (in bytes) of the stored item
    function DynArrayItemSize: integer; {$ifdef HASINLINENOTX86}inline;{$endif}
    /// get the SQL type of the items of a dynamic array
    function DynArraySQLFieldType: TSQLFieldType;
    /// recognize most used string types, returning their code page
    // - will recognize TSQLRawBlob as the fake CP_SQLRAWBLOB code page
    // - will return the exact code page since Delphi 2009, from RTTI
    // - for non Unicode versions of Delphi, will recognize WinAnsiString as
    // CODEPAGE_US, RawUnicode as CP_UTF16, RawByteString as CP_RAWBYTESTRING,
    // AnsiString as 0, and any other type as RawUTF8
    function AnsiStringCodePage: integer; {$ifdef HASCODEPAGE}inline;{$endif}
    /// get the TGUID of a given interface type information
    // - returns nil if this type is not an interface
    function InterfaceGUID: PGUID;
    /// get the unit name of a given interface type information
    // - returns '' if this type is not an interface
    function InterfaceUnitName: PShortString;
    /// get the ancestor/parent of a given interface type information
    // - returns nil if this type has no parent
    function InterfaceAncestor: PTypeInfo;
    /// get all ancestors/parents of a given interface type information
    // - only ancestors with an associated TGUID will be added
    // - if OnlyImplementedBy is not nil, only the interface explicitly
    // implemented by this class will be added, and AncestorsImplementedEntry[]
    // will contain the corresponding PInterfaceEntry values
    procedure InterfaceAncestors(out Ancestors: PTypeInfoDynArray;
      OnlyImplementedBy: TInterfacedObjectClass;
      out AncestorsImplementedEntry: TPointerDynArray);
    {$ifdef FPC_PROVIDE_ATTR_TABLE}
    /// type attributes, introduced since SVN 42356-42411 (2019/07)
    function AttributeTable: PFPCAttributeTable; inline;
    {$endif FPC_PROVIDE_ATTR_TABLE}
  end;

  /// how a RTTI property definition access its value
  // - as returned by TPropInfo.Getter/Setter methods
  TPropInfoCall = (
    picNone, picField, picMethod, picIndexed);

  /// a wrapper containing a RTTI property definition
  // - used for direct Delphi / UTF-8 SQL type mapping/conversion
  // - doesn't depend on RTL's TypInfo unit, to enhance cross-compiler support
  {$ifdef USERECORDWITHMETHODS}TPropInfo = packed record
    {$else}TPropInfo = object{$endif} { "packed" above is needed on ARM (alf) }
  public
    /// raw retrieval of the property read access definition
    // - note: 'var Call' generated incorrect code on Delphi XE4 -> use PMethod
    function Getter(Instance: TObject; Call: PMethod): TPropInfoCall; {$ifdef HASINLINE}inline;{$endif}
    /// raw retrieval of the property access definition
    function Setter(Instance: TObject; Call: PMethod): TPropInfoCall; {$ifdef HASINLINE}inline;{$endif}
    /// raw retrieval of tkInteger,tkEnumeration,tkSet,tkChar,tkWChar,tkBool
    // - rather call GetOrdValue/GetInt64Value
    function GetOrdProp(Instance: TObject): PtrInt;
    /// raw assignment of tkInteger,tkEnumeration,tkSet,tkChar,tkWChar,tkBool
    // - rather call SetOrdValue/SetInt64Value
    procedure SetOrdProp(Instance: TObject; Value: PtrInt);
    /// raw retrieval of tkClass
    function GetObjProp(Instance: TObject): TObject;
    /// raw retrieval of tkInt64,tkQWord
    // - rather call GetInt64Value
    function GetInt64Prop(Instance: TObject): Int64;
    /// raw assignment of tkInt64,tkQWord
    // - rather call SetInt64Value
    procedure SetInt64Prop(Instance: TObject; const Value: Int64);
    /// raw retrieval of tkLString
    procedure GetLongStrProp(Instance: TObject; var Value: RawByteString);
    /// raw assignment of tkLString
    procedure SetLongStrProp(Instance: TObject; const Value: RawByteString);
    /// raw copy of tkLString
    procedure CopyLongStrProp(Source,Dest: TObject);
    /// raw retrieval of tkString into an Ansi7String
    procedure GetShortStrProp(Instance: TObject; var Value: RawByteString);
    /// raw retrieval of tkWString
    procedure GetWideStrProp(Instance: TObject; var Value: WideString);
    /// raw assignment of tkWString
    procedure SetWideStrProp(Instance: TObject; const Value: WideString);
    {$ifdef HASVARUSTRING}
    /// raw retrieval of tkUString
    procedure GetUnicodeStrProp(Instance: TObject; var Value: UnicodeString);
    /// raw assignment of tkUString
    procedure SetUnicodeStrProp(Instance: TObject; const Value: UnicodeString);
    {$endif HASVARUSTRING}
    /// raw retrieval of tkFloat/currency
    // - use instead GetCurrencyValue
    function GetCurrencyProp(Instance: TObject): currency;
    /// raw assignment of tkFloat/currency
    procedure SetCurrencyProp(Instance: TObject; const Value: Currency);
    /// raw retrieval of tkFloat/double
    function GetDoubleProp(Instance: TObject): double;
    /// raw assignment of tkFloat/double
    procedure SetDoubleProp(Instance: TObject; Value: Double);
    /// raw retrieval of tkFloat - with conversion to 64-bit double
    // - use instead GetDoubleValue
    function GetFloatProp(Instance: TObject): double;
    /// raw assignment of tkFloat
    // - use instead SetDoubleValue
    procedure SetFloatProp(Instance: TObject; Value: TSynExtended);
    {$ifndef NOVARIANTS}
    /// raw retrieval of tkVariant
    procedure GetVariantProp(Instance: TObject; var result: Variant);
    /// raw assignment of tkVariant
    procedure SetVariantProp(Instance: TObject; const Value: Variant);
    {$endif NOVARIANTS}
  public
    /// the type definition of this property
    // - call TPropInfo.TypeInfo for cross-compiler access to this information
    PropType: PPTypeInfo;
    /// contains the offset of a field, or the getter method set by 'read' declaration
    // - if this field is 0 (no 'read' was specified), raw access methods will
    // use SetProc to get the field memory address to read from
    // - call TPropInfo.Getter for cross-compiler access to this information
    GetProc: PtrUInt;
    /// contains the offset of a field, or the setter method set by 'write' declaration
    // - if this field is 0 (no 'write' was specified), raw access methods will
    // use GetProc to get the field memory address to save into
    // - call TPropInfo.Setter for cross-compiler access to this information
    SetProc: PtrUInt;
    /// contains the 'stored' boolean value/method (used in TPersistent saving)
    // - either integer(True) - the default, integer(False), reference to a Boolean
    // field, or reference to a parameterless method that returns a Boolean value
    // - if a property is marked as "stored AS_UNIQUE" (i.e. "stored false"),
    // it is created as UNIQUE in the SQL database and its bit is set in
    // Model.fIsUnique[]
    // - call TPropInfo.IsStored for cross-compiler access to this information
    StoredProc: PtrUInt;
    /// contains the index value of an indexed class data property
    // - outside SQLite3, this can be used to define a VARCHAR() length value
    // for the textual field definition (sftUTF8Text/sftAnsiText); e.g.
    // the following will create a NAME VARCHAR(40) field:
    // ! Name: RawUTF8 index 40 read fName write fName;
    // - is used by a dynamic array property for fast usage of the
    // TSQLRecord.DynArray(DynArrayFieldIndex) method
    Index: Integer;
    /// contains the default value (NO_DEFAULT=$80000000 indicates none set)
    // when an ordinal or set property is saved as TPersistent
    // - see TPropInfo.DefaultOr0/DefaultOrVoid for easy use
    Default: Longint;
    /// index of the property in the current inherited class definition
    // - first name index at a given class level is 0
    // - index is reset to 0 at every inherited class level
    NameIndex: SmallInt;
    {$ifdef FPC}
    /// contains the type of the GetProc/SetProc/StoredProc, see also ptxxx
    // - bit 0..1 GetProc     e.g. PropProcs and 3=ptField
    //       2..3 SetProc     e.g. (PropProcs shr 2) and 3=ptField
    //       4..5 StoredProc
    //       6 : true, constant index property
    // - rather call TPropInfo.Getter/Setter for cross-compiler access
    PropProcs: Byte;
    {$ifdef FPC_PROVIDE_ATTR_TABLE}
    /// property attributes, introduced since FPC SVN 42356-42411 (2019/07)
    AttributeTable: PFPCAttributeTable;
    {$endif FPC_PROVIDE_ATTR_TABLE}
    {$endif FPC}
    /// the property definition Name
    Name: ShortString;

    /// the type information of this property
    // - will de-reference the PropType pointer on Delphi and newer FPC compilers
    function TypeInfo: PTypeInfo; {$ifdef HASINLINENOTX86}inline;{$endif}
    /// get the next property information
    // - no range check: use ClassProp()^.PropCount to determine the properties count
    // - get the first PPropInfo with ClassProp()^.PropList
    function Next: PPropInfo; {$ifdef HASINLINENOTX86}inline;{$endif}
    /// return FALSE (AS_UNIQUE) if was marked as "stored AS_UNIQUE"
    //  (i.e. "stored false"), or TRUE by default
    // - if Instance=nil, will work only at RTTI level, not with field or method
    // (and will return TRUE if nothing is defined in the RTTI)
    function IsStored(Instance: TObject): boolean;
    /// copy a published property value from one instance to another
    // - this method use direct copy of the low-level binary content, and is
    // therefore faster than a SetValue(Dest,GetValue(Source)) call
    // - if DestInfo is nil, it will assume DestInfo=@self
    procedure CopyValue(Source, Dest: TObject; DestInfo: PPropInfo=nil);
    /// create a new instance of a published property
    // - copying its properties values from a given instance of another class
    // - if the destination property is not of the aFrom class, it will first
    // search for any extact mach in the destination nested properties
    function CopyToNewObject(aFrom: TObject): TObject;
    /// compare two published properties
    function SameValue(Source: TObject; DestInfo: PPropInfo; Dest: TObject): boolean;
    /// return true if this property is a BLOB (TSQLRawBlob)
    function IsBlob: boolean;     {$ifdef HASINLINE}inline;{$endif}
    /// return the Default RTTI value defined for this property, or 0 if not set
    function DefaultOr0: integer; {$ifdef HASINLINE}inline;{$endif}
    /// return TRUE if the property has its Default RTTI value, or is 0/""/nil
    // - will call function IsObjectDefaultOrVoid() for class properties
    function IsDefaultOrVoid(Instance: TObject): boolean;
    /// compute in how many bytes this property is stored
    function RetrieveFieldSize: integer;
    /// low-level getter of the ordinal property value of a given instance
    // - this method will check if the corresponding property is ordinal
    // - return -1 on any error
    function GetOrdValue(Instance: TObject): PtrInt;
      {$ifdef HASINLINE}inline;{$endif}
    /// low-level getter of the ordinal property value of a given instance
    // - this method will check if the corresponding property is ordinal
    // - ordinal properties smaller than tkInt64 will return an Int64-converted
    // value (e.g. tkInteger)
    // - return 0 on any error
    function GetInt64Value(Instance: TObject): Int64;
    /// low-level getter of the currency property value of a given instance
    // - this method will check if the corresponding property is exactly currency
    // - return 0 on any error
    function GetCurrencyValue(Instance: TObject): Currency;
    /// low-level getter of the floating-point property value of a given instance
    // - this method will check if the corresponding property is floating-point
    // - return 0 on any error
    function GetDoubleValue(Instance: TObject): double;
    /// low-level setter of the floating-point property value of a given instance
    // - this method will check if the corresponding property is floating-point
    procedure SetDoubleValue(Instance: TObject; const Value: double);
    /// low-level getter of the long string property value of a given instance
    // - this method will check if the corresponding property is a Long String,
    // and will return '' if it's not the case
    // - it will convert the property content into RawUTF8, for RawUnicode,
    // WinAnsiString, TSQLRawBlob and generic Delphi 6-2007 string property
    // - WideString and UnicodeString properties will also be UTF-8 converted
    procedure GetLongStrValue(Instance: TObject; var result: RawUTF8);
    /// low-level getter of the long string property content of a given instance
    // - just a wrapper around low-level GetLongStrProp() function
    // - call GetLongStrValue() method if you want a conversion into RawUTF8
    // - will work only for Kind=tkLString
    procedure GetRawByteStringValue(Instance: TObject; var Value: RawByteString);
    /// low-level setter of the ordinal property value of a given instance
    // - this method will check if the corresponding property is ordinal
    procedure SetOrdValue(Instance: TObject; Value: PtrInt);
    /// low-level setter of the ordinal property value of a given instance
    // - this method will check if the corresponding property is ordinal
    procedure SetInt64Value(Instance: TObject; Value: Int64);
    /// low-level setter of the long string property value of a given instance
    // - this method will check if the corresponding property is a Long String
    // - it will convert the property content into RawUTF8, for RawUnicode,
    // WinAnsiString, TSQLRawBlob and generic Delphi 6-2007 string property
    // - will set WideString and UnicodeString properties from UTF-8 content
    procedure SetLongStrValue(Instance: TObject; const Value: RawUTF8);
    /// low-level setter of the string property value of a given instance
    // - uses the generic string type: to be used within the VCL
    // - this method will check if the corresponding property is a Long String
    // or an UnicodeString (for Delphi 2009+), and will call the corresponding
    // SetLongStrValue() or SetUnicodeStrValue() method
    procedure SetGenericStringValue(Instance: TObject; const Value: string);
    /// low-level getter of the long string property value of a given instance
    // - uses the generic string type: to be used within the VCL
    // - this method will check if the corresponding property is a Long String,
    // or an UnicodeString (for Delphi 2009+),and will return '' if it's
    // not the case
    function GetGenericStringValue(Instance: TObject): string;
    {$ifdef HASVARUSTRING}
    /// low-level setter of the Unicode string property value of a given instance
    // - this method will check if the corresponding property is a Unicode String
    procedure SetUnicodeStrValue(Instance: TObject; const Value: UnicodeString);
    /// low-level getter of the Unicode string property value of a given instance
    // - this method will check if the corresponding property is a Unicode String
    function GetUnicodeStrValue(Instance: TObject): UnicodeString;
    {$endif HASVARUSTRING}
    /// low-level getter of a dynamic array wrapper
    // - this method will NOT check if the property is a dynamic array: caller
    // must have already checked that PropType^^.Kind=tkDynArray
    function GetDynArray(Instance: TObject): TDynArray; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// low-level getter of a dynamic array wrapper
    // - this method will NOT check if the property is a dynamic array: caller
    // must have already checked that PropType^^.Kind=tkDynArray
    procedure GetDynArray(Instance: TObject; var result: TDynArray); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// return TRUE if this dynamic array has been registered as a T*ObjArray
    // - the T*ObjArray dynamic array should have been previously registered
    // via TJSONSerializer.RegisterObjArrayForJSON() overloaded methods
    function DynArrayIsObjArray: boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// return class instance creation information about a T*ObjArray
    // - the T*ObjArray dynamic array should have been previously registered
    // via TJSONSerializer.RegisterObjArrayForJSON() overloaded methods
    // - returns nil if the supplied type is not a registered T*ObjArray
    // - you can create a new item instance just by calling result^.CreateNew
    function DynArrayIsObjArrayInstance: PClassInstance;
      {$ifdef HASINLINE}inline;{$endif}
    /// return TRUE if the property has no getter but direct field read
    function GetterIsField: boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// return TRUE if the property has no setter but direct field write
    function SetterIsField: boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// return TRUE if the property has a write setter or direct field
    function WriteIsDefined: boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// returns the low-level field read address, if GetterIsField is TRUE
    function GetterAddr(Instance: pointer): pointer; {$ifdef HASINLINENOTX86}inline;{$endif}
    /// returns the low-level field write address, if SetterIsField is TRUE
    function SetterAddr(Instance: pointer): pointer; {$ifdef HASINLINE}inline;{$endif}
    /// low-level getter of the field value memory pointer
    // - return NIL if both getter and setter are methods
    function GetFieldAddr(Instance: TObject): pointer; {$ifdef HASINLINE}inline;{$endif}
    /// low-level setter of the property value as its default
    // - this method will check the property type, e.g. setting '' for strings,
    // and 0 for numbers, or running FreeAndNil() on any nested object (unless
    // FreeAndNilNestedObjects is false so that ClearObject() is used
    procedure SetDefaultValue(Instance: TObject; FreeAndNilNestedObjects: boolean=true);
    {$ifndef NOVARIANTS}
    /// low-level setter of the property value from a supplied variant
    // - will optionally make some conversion if the property type doesn't
    // match the variant type, e.g. a text variant could be converted to integer
    // when setting a tkInteger kind of property
    // - a tkDynArray property is expected to be a T*ObjArray and will be
    // converted from a TDocVariant using a newly allocated T*ObjArray
    procedure SetFromVariant(Instance: TObject; const Value: variant);
    /// low-level getter of the property value into a variant value
    // - a tkDynArray property is expected to be a T*ObjArray and will be
    // converted into a TDocVariant using a temporary JSON serialization
    procedure GetVariant(Instance: TObject; var Dest: variant);
    {$endif NOVARIANTS}
    /// low-level setter of the property value from its text representation
    /// - handle published integer, Int64, floating point values, (wide)string,
    // enumerates (e.g. boolean), variant properties of the object
    // - for variant properties, could unserialize the Text as JSON into a
    // TDocVariantData if TryCustomVariants (and AllowDouble) are set
    // - dynamic arrays are unserialized from JSON [...], unless a
    // TRawUTF8DynArray property has been stored as CSV
    procedure SetFromText(Instance: TObject; const Text: RawUTF8;
      TryCustomVariants: PDocVariantOptions=nil; AllowDouble: boolean=false);
    /// low-level appender of the property value to a text buffer
    // - write the published integer, Int64, floating point values, (wide)string,
    // enumerates (e.g. boolean), variant properties of the object
    // - dynamic arrays will be serialized as JSON, unless RawUTF8DynArrayAsCSV
    // is set, and a TRawUTF8DynArray property will be stored as CSV
    procedure GetToText(Instance: TObject; WR: TTextWriter; RawUTF8DynArrayAsCSV: boolean=false;
      Escape: TTextWriterKind=twNone);
    /// read an TObject published property, as saved by ObjectToJSON() function
    // - will use direct in-memory reference to the object, or call the corresponding
    // setter method (if any), creating a temporary instance via TTypeInfo.ClassCreate
    // - unserialize the JSON input buffer via a call to JSONToObject()
    // - by default, a temporary instance will be created if a published field
    // has a setter, and the instance is expected to be released later by the
    // owner class: you can set the j2oSetterExpectsToFreeTempInstance option
    // to let this method release it when the setter returns
    function ClassFromJSON(Instance: TObject; From: PUTF8Char; var Valid: boolean;
      Options: TJSONToObjectOptions=[]): PUTF8Char;
  end;

  {$ifdef FPC}
    {$pop}
  {$endif}

  /// the available methods calling conventions
  // - this is by design only relevant to the x86 model
  // - Win64 has one unique calling convention
  TCallingConvention = (
    ccRegister, ccCdecl, ccPascal, ccStdCall, ccSafeCall
    {$ifdef FPC}, ccCppdecl, ccFar16, ccOldFPCCall, ccInternProc,
    ccSysCall, ccSoftFloat, ccMWPascal{$endif FPC});

  /// the available kind of method parameters
  TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut
    {$ifdef FPC}
    ,pfConstRef
    {$ifdef FPC_NEWRTTI}
    ,pfHidden,pfHigh,pfSelf,pfVmt,pfResult
    {$endif FPC_NEWRTTI}
    {$else}
    ,pfResult
    {$endif});

  /// a set of kind of method parameters
  TParamFlags = set of TParamFlag;

  PReturnInfo = ^TReturnInfo;
  PCallingConvention = ^TCallingConvention;
  PParamInfo  = ^TParamInfo;

  /// a wrapper around method returned result definition
  {$ifdef USERECORDWITHMETHODS}TReturnInfo = record
    {$else}TReturnInfo = object{$endif}
  public
    /// RTTI version
    // - 2 up to Delphi 2010, 3 for Delphi XE and up
    Version: byte;
    /// expected calling convention (only relevant for x86 mode)
    CallingConvention: TCallingConvention;
    /// the expected type of the returned function result
    // - is nil for procedure
    ReturnType: ^PTypeInfo;
    /// total size of data needed for stack parameters + 8 (ret-addr + pushed EBP)
    ParamSize: Word;
    /// number of expected parameters
    ParamCount: Byte;
    /// access to the first method parameter definition
    function Param: PParamInfo;
      {$ifdef HASINLINE}inline;{$endif}
  end;

  /// a wrapper around an individual method parameter definition
  {$ifdef USERECORDWITHMETHODS}TParamInfo = record
    {$else}TParamInfo = object{$endif}
  public
    /// the kind of parameter
    Flags: TParamFlags;
    /// the parameter type information
    ParamType: PPTypeInfo;
    {$ifdef FPC}
    ParReg: byte;
    Offset: longint;
    {$else}
    /// parameter offset
    // - 0 for EAX, 1 for EDX, 2 for ECX
    // - any value >= 8 for stack-based parameter
    Offset: Word;
    {$endif}
    /// parameter name
    Name: ShortString;
    /// get the next parameter information
    // - no range check: use TReturnInfo.ParamCount to determine the appropriate count
    function Next: PParamInfo; {$ifdef HASINLINE}inline;{$endif}
  end;

  /// a wrapper around a method definition
  {$ifdef USERECORDWITHMETHODS}TMethodInfo = packed record
    {$else}TMethodInfo = object{$endif}
  public
    {$ifdef FPC}
    /// method name
    Name: PShortString;
    /// the associated method code address
    Addr: Pointer;
    {$else}
    /// size (in bytes) of this TMethodInfo block
    Len: Word;
    /// the associated method code address
    Addr: Pointer;
    /// method name
    Name: ShortString;
    {$endif}
    /// retrieve the associated parameters information
    function ReturnInfo: PReturnInfo;
      {$ifdef HASINLINE}inline;{$endif}
    /// wrapper returning nil and avoiding a GPF if @self=nil
    function MethodAddr: Pointer;
      {$ifdef HASINLINE}inline;{$endif}
  end;

{$ifdef FPC}
  const
    ptField = 0;
    ptStatic = 1;
    ptVirtual = 2;
    ptConst = 3;
    NO_INDEX = 0;
  {$PACKRECORDS DEFAULT} // back to normal alignment
{$else}
  const
    NO_INDEX = longint($80000000);
    ptField = $ff;
    ptVirtual = $fe;
  type
    /// used to map a TPropInfo.GetProc/SetProc and retrieve its kind
    // - defined here for proper Delphi inlining
    PropWrap = packed record
      FillBytes: array [0..SizeOf(Pointer)-2] of byte;
      /// =$ff for a ptField address, or =$fe for a ptVirtual method
      Kind: byte;
    end;
  {$A+} // back to normal alignment
{$endif FPC}

const
  NO_DEFAULT = longint($80000000);

type
  TJSONSerializer = class;

  /// ORM attributes for a TSQLPropInfo definition
  TSQLPropInfoAttribute = (
    aIsUnique, aAuxiliaryRTreeField, aBinaryCollation);

  /// set of ORM attributes for a TSQLPropInfo definition
  TSQLPropInfoAttributes = set of TSQLPropInfoAttribute;

  /// abstract parent class to store information about a published property
  // - property information could be retrieved from RTTI (TSQLPropInfoRTTI*),
  // or be defined by code (TSQLPropInfoCustom derivated classes) when RTTI
  // is not available
  TSQLPropInfo = class
  protected
    fName: RawUTF8;
    fNameUnflattened: RawUTF8;
    fSQLFieldType: TSQLFieldType;
    fSQLFieldTypeStored: TSQLFieldType;
    fSQLDBFieldType: TSQLDBFieldType;
    fAttributes: TSQLPropInfoAttributes;
    fFieldWidth: integer;
    fPropertyIndex: integer;
    fFromRTTI: boolean;
    function GetNameDisplay: string; virtual;
    /// those two protected methods allow custom storage of binary content as text
    // - default implementation is to use hexa (ToSQL=true) or Base64 encodings
    procedure BinaryToText(var Value: RawUTF8; ToSQL: boolean; wasSQLString: PBoolean); virtual;
    procedure TextToBinary(Value: PUTF8Char; var result: RawByteString); virtual;
    function GetSQLFieldTypeName: PShortString;
    function GetSQLFieldRTTITypeName: RawUTF8; virtual;
    // overriden method shall use direct copy of the low-level binary content,
    // to be faster than a DestInfo.SetValue(Dest,GetValue(Source)) call
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); virtual;
  public
    /// initialize the internal fields
    // - should not be called directly, but with dedicated class methods like
    // class function TSQLPropInfoRTTI.CreateFrom() or overridden constructors
    constructor Create(const aName: RawUTF8; aSQLFieldType: TSQLFieldType;
      aAttributes: TSQLPropInfoAttributes; aFieldWidth, aPropertyIndex: integer); reintroduce; virtual;
    /// the property definition Name
    property Name: RawUTF8 read fName;
    /// the property definition Name, afer un-camelcase and translation
    property NameDisplay: string read GetNameDisplay;
    /// the property definition Name, with full path name if has been flattened
    // - if the property has been flattened (for a TSQLPropInfoRTTI), the real
    // full nested class will be returned, e.g. 'Address.Country.Iso' for
    // the 'Address_Country' flattened property name
    property NameUnflattened: RawUTF8 read fNameUnflattened;
    /// the property index in the RTTI
    property PropertyIndex: integer read fPropertyIndex;
    /// the corresponding column type, as managed by the ORM layer
    property SQLFieldType: TSQLFieldType read fSQLFieldType;
    /// the corresponding column type, as stored by the ORM layer
    // - match SQLFieldType, unless for SQLFieldType=sftNullable, in which this
    // field will contain the simple type eventually stored in the database
    property SQLFieldTypeStored: TSQLFieldType read fSQLFieldTypeStored;
    /// the corresponding column type name, as managed by the ORM layer and
    // retrieved by the RTTI
    // - returns e.g. 'sftTimeLog'
    property SQLFieldTypeName: PShortString read GetSQLFieldTypeName;
    /// the type name, as defined in the RTTI
    // - returns e.g. 'RawUTF8'
    // - will return the TSQLPropInfo class name if it is not a TSQLPropInfoRTTI
    property SQLFieldRTTITypeName: RawUTF8 read GetSQLFieldRTTITypeName;
    /// the corresponding column type, as managed for abstract database access
    // - TNullable* fields will report here the corresponding simple DB type,
    // e.g. ftInt64 for TNullableInteger (following SQLFieldTypeStored value)
    property SQLDBFieldType: TSQLDBFieldType read fSQLDBFieldType;
    /// the corresponding column type name, as managed for abstract database access
    function SQLDBFieldTypeName: PShortString;
    /// the ORM attributes of this property
    // - contains aIsUnique e.g for TSQLRecord published properties marked as
    // ! property MyProperty: RawUTF8 stored AS_UNIQUE;
    // (i.e. "stored false")
    property Attributes: TSQLPropInfoAttributes read fAttributes write fAttributes;
    /// the optional width of this field, in external databases
    // - is set e.g. by index attribute of TSQLRecord published properties as
    // ! property MyProperty: RawUTF8 index 10;
    property FieldWidth: integer read fFieldWidth;
  public
    /// convert UTF-8 encoded text into the property value
    // - setter method (write Set*) is called if available
    // - if no setter exists (no write declaration), the getted field address is used
    // - handle UTF-8 SQL to Delphi values conversion
    // - expect BLOB fields encoded as SQlite3 BLOB literals ("x'01234'" e.g.)
    // or base-64 encoded stream for JSON ("\uFFF0base64encodedbinary") - i.e.
    // both format supported by BlobToTSQLRawBlob() function
    // - handle TPersistent, TCollection, TRawUTF8List or TStrings with JSONToObject
    // - note that the supplied Value buffer won't be modified by this method:
    // overriden implementation should create their own temporary copy
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); virtual; abstract;
    /// convert UTF-8 encoded text into the property value
    // - just a wrapper around SetValue(...,pointer(Value),...) which may be
    // optimized for overriden methods
    procedure SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean); virtual;
    /// convert the property value into an UTF-8 encoded text
    // - if ToSQL is true, result is on SQL form (false->'0' e.g.)
    // - if ToSQL is false, result is on JSON form (false->'false' e.g.)
    // - BLOB field returns SQlite3 BLOB literals ("x'01234'" e.g.) if ToSQL is
    // true, or base-64 encoded stream for JSON ("\uFFF0base64encodedbinary")
    // - getter method (read Get*) is called if available
    // - handle Delphi values into UTF-8 SQL conversion
    // - sftBlobDynArray, sftBlobCustom or sftBlobRecord are returned as BLOB
    // litterals ("X'53514C697465'") if ToSQL is true, or base-64 encoded stream
    // for JSON ("\uFFF0base64encodedbinary")
    // - handle TPersistent, TCollection, TRawUTF8List or TStrings with ObjectToJSON
    function GetValue(Instance: TObject; ToSQL: boolean; wasSQLString: PBoolean=nil): RawUTF8;
      {$ifdef HASINLINE}inline;{$endif}
    /// convert the property value into an UTF-8 encoded text
    // - this method is the same as GetValue(), but avoid assigning the result
    // string variable (some speed up on multi-core CPUs, since avoid a CPU LOCK)
    // - this virtual method is the one to be overridden by the implementing classes
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); virtual; abstract;
    /// normalize the content of Value, so that GetValue(Object,true) should return the
    // same content (true for ToSQL format)
    procedure NormalizeValue(var Value: RawUTF8); virtual; abstract;
    /// retrieve a field value into a TSQLVar value
    // - the temp RawByteString is used as a temporary storage for TEXT or BLOB
    // and should be available during all access to the TSQLVar fields
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); virtual;
    /// set a field value from a TSQLVar value
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; virtual;
    /// returns TRUE if value is 0 or ''
    function IsValueVoid(Instance: TObject): boolean;
    /// append the property value into a binary buffer
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); virtual; abstract;
    /// read the property value from a binary buffer
    // - PEnd should point to the end of the P input buffer, to avoid any overflow
    // - returns next char in input buffer on success, or nil in case of invalid
    // content supplied e.g.
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; virtual; abstract;
    /// copy a property value from one instance to another
    // - both objects should have the same exact property
    procedure CopyValue(Source, Dest: TObject); virtual;
    /// copy a value from one instance to another property instance
    // - if the property has been flattened (for a TSQLPropInfoRTTI), the real
    // Source/Dest instance will be used for the copy
    procedure CopyProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject);
    {$ifndef NOVARIANTS}
    /// retrieve the property value into a Variant
    // - will set the Variant type to the best matching kind according to the
    // SQLFieldType type
    // - BLOB field returns SQlite3 BLOB textual literals ("x'01234'" e.g.)
    // - dynamic array field is returned as a variant array
    procedure GetVariant(Instance: TObject; var Dest: Variant); virtual;
    /// set the property value from a Variant value
    // - dynamic array field must be set from a variant array
    // - will set the Variant type to the best matching kind according to the
    // SQLFieldType type
    // - expect BLOB fields encoded as SQlite3 BLOB literals ("x'01234'" e.g.)
    procedure SetVariant(Instance: TObject; const Source: Variant); virtual;
    {$endif}
    /// compare the content of the property of two objects
    // - not all kind of properties are handled: only main types (like GetHash)
    // - if CaseInsensitive is TRUE, will apply NormToUpper[] 8 bits uppercase,
    // handling RawUTF8 properties just like the SYSTEMNOCASE collation
    // - this method should match the case-sensitivity of GetHash()
    // - this default implementation will call GetValueVar() for slow comparison
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; virtual;
    /// retrieve an unsigned 32-bit hash of the corresponding property
    // - not all kind of properties are handled: only main types
    // - if CaseInsensitive is TRUE, will apply NormToUpper[] 8 bits uppercase,
    // handling RawUTF8 properties just like the SYSTEMNOCASE collation
    // - note that this method can return a hash value of 0
    // - this method should match the case-sensitivity of CompareValue()
    // - this default implementation will call GetValueVar() for slow computation
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; virtual;
    /// add the JSON content corresponding to the given property
    // - this default implementation will call safe but slow GetValueVar() method
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); virtual;
    /// returns an untyped pointer to the field property memory in a given instance
    function GetFieldAddr(Instance: TObject): pointer; virtual; abstract;
  end;

  /// class-reference type (metaclass) of a TSQLPropInfo information
  TSQLPropInfoClass = class of TSQLPropInfo;

  /// define how the published properties RTTI is to be interpreted
  // - i.e. how TSQLPropInfoList.Create() and TSQLPropInfoRTTI.CreateFrom()
  // will handle the incoming RTTI
  TSQLPropInfoListOptions = set of (
    pilRaiseEORMExceptionIfNotHandled, pilAllowIDFields,
    pilSubClassesFlattening, pilIgnoreIfGetter,
    pilSingleHierarchyLevel, pilAuxiliaryFields);

  /// parent information about a published property retrieved from RTTI
  TSQLPropInfoRTTI = class(TSQLPropInfo)
  protected
    fPropInfo: PPropInfo;
    fPropType: PTypeInfo;
    fFlattenedProps: PPropInfoDynArray;
    fGetterIsFieldPropOffset: PtrUInt;
    fInPlaceCopySameClassPropOffset: PtrUInt;
    function GetSQLFieldRTTITypeName: RawUTF8; override;
  public
    /// this meta-constructor will create an instance of the exact descendant
    // of the specified property RTTI
    // - it will raise an EORMException in case of an unhandled type
    class function CreateFrom(aPropInfo: PPropInfo; aPropIndex: integer;
      aOptions: TSQLPropInfoListOptions; const aFlattenedProps: PPropInfoDynArray): TSQLPropInfo;
    /// register this class corresponding to the RTTI TypeInfo() pointer
    // - could be used e.g. to define custom serialization and process of
    // any custom type
    class procedure RegisterTypeInfo(aTypeInfo: Pointer);
    /// initialize the internal fields
    // - should not be called directly, but with dedicated class methods like
    // class function CreateFrom()
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); reintroduce; virtual;
    {$ifndef NOVARIANTS}
    /// retrieve the property value into a Variant
    // - will set the Variant type to the best matching kind according to the
    // SQLFieldType type
    // - BLOB field returns SQlite3 BLOB textual literals ("x'01234'" e.g.)
    // - dynamic array field is returned as a variant array
    procedure GetVariant(Instance: TObject; var Dest: Variant); override;
    {$endif}
    /// generic way of implementing it
    function GetFieldAddr(Instance: TObject): pointer; override;
    /// for pilSubClassesFlattening properties, compute the actual instance
    // containing the property value
    // - if the property was not flattened, return the instance
    function Flattened(Instance: TObject): TObject;
    /// corresponding RTTI information
    property PropInfo: PPropInfo read fPropInfo;
    /// for pilSubClassesFlattening properties, the parents RTTI
    property FlattenedPropInfo: PPropInfoDynArray read fFlattenedProps;
    /// corresponding type information, as retrieved from PropInfo RTTI
    property PropType: PTypeInfo read fPropType;
  end;

  /// class-reference type (metaclass) of a TSQLPropInfoRTTI information
  TSQLPropInfoRTTIClass = class of TSQLPropInfoRTTI;

  TSQLPropInfoRTTIObjArray = array of TSQLPropInfoRTTI;

  /// information about an ordinal Int32 published property
  TSQLPropInfoRTTIInt32 = class(TSQLPropInfoRTTI)
  protected
    fUnsigned: boolean;
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
  end;

  /// information about a set published property
  TSQLPropInfoRTTISet = class(TSQLPropInfoRTTIInt32)
  protected
    fSetEnumType: PEnumType;
  public
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    property SetEnumType: PEnumType read fSetEnumType;
  end;

  /// information about a enumeration published property
  // - can be either sftBoolean or sftEnumerate kind of property
  TSQLPropInfoRTTIEnum = class(TSQLPropInfoRTTIInt32)
  protected
    fEnumType: PEnumType;
  public
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    function GetCaption(Value: RawUTF8; out IntValue: integer): string;
    property EnumType: PEnumType read fEnumType;
  end;

  /// information about a character published property
  TSQLPropInfoRTTIChar = class(TSQLPropInfoRTTIInt32)
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure NormalizeValue(var Value: RawUTF8); override;
  end;

  /// information about an ordinal Int64 published property
  TSQLPropInfoRTTIInt64 = class(TSQLPropInfoRTTI)
  protected
    fIsQWord: boolean;
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
  end;

  /// information about a PtrInt published property, according to the native CPU
  // - not a real stand-alone class, but a convenient wrapper type
  TSQLPropInfoRTTIPtrInt = {$ifdef CPU64}TSQLPropInfoRTTIInt64{$else}TSQLPropInfoRTTIInt32{$endif};

  /// information about a TTimeLog published property
  // - stored as an Int64, but with a specific class
  TSQLPropInfoRTTITimeLog = class(TSQLPropInfoRTTIInt64);

  /// information about a TUnixTime published property
  // - stored as an Int64, but with a specific class
  TSQLPropInfoRTTIUnixTime = class(TSQLPropInfoRTTIInt64);

  /// information about a TUnixMSTime published property
  // - stored as an Int64, but with a specific class
  TSQLPropInfoRTTIUnixMSTime = class(TSQLPropInfoRTTIInt64);

  /// information about a floating-point Double published property
  TSQLPropInfoRTTIDouble = class(TSQLPropInfoRTTI)
  protected
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
  end;

  /// information about a fixed-decimal Currency published property
  TSQLPropInfoRTTICurrency = class(TSQLPropInfoRTTIDouble)
  protected
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
  end;

  /// information about a TDateTime published property
  TSQLPropInfoRTTIDateTime = class(TSQLPropInfoRTTIDouble)
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
  end;

  /// information about a AnsiString published property
  TSQLPropInfoRTTIAnsi = class(TSQLPropInfoRTTI)
  protected
    fEngine: TSynAnsiConvert;
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure CopyValue(Source, Dest: TObject); override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
  end;

  /// information about a RawUTF8 published property
  // - will also serialize a RawJSON property without JSON escape
  TSQLPropInfoRTTIRawUTF8 = class(TSQLPropInfoRTTIAnsi)
  protected
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
  end;

  /// information about a RawUnicode published property
  TSQLPropInfoRTTIRawUnicode = class(TSQLPropInfoRTTIAnsi)
  protected
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
  end;

  /// information about a TSQLRawBlob published property
  TSQLPropInfoRTTIRawBlob = class(TSQLPropInfoRTTIAnsi)
  protected
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    procedure GetBlob(Instance: TObject; var Blob: RawByteString);
    procedure SetBlob(Instance: TObject; const Blob: RawByteString);
    function IsNull(Instance: TObject): Boolean;
  end;

  /// information about a WideString published property
  TSQLPropInfoRTTIWide = class(TSQLPropInfoRTTI)
  protected
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure CopyValue(Source, Dest: TObject); override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
  end;

  {$ifdef HASVARUSTRING}
  /// information about a UnicodeString published property
  TSQLPropInfoRTTIUnicode = class(TSQLPropInfoRTTI)
  protected
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure CopyValue(Source, Dest: TObject); override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
  end;
  {$endif HASVARUSTRING}

  /// information about a dynamic array published property
  TSQLPropInfoRTTIDynArray = class(TSQLPropInfoRTTI)
  protected
    fObjArray: PClassInstance;
    fWrapper: TDynArray;
    procedure GetDynArray(Instance: TObject; var result: TDynArray);
      {$ifdef HASINLINE}inline;{$endif}
    function GetDynArrayElemType: PTypeInfo;
      {$ifdef HASINLINE}inline;{$endif}
    /// will create TDynArray.SaveTo by default, or JSON if is T*ObjArray
    procedure Serialize(Instance: TObject; var data: RawByteString; ExtendedJson: boolean); virtual;
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    /// initialize the internal fields
    // - should not be called directly, but with dedicated class methods like
    // class function CreateFrom()
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    {$ifndef NOVARIANTS}
    procedure GetVariant(Instance: TObject; var Dest: Variant); override;
    procedure SetVariant(Instance: TObject; const Source: Variant); override;
    {$endif}
    /// optional index of the dynamic array published property
    // - used e.g. for fast lookup by TSQLRecord.DynArray(DynArrayFieldIndex)
    property DynArrayIndex: integer read fFieldWidth;
    /// read-only access to the low-level type information the array item type
    property DynArrayElemType: PTypeInfo read GetDynArrayElemType;
    /// dynamic array item information for a T*ObjArray
    // - equals nil if this dynamic array was not previously registered via
    // TJSONSerializer.RegisterObjArrayForJSON()
    // - note that if the field is a T*ObjArray, you could create a new item
    // by calling ObjArray^.CreateNew
    // - T*ObjArray database column will be stored as text
    property ObjArray: PClassInstance read fObjArray;
  end;

  TSQLPropInfoRTTIDynArrayObjArray = array of TSQLPropInfoRTTIDynArray;

{$ifndef NOVARIANTS}
  /// information about a variant published property
  // - is also used for TNullable* properties
  TSQLPropInfoRTTIVariant = class(TSQLPropInfoRTTI)
  protected
    fDocVariantOptions: TDocVariantOptions;
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    /// initialize the internal fields
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean); override;
    procedure SetValuePtr(Instance: TObject; Value: PUTF8Char; ValueLen: integer;
      wasString: boolean);
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    procedure GetVariant(Instance: TObject; var Dest: Variant); override;
    procedure SetVariant(Instance: TObject; const Source: Variant); override;
    /// how this property will deal with its instances (including TDocVariant)
    // - by default, contains JSON_OPTIONS_FAST for best performance - i.e.
    // [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]
    // - set JSON_OPTIONS_FAST_EXTENDED (or include dvoSerializeAsExtendedJson)
    // so that any TDocVariant nested field names will not be double-quoted,
    // saving some chars in the stored TEXT column and in the JSON escaped
    // transmitted data over REST, by writing '{name:"John",age:123}' instead of
    // '{"name":"John","age":123}': be aware that this syntax is supported by
    // the ORM, SOA, TDocVariant, TBSONVariant, and our SynCrossPlatformJSON
    // unit, but not AJAX/JavaScript or most JSON libraries
    // - see also TSQLModel/TSQLRecordProperties.SetVariantFieldsDocVariantOptions
    property DocVariantOptions: TDocVariantOptions read fDocVariantOptions write fDocVariantOptions;
  end;
{$endif NOVARIANTS}

  /// optional event handler used by TSQLPropInfoRecord to handle textual storage
  // - by default, TSQLPropInfoRecord content will be stored as sftBlobCustom;
  // specify such a callback event to allow storage as UTF-8 textual field and
  // use a sftUTF8Custom kind of column
  // - event implementation shall convert data/datalen binary value into Text
  TOnSQLPropInfoRecord2Text = procedure(Data: pointer; DataLen: integer;
    var Text: RawUTF8);
  /// optional event handler used by TSQLPropInfoRecord to handle textual storage
  // - by default, TSQLPropInfoRecord content will be stored as sftBlobCustom;
  // specify such a callback event to allow storage as UTF-8 textual field and
  // use a sftUTF8Custom kind of column
  // - event implementaiton shall convert Text into Data binary value
  TOnSQLPropInfoRecord2Data = procedure(Text: PUTF8Char; var Data: RawByteString);

  /// abstract information about a record-like property defined directly in code
  // - do not use this class, but TSQLPropInfoRecordRTTI and TSQLPropInfoRecordFixedSize
  // - will store the content as BLOB by default, and SQLFieldType as sftBlobCustom
  // - if aData2Text/aText2Data are defined, use TEXT storage and sftUTF8Custom type
  TSQLPropInfoCustom = class(TSQLPropInfo)
  protected
    fOffset: PtrUInt;
    fData2Text: TOnSQLPropInfoRecord2Text;
    fText2Data: TOnSQLPropInfoRecord2Data;
    procedure BinaryToText(var Value: RawUTF8; ToSQL: boolean; wasSQLString: PBoolean); override;
    procedure TextToBinary(Value: PUTF8Char; var result: RawByteString); override;
  public
    /// define a custom property in code
    // - do not call this constructor directly, but one of its inherited classes,
    // via a call to TSQLRecordProperties.RegisterCustom*()
    constructor Create(const aName: RawUTF8; aSQLFieldType: TSQLFieldType;
      aAttributes: TSQLPropInfoAttributes; aFieldWidth, aPropIndex: Integer;
      aProperty: pointer; aData2Text: TOnSQLPropInfoRecord2Text;
      aText2Data: TOnSQLPropInfoRecord2Data); reintroduce;
  public
    function GetFieldAddr(Instance: TObject): pointer; override;
  end;

  /// information about a record property defined directly in code using RTTI
  TSQLPropInfoRecordTyped = class(TSQLPropInfoCustom)
  protected
    fTypeInfo: PTypeInfo;
  public
    property TypeInfo: PTypeInfo read fTypeInfo;
  end;

  /// information about a record property defined directly in code
  // - Delphi does not publish RTTI for published record properties
  // - you can use this class to register a record property from its RTTI
  // - will store the content as BLOB by default, and SQLFieldType as sftBlobCustom
  // - if aData2Text/aText2Data are defined, use TEXT storage and sftUTF8Custom type
  // - this class will use only binary RecordLoad/RecordSave methods
  TSQLPropInfoRecordRTTI = class(TSQLPropInfoRecordTyped)
  protected
    function GetSQLFieldRTTITypeName: RawUTF8; override;
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    /// define a record property from its RTTI definition
    // - handle any kind of record with available generated TypeInfo()
    // - aPropertyPointer shall be filled with the offset to the private
    // field within a nil object, e.g for
    // !  class TMainObject = class(TSQLRecord)
    // !    (...)
    // !    fFieldName: TMyRecord;
    // !  public
    // !    (...)
    // !    property FieldName: TMyRecord read fFieldName write fFieldName;
    // !  end;
    // you will have to register it via a call to
    // TSQLRecordProperties.RegisterCustomRTTIRecordProperty()
    // - optional aIsNotUnique parametercanl be defined
    // - implementation will use internally RecordLoad/RecordSave functions
    // - you can specify optional aData2Text/aText2Data callbacks to store
    // the content as textual values, and not as BLOB
    constructor Create(aRecordInfo: PTypeInfo; const aName: RawUTF8; aPropertyIndex: integer;
      aPropertyPointer: pointer; aAttributes: TSQLPropInfoAttributes=[];
      aFieldWidth: integer=0; aData2Text: TOnSQLPropInfoRecord2Text=nil;
      aText2Data: TOnSQLPropInfoRecord2Data=nil); reintroduce; overload;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    {$ifndef NOVARIANTS}
    procedure GetVariant(Instance: TObject; var Dest: Variant); override;
    procedure SetVariant(Instance: TObject; const Source: Variant); override;
    {$endif}
  end;

  /// information about a fixed-size record property defined directly in code
  // - Delphi does not publish RTTI for published record properties
  // - you can use this class to register a record property with no RTTI (i.e.
  // a record with no reference-counted types within)
  // - will store the content as BLOB by default, and SQLFieldType as sftBlobCustom
  // - if aData2Text/aText2Data are defined, use TEXT storage and sftUTF8Custom type
  TSQLPropInfoRecordFixedSize = class(TSQLPropInfoRecordTyped)
  protected
    fRecordSize: integer;
    function GetSQLFieldRTTITypeName: RawUTF8; override;
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    /// define an unmanaged fixed-size record property
    // - simple kind of records (i.e. those not containing reference-counted
    // members) do not have RTTI generated, at least in older versions of Delphi:
    // use this constructor to define a direct property access
    // - main parameter is the record size, in bytes
    constructor Create(aRecordSize: cardinal; const aName: RawUTF8; aPropertyIndex: integer;
      aPropertyPointer: pointer; aAttributes: TSQLPropInfoAttributes=[];
      aFieldWidth: integer=0; aData2Text: TOnSQLPropInfoRecord2Text=nil;
      aText2Data: TOnSQLPropInfoRecord2Data=nil); reintroduce; overload;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
      var temp: RawByteString); override;
    function SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean; override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    function CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    {$ifndef NOVARIANTS}
    procedure GetVariant(Instance: TObject; var Dest: Variant); override;
    procedure SetVariant(Instance: TObject; const Source: Variant); override;
    {$endif}
  end;

  /// information about a custom property defined directly in code
  // - you can define any kind of property, either a record or any type
  // - this class will use JSON serialization, by type name or TypeInfo() pointer
  // - will store the content as TEXT by default, and SQLFieldType as sftUTF8Custom
  TSQLPropInfoCustomJSON = class(TSQLPropInfoRecordTyped)
  protected
    fCustomParser: TJSONCustomParserRTTI;
    function GetSQLFieldRTTITypeName: RawUTF8; override;
    procedure SetCustomParser(aCustomParser: TJSONCustomParserRTTI);
  public
    /// initialize the internal fields
    // - should not be called directly
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer);
      reintroduce; overload; virtual;
    /// define a custom property from its RTTI definition
    // - handle any kind of property, e.g. from enhanced RTTI or a custom record
    // defined via TTextWriter.RegisterCustomJSONSerializer[FromText]()
    // - aPropertyPointer shall be filled with the offset to the private
    // field within a nil object, e.g for
    // !  class TMainObject = class(TSQLRecord)
    // !    (...)
    // !    fFieldName: TMyRecord;
    // !  public
    // !    (...)
    // !    property FieldName: TMyRecord read fFieldName write fFieldName;
    // !  end;
    // you will have to register it via a call to
    // TSQLRecordProperties.RegisterCustomPropertyFromRTTI()
    // - optional aIsNotUnique parameter can be defined
    // - implementation will use internally RecordLoadJSON/RecordSave functions
    // - you can specify optional aData2Text/aText2Data callbacks to store
    // the content as textual values, and not as BLOB
    constructor Create(aTypeInfo: PTypeInfo; const aName: RawUTF8;
      aPropertyIndex: integer; aPropertyPointer: pointer;
      aAttributes: TSQLPropInfoAttributes=[]; aFieldWidth: integer=0);
        reintroduce; overload;
    /// define a custom property from its RTTI definition
    // - handle any kind of property, e.g. from enhanced RTTI or a custom record
    // defined via TTextWriter.RegisterCustomJSONSerializer[FromText]()
    // - aPropertyPointer shall be filled with the offset to the private
    // field within a nil object, e.g for
    // !  class TMainObject = class(TSQLRecord)
    // !    (...)
    // !    fGUID: TGUID;
    // !  public
    // !    (...)
    // !    property GUID: TGUID read fGUID write fGUID;
    // !  end;
    // you will have to register it via a call to
    // TSQLRecordProperties.RegisterCustomPropertyFromTypeName()
    // - optional aIsNotUnique parameter can be defined
    // - implementation will use internally RecordLoadJSON/RecordSave functions
    // - you can specify optional aData2Text/aText2Data callbacks to store
    // the content as textual values, and not as BLOB
    constructor Create(const aTypeName, aName: RawUTF8;
      aPropertyIndex: integer; aPropertyPointer: pointer;
      aAttributes: TSQLPropInfoAttributes=[]; aFieldWidth: integer=0);
        reintroduce; overload;
    /// finalize the instance
    destructor Destroy; override;
    /// the corresponding custom JSON parser
    property CustomParser: TJSONCustomParserRTTI read fCustomParser;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
  end;

  /// dynamic array of ORM fields information for published properties
  TSQLPropInfoObjArray = array of TSQLPropInfo;

  /// handle a read-only list of fields information for published properties
  // - is mainly used by our ORM for TSQLRecord RTTI, but may be used for
  // any TPersistent
  TSQLPropInfoList = class
  protected
    fList: TSQLPropInfoObjArray;
    fCount: integer;
    fTable: TClass;
    fOptions: TSQLPropInfoListOptions;
    fOrderedByName: TIntegerDynArray;
    function GetItem(aIndex: integer): TSQLPropInfo;
    procedure QuickSortByName(L,R: PtrInt);
    procedure InternalAddParentsFirst(aClassType: TClass); overload;
    procedure InternalAddParentsFirst(aClassType: TClass;
      aFlattenedProps: PPropInfoDynArray); overload;
  public
    /// initialize the list from a given class RTTI
    constructor Create(aTable: TClass; aOptions: TSQLPropInfoListOptions);
    /// release internal list items
    destructor Destroy; override;
    /// add a TSQLPropInfo to the list
    function Add(aItem: TSQLPropInfo): integer;
    /// find an item in the list
    // - returns nil if not found
    function ByRawUTF8Name(const aName: RawUTF8): TSQLPropInfo; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// find an item in the list
    // - returns nil if not found
    function ByName(aName: PUTF8Char): TSQLPropInfo; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// find an item in the list
    // - returns -1 if not found
    function IndexByName(const aName: RawUTF8): integer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// find an item in the list
    // - returns -1 if not found
    function IndexByName(aName: PUTF8Char): integer; overload;
    /// find an item by name in the list, including RowID/ID
    // - will identify 'ID' / 'RowID' field name as -1
    // - raise an EORMException if not found in the internal list
    function IndexByNameOrExcept(const aName: RawUTF8): integer;
    /// find one or several items by name in the list, including RowID/ID
    // - will identify 'ID' / 'RowID' field name as -1
    // - raise an EORMException if not found in the internal list
    procedure IndexesByNamesOrExcept(const aNames: array of RawUTF8;
      const aIndexes: array of PInteger);
    /// find an item in the list, searching by unflattened name
    // - for a flattened property, you may for instance call
    // IndexByNameUnflattenedOrExcept('Address.Country.Iso')
    // instead of IndexByNameOrExcept('Address_Country')
    // - won't identify 'ID' / 'RowID' field names, just List[].
    // - raise an EORMException if not found in the internal list
    function IndexByNameUnflattenedOrExcept(const aName: RawUTF8): integer;
    /// fill a TRawUTF8DynArray instance from the field names
    // - excluding ID
    procedure NamesToRawUTF8DynArray(var Names: TRawUTF8DynArray);
    /// returns the number of TSQLPropInfo in the list
    property Count: integer read fCount;
    /// quick access to the TSQLPropInfo list
    // - note that length(List) may not equal Count, since is its capacity
    property List: TSQLPropInfoObjArray read fList;
    /// read-only retrieval of a TSQLPropInfo item
    // - will raise an exception if out of range
    property Items[aIndex: integer]: TSQLPropInfo read GetItem;
  end;

  /// simple writer to a Stream, specialized for writing an object as INI
  // - resulting content will be UTF-8 encoded
  // - use an internal buffer, faster than string+string
  TINIWriter = class(TTextWriter)
    /// write the published properties of the object in INI text format
    // - i.e. append PropertyName=PropertyValue lines
    // - add a new INI-like section with [Value.ClassName] if WithSection is true
    // - use internally TPropInfo.GetToText for the conversion to text
    // - Value object must have been compiled with the $M+ define, i.e. must
    // inherit from TPersistent, TSynPersistent or TSQLRecord
    // - the enumerates properties are stored with their integer index value
    // - dynamic arrays will be serialized as JSON, unless RawUTF8DynArrayAsCSV
    // is set, and a TRawUTF8DynArray property will be stored as CSV
    // - content can be read back using overloaded procedures ReadObject()
    procedure WriteObject(Value: TObject; const SubCompName: RawUTF8='';
      WithSection: boolean=true; RawUTF8DynArrayAsCSV: boolean=false); reintroduce;
  end;

  /// method prototype to be used for custom serialization of a class
  // - to be used with TJSONSerializer.RegisterCustomSerializer() method
  // - note that the generated JSON content is not required to start with '{',
  // as a normal JSON object (you may e.g. write a JSON string for some class) -
  // as a consequence, custom code could explicitely start with Add('{')
  // - implementation code shall follow function TJSONSerializer.WriteObject()
  // patterns, i.e. aSerializer.Add/AddInstanceName/AddJSONEscapeString...
  // - implementation code shall follow the same exact format for the
  // associated TJSONSerializerCustomReader callback
  TJSONSerializerCustomWriter = procedure(const aSerializer: TJSONSerializer;
    aValue: TObject; aOptions: TTextWriterWriteObjectOptions) of object;
  /// method prototype to be used for custom un-serialization of a class
  // - to be used with TJSONSerializer.RegisterCustomSerializer() method
  // - note that the read JSON content is not required to start with '{',
  // as a normal JSON object (you may e.g. read a JSON string for some class) -
  // as a consequence, custom code could explicitely start with "if aFrom^='{'..."
  // - implementation code shall follow function JSONToObject() patterns, i.e.
  // calling low-level GetJSONField() function to decode the JSON content
  // - implementation code shall follow the same exact format for the
  // associated TJSONSerializerCustomWriter callback
  TJSONSerializerCustomReader = function(const aValue: TObject; aFrom: PUTF8Char;
    var aValid: Boolean; aOptions: TJSONToObjectOptions): PUTF8Char of object;

  /// several options to customize how TSQLRecord will be serialized
  // - e.g. if properties storing JSON should be serialized as an object, and not
  // escaped as a string (which is the default, matching ORM column storage)
  // - if an additional "ID_str":"12345" field should be added to the standard
  // "ID":12345 field, which may exceed 53-bit integer precision of JavsCript
  TJSONSerializerSQLRecordOption = (
    jwoAsJsonNotAsString, jwoID_str);
  /// options to customize how TSQLRecord will be written by TJSONSerializer
  TJSONSerializerSQLRecordOptions = set of TJSONSerializerSQLRecordOption;

  /// simple writer to a Stream, specialized for writing an object as JSON
  // - override WriteObject() to use class RTTI process of this unit, and
  // allow custom JSON serialization
  // - this is the full-feature JSON serialization class
  TJSONSerializer = class(TJSONWriter)
  protected
    fSQLRecordOptions: TJSONSerializerSQLRecordOptions;
    procedure SetSQLRecordOptions(Value: TJSONSerializerSQLRecordOptions);
  public
    /// serialize as JSON the published integer, Int64, floating point values,
    // TDateTime (stored as ISO 8601 text), string and enumerate (e.g. boolean)
    // properties of the object
    // - won't handle shortstring properties
    // - the object must have been compiled with the $M+ define, i.e. must
    // inherit from TPersistent or TSQLRecord, or has been defined with a
    // custom serializer via RegisterCustomSerializer()
    // - will write also the properties published in the parent classes
    // - the enumerates properties are stored with their integer index value by
    // default, but will be written as text if woFullExpand option is set
    // - TList objects are not handled by default - they will be written only
    // if FullExpand is set to true (and JSONToObject won't be able to read it)
    // - nested properties are serialized as nested JSON objects
    // - any TCollection property will also be serialized as JSON array
    // - any TStrings or TRawUTF8List property will also be serialized as
    // JSON string array
    // - function ObjectToJSON() is just a wrapper over this method
    procedure WriteObject(Value: TObject;
      Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]); override;
    /// customize TSQLRecord.GetJSONValues serialization process
    // - jwoAsJsonNotAsString will force TSQLRecord.GetJSONValues to serialize
    // nested property instances as a JSON object/array, not a JSON string:
    // i.e. root/table/id REST will be ready-to-be-consumed from AJAX clients
    // (e.g. TSQLPropInfoRTTIObject.GetJSONValues as a JSON object, and
    // TSQLPropInfoRTTIDynArray.GetJSONValues as a JSON array)
    // - jwoID_str will add an "ID_str":"12345" property to the default
    // "ID":12345 field to circumvent JavaScript's limitation of 53-bit for
    // integer numbers, which is easily reached with our 64-bit TID values, e.g.
    // if TSynUniqueIdentifier are used to generate the IDs: AJAX clients should
    // better use this "ID_str" string value to identify each record, and ignore
    // the "id" fields
    property SQLRecordOptions: TJSONSerializerSQLRecordOptions
      read fSQLRecordOptions write SetSQLRecordOptions;

    /// define a custom serialization for a given class
    // - by default, TSQLRecord, TPersistent, TStrings, TCollection classes
    // are processed: but you can specify here some callbacks to perform
    // the serialization process for any class
    // - any previous registration is overridden
    // - setting both aReader=aWriter=nil will return back to the default class
    // serialization (i.e. published properties serialization)
    // - note that any inherited classes will be serialized as the parent class
    // - this method is thread-safe, but should be called before any serialization
    class procedure RegisterCustomSerializer(aClass: TClass;
      aReader: TJSONSerializerCustomReader; aWriter: TJSONSerializerCustomWriter);
    /// define custom serialization of field names for a given class
    // - any aClassField[] property name will be serialized using aJsonFields[]
    // - if any aJsonFields[] equals '', this published property will be
    // excluded from the serialization object
    // - aJsonFields[] is expected to be only plain pascal identifier, i.e.
    // A-Z a-z 0-9 and _ characters, up to 63 in length
    // - setting both aClassField=aJsonFields=[] will return back to the default
    // class serialization (i.e. serialization with published properties names)
    // - by design, this customization excludes RegisterCustomSerializer() with
    // custom reader/writer callbacks
    // - note that any inherited classes will be serialized as the parent class
    // - this method is thread-safe, but should be called before any serialization
    class procedure RegisterCustomSerializerFieldNames(aClass: TClass;
      const aClassFields, aJsonFields: array of ShortString);
    /// let a given class be recognized by JSONToObject() from "ClassName":".."
    // - TObjectList item instances will be created corresponding to the
    // serialized class name field specified, and JSONToNewObject() can create a
    // new instance using the "ClassName":"..." field to identify the class type
    // - by default, all referenced TSQLRecord classes will be globally
    // registered when TSQLRecordProperties information is retrieved
    // - this method is thread-safe, but should be called before any serialization
    class procedure RegisterClassForJSON(aItemClass: TClass); overload;
    /// let a given class be recognized by JSONToObject() from "ClassName":".."
    // - TObjectList item instances will be created corresponding to the
    // serialized class name field specified, and JSONToNewObject() can create a
    // new instance using the "ClassName":"..." field to identify the class type
    // - by default, all referenced TSQLRecord classes will be globally
    // registered when TSQLRecordProperties information is retrieved
    // - this method is thread-safe, but should be called before any serialization
    class procedure RegisterClassForJSON(const aItemClass: array of TClass); overload;
    {$ifndef LVCL}
    /// let a given TCollection be recognized during JSON serialization
    // - due to how TCollection instances are created, you can not create a
    // server-side instance of TCollection directly
    // - first workaround is to inherit from TInterfacedCollection
    // - this method allows to recognize the needed TCollectionItem class for
    // a given TCollection class, so allow to (un)serialize any TCollection,
    // without defining a new method and inherits from TInterfacedCollection
    // - note that both supplied classes will be registered for the internal
    // "ClassName":"..." RegisterClassForJSON() process
    // - this method is thread-safe, but should be called before any serialization
    class procedure RegisterCollectionForJSON(aCollection: TCollectionClass;
      aItem: TCollectionItemClass);
    {$endif}
    /// let a T*ObjArray dynamic array be used for storage of class instances
    // - will allow JSON serialization and unserialization of the registered
    // dynamic array property defined in any TPersistent or TSQLRecord
    // - could be used as such (note the T*ObjArray type naming convention):
    // ! TUserObjArray = array of TUser;
    // ! ...
    // ! TJSONSerializer.RegisterObjArrayForJSON(TypeInfo(TUserObjArray),TUser);
    // - then you can use ObjArrayAdd/ObjArrayFind/ObjArrayDelete to manage
    // the stored items, and never forget to call ObjArrayClear to release
    // the memory
    // - will use the default published properties serializer, unless you specify
    // your custom Reader/Write callbacks
    class procedure RegisterObjArrayForJSON(aDynArray: PTypeInfo;
      aItem: TClass; aReader: TDynArrayJSONCustomReader=nil; aWriter: TDynArrayJSONCustomWriter=nil);overload;
    /// let T*ObjArray dynamic arrays be used for storage of class instances
    // - will allow JSON serialization and unserialization of the registered
    // dynamic array property defined in any TPersistent or TSQLRecord
    // - will call the overloaded RegisterObjArrayForJSON() class method by pair:
    // ! TJSONSerializer.RegisterObjArrayForJSON([
    // !     TypeInfo(TAddressObjArray),TAddress, TypeInfo(TUserObjArray),TUser]);
    class procedure RegisterObjArrayForJSON(const aDynArrayClassPairs: array of const); overload;
    /// retrieve TClassInstance information for a T*ObjArray dynamic array type
    // - the T*ObjArray dynamic array should have been previously registered
    // via TJSONSerializer.RegisterObjArrayForJSON() overloaded methods
    // - returns nil if the supplied type is not a registered T*ObjArray
    class function RegisterObjArrayFindType(aDynArray: PTypeInfo): PClassInstance;
    /// retrieve the T*ObjArray dynamic array type RTTI for a given item class
    // - the T*ObjArray dynamic array should have been previously registered
    // via TJSONSerializer.RegisterObjArrayForJSON() overloaded methods
    // - returns nil if the supplied type is not a registered T*ObjArray
    class function RegisterObjArrayFindTypeInfo(aClass: TClass): PTypeInfo;
  end;

const
  /// fake TTypeInfo RTTI used for TGUID on older versions of the compiler
  GUID_FAKETYPEINFO: packed record
    Kind: TTypeKind;
    Name: string[5];
    Size: cardinal;
    Count: integer;
  end = (
    Kind: tkRecord;
    Name: 'TGUID';
    Size: SizeOf(TGUID);
    Count: 0);

/// returns the interface name of a registered GUID, or its hexadecimal value
function ToText({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  aGUID: TGUID): TGUIDShortString; overload;

/// retrieve a Field property RTTI information from a Property Name
function ClassFieldProp(ClassType: TClass; const PropName: shortstring): PPropInfo;

/// retrieve a Field property RTTI information from a Property Name
// - this special version also search into parent properties (default is only current)
function ClassFieldPropWithParents(aClassType: TClass; const aPropName: shortstring;
  aCaseSensitive: boolean=false): PPropInfo;

/// retrieve an integer/Int64 Field propery value from a Property Name
// - this version also search into parent properties
// - returns TRUE and set PropValue if a matching property was found
function ClassFieldInt64(Instance: TObject; const PropName: ShortString;
  out PropValue: Int64): boolean;

/// retrieve a class Field property instance from a Property Name
// - this version also search into parent properties
// - returns TRUE and set PropInstance if a matching property was found
function ClassFieldInstance(Instance: TObject; const PropName: shortstring;
  PropClassType: TClass; out PropInstance): boolean; overload;

/// retrieve a Field property RTTI information from a Property Name
// - this special version also search into parent properties (default is only current)
function ClassFieldPropWithParentsFromUTF8(aClassType: TClass; PropName: PUTF8Char;
  PropNameLen: integer; aCaseSensitive: boolean=false): PPropInfo;

/// retrieve a Field property RTTI information searching for an exact Property class type
// - this special version also search into parent properties
function ClassFieldPropWithParentsFromClassType(aClassType,aSearchedClassType: TClass): PPropInfo;

/// retrieve a Field property RTTI information searching for an inherited Property class type
// - this special version also search into parent properties
function ClassFieldPropWithParentsInheritsFromClassType(aClassType,aSearchedClassType: TClass): PPropInfo;

/// retrieve a Field property RTTI information searching for an exact Property offset address
// - this special version also search into parent properties
function ClassFieldPropWithParentsFromClassOffset(aClassType: TClass;
  aSearchedOffset: pointer): PPropInfo;

/// retrieve a class Field property instance from a Property class type
// - this version also search into parent properties
// - returns TRUE and set PropInstance if a matching property was found
function ClassFieldInstance(Instance: TObject; PropClassType: TClass;
  out PropInstance): boolean; overload;

/// retrieve all class Field property instances from a Property class type
// - this version also search into parent properties
// - returns all matching property instances found
function ClassFieldInstances(Instance: TObject; PropClassType: TClass): TObjectDynArray;

/// retrieve a class instance property value matching a class type
// - if aSearchedInstance is aSearchedClassType, will return aSearchedInstance
// - if aSearchedInstance is not aSearchedClassType, it will try all nested
// properties of aSearchedInstance for a matching aSearchedClassType: if no
// exact match is found, will return aSearchedInstance
function ClassFieldPropInstanceMatchingClass(aSearchedInstance: TObject;
  aSearchedClassType: TClass): TObject;

/// retrieve the total number of properties for a class, including its parents
function ClassFieldCountWithParents(ClassType: TClass;
  onlyWithoutGetter: boolean=false): integer;

/// returns TRUE if the class has some published fields, including its parents
function ClassHasPublishedFields(ClassType: TClass): boolean;

/// retrieve all class hierachy types which have some published properties
function ClassHierarchyWithField(ClassType: TClass): TClassDynArray;

/// retrieve the PPropInfo values of all published properties of a class
// - you could select which property types should be included in the list
function ClassFieldAllProps(ClassType: TClass;
  Types: TTypeKinds=[low(TTypeKind)..high(TTypeKind)]): PPropInfoDynArray;

/// retrieve the field names of all published properties of a class
// - will optionally append the property type to the name, e.g 'Age: integer'
// - you could select which property types should be included in the list
function ClassFieldNamesAllProps(ClassType: TClass; IncludePropType: boolean=false;
  Types: TTypeKinds=[low(TTypeKind)..high(TTypeKind)]): TRawUTF8DynArray;

/// retrieve the field names of all published properties of a class
// - will optionally append the property type to the name, e.g 'Age: integer'
// - you could select which property types should be included in the list
function ClassFieldNamesAllPropsAsText(ClassType: TClass; IncludePropType: boolean=false;
  Types: TTypeKinds=[low(TTypeKind)..high(TTypeKind)]): RawUTF8;

/// retrieve an object's component from its property name and class
// - useful to set User Interface component, e.g.
function GetObjectComponent(Obj: TPersistent; const ComponentName: shortstring;
  ComponentClass: TClass): pointer;

/// retrieve the class property RTTI information for a specific class
function InternalClassProp(ClassType: TClass): PClassProp;
  {$ifdef FPC}inline;{$else}{$ifdef HASINLINENOTX86}inline;{$endif}{$endif}

/// retrieve the class property RTTI information for a specific class
// - will return the number of published properties
// - and set the PropInfo variable to point to the first property
// - typical use to enumerate all published properties could be:
//  !  var i: integer;
//  !      CT: TClass;
//  !      P: PPropInfo;
//  !  begin
//  !    CT := ..;
//  !    repeat
//  !      for i := 1 to InternalClassPropInfo(CT,P) do begin
//  !        // use P^
//  !        P := P^.Next;
//  !      end;
//  !      CT := GetClassParent(CT);
//  !    until CT=nil;
//  !  end;
// such a loop is much faster than using the RTL's TypeInfo or RTTI units
function InternalClassPropInfo(ClassType: TClass; out PropInfo: PPropInfo): integer;

/// retrieve a method RTTI information for a specific class
function InternalMethodInfo(aClassType: TClass; const aMethodName: ShortString): PMethodInfo;

/// execute an instance method from its RTTI per-interface information
// - calling this function with a pre-computed PInterfaceEntry value is faster
// than calling the TObject.GetInterface() method, especially when the class
// implements several interfaces, since it avoid a slow GUID lookup
function GetInterfaceFromEntry(Instance: TObject; Entry: PInterfaceEntry; out Obj): boolean;

/// retrieve the ready to be displayed text of an enumeration
// - will "uncamel" then translate into a generic VCL string
// - aIndex will be converted to the matching ordinal value (byte or word)
function GetEnumCaption(aTypeInfo: PTypeInfo; const aIndex): string;

/// get the corresponding enumeration name, without the first lowercase chars
// (otDone -> 'Done')
// - aIndex will be converted to the matching ordinal value (byte or word)
// - this will return the code-based English text; use GetEnumCaption() to
// retrieve the enumeration display text
function GetEnumNameTrimed(aTypeInfo: PTypeInfo; const aIndex): RawUTF8;

/// get all included values of an enumeration set, as CSV names
function GetSetNameCSV(aTypeInfo: PTypeInfo; const aValue): RawUTF8;

var
  /// a shared list of T*ObjArray registered serializers
  // - you should not access this variable, but via inline methods
  ObjArraySerializers: TPointerClassHash;

{$ifndef NOVARIANTS}
/// fill a class instance from a TDocVariant object document properties
// - returns FALSE if the variant is not a dvObject, TRUE otherwise
function DocVariantToObject(var doc: TDocVariantData; obj: TObject): boolean;

/// fill a T*ObjArray variable from a TDocVariant array document values
// - will always erase the T*ObjArray instance, and fill it from arr values
procedure DocVariantToObjArray(var arr: TDocVariantData; var objArray;
  objClass: TClass); overload;

/// fill a T*ObjArray variable from a TDocVariant array document values
// - will always erase the T*ObjArray instance, and fill it from arr values
procedure DocVariantToObjArray(var arr: TDocVariantData; var objArray;
  objClass: PClassInstance); overload;

/// will convert a blank TObject into a TDocVariant document instance
function ObjectDefaultToVariant(aClass: TClass; aOptions: TDocVariantOptions): variant; overload;
{$endif}


{ ************ cross-cutting classes and types }

type
  {$ifndef LVCL}
  /// any TCollection used between client and server shall inherit from this class
  // - you should override the GetClass virtual method to provide the
  // expected collection item class to be used on server side
  // - another possibility is to register a TCollection/TCollectionItem pair
  // via a call to TJSONSerializer.RegisterCollectionForJSON()
  TInterfacedCollection = class(TCollection)
  protected
    /// you shall override this abstract method
    class function GetClass: TCollectionItemClass; virtual; abstract;
  public
    /// this constructor which will call GetClass to initialize the collection
    constructor Create; reintroduce; virtual;
  end;

  /// class-reference type (metaclass) of a TInterfacedCollection kind
  TInterfacedCollectionClass = class of TInterfacedCollection;

  /// abstract TCollectionItem class, which will instantiate all its nested class
  // published properties, then release them (and any T*ObjArray) when freed
  // - could be used for gathering of TCollectionItem properties, e.g. for
  // Domain objects in DDD, especially for list of value objects
  // - consider using T*ObjArray dynamic array published properties in your
  // value types instead of TCollection storage: T*ObjArray have a lower overhead
  // and are easier to work with, once TJSONSerializer.RegisterObjArrayForJSON
  // is called to register the T*ObjArray type
  // - note that non published (e.g. public) properties won't be instantiated,
  // serialized, nor released - but may contain weak references to other classes
  // - please take care that you will not create any endless recursion: you should
  // ensure that at one level, nested published properties won't have any class
  // instance refering to its owner (there is no weak reference - remember!)
  // - since the destructor will release all nested properties, you should
  // never store a reference to any of those nested instances if this owner
  // may be freed before
  TCollectionItemAutoCreateFields = class(TCollectionItem)
  public
    /// this overriden constructor will instantiate all its nested
    // TPersistent/TSynPersistent/TSynAutoCreateFields published properties
    constructor Create(Collection: TCollection); override;
    /// finalize the instance, and release its published properties
    destructor Destroy; override;
  end;

  {$endif LVCL}

  /// abstract TPersistent class, which will instantiate all its nested TPersistent
  // class published properties, then release them (and any T*ObjArray) when freed
  // - TSynAutoCreateFields is to be preferred in most cases, thanks to its
  // lower overhead
  // - note that non published (e.g. public) properties won't be instantiated,
  // serialized, nor released - but may contain weak references to other classes
  // - please take care that you will not create any endless recursion: you should
  // ensure that at one level, nested published properties won't have any class
  // instance refering to its owner (there is no weak reference - remember!)
  // - since the destructor will release all nested properties, you should
  // never store a reference to any of those nested instances if this owner
  // may be freed before
  TPersistentAutoCreateFields = class(TPersistentWithCustomCreate)
  public
    /// this overriden constructor will instantiate all its nested
    // TPersistent/TSynPersistent/TSynAutoCreateFields published properties
    constructor Create; override;
    /// finalize the instance, and release its published properties
    destructor Destroy; override;
  end;

  /// our own empowered TPersistentAutoCreateFields-like parent class
  // - this class is a perfect parent to store any data by value, e.g. DDD Value
  // Objects, Entities or Aggregates
  // - is defined as an abstract class able with a virtual constructor, RTTI
  // for published properties, and automatic memory management of all nested
  // class published properties: any class defined as a published property will
  // be owned by this instance - i.e. with strong reference
  // - will also release any T*ObjArray dynamic array storage of persistents,
  // previously registered via TJSONSerializer.RegisterObjArrayForJSON()
  // - nested published classes (or T*ObjArray) don't need to inherit from
  // TSynAutoCreateFields: they may be from any TPersistent/TSynPersistent type
  // - note that non published (e.g. public) properties won't be instantiated,
  // serialized, nor released - but may contain weak references to other classes
  // - please take care that you will not create any endless recursion: you should
  // ensure that at one level, nested published properties won't have any class
  // instance refering to its owner (there is no weak reference - remember!)
  // - since the destructor will release all nested properties, you should
  // never store a reference to any of those nested instances if this owner
  // may be freed before
  // - TPersistent/TPersistentAutoCreateFields have an unexpected speed overhead
  // due a giant lock introduced to manage property name fixup resolution
  // (which we won't use outside the VCL) - this class is definitively faster
  TSynAutoCreateFields = class(TSynPersistent)
  public
    /// this overriden constructor will instantiate all its nested
    // TPersistent/TSynPersistent/TSynAutoCreateFields published properties
    {$ifdef FPC_OR_PUREPASCAL}
    constructor Create; override;
    {$else}
    class function NewInstance: TObject; override;
    {$endif}
    /// finalize the instance, and release its published properties
    destructor Destroy; override;
    /// virtual method allowing instance customization after initialization
    // - called e.g. by JsonToObject, but may be executed after manual fields
    // assignment
    // - do nothing by default
    // - may be overriden for string interning or content customization
    procedure AfterLoad; virtual;
  end;

  /// adding locking methods to a TSynAutoCreateFields with virtual constructor
  TSynAutoCreateFieldsLocked = class(TSynAutoCreateFields)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the object instance, and its associated lock
    constructor Create; override;
    /// release the instance (including the locking resource)
    destructor Destroy; override;
    /// access to the locking methods of this instance
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: TSynLocker read fSafe;
    /// could be used as a short-cut to Safe.Lock
    procedure Lock; {$ifdef HASINLINE}inline;{$endif}
    /// could be used as a short-cut to Safe.UnLock
    procedure Unlock; {$ifdef HASINLINE}inline;{$endif}
  end;

  /// abstract TInterfacedObject class, which will instantiate all its nested
  // TPersistent/TSynPersistent published properties, then release them when freed
  // - will handle automatic memory management of all nested class and T*ObjArray
  // published properties: any class or T*ObjArray defined as a published
  // property will be owned by this instance - i.e. with strong reference
  // - non published properties (e.g. public) won't be instantiated, so may
  // store weak class references
  // - could be used for gathering of TCollectionItem properties, e.g. for
  // Domain objects in DDD, especially for list of value objects, with some
  // additional methods defined by an Interface
  // - since the destructor will release all nested properties, you should
  // never store a reference to any of those nested instances if this owner
  // may be freed before
  TInterfacedObjectAutoCreateFields = class(TInterfacedObjectWithCustomCreate)
  public
    /// this overriden constructor will instantiate all its nested
    // TPersistent/TSynPersistent/TSynAutoCreateFields class and T*ObjArray
    // published properties
    constructor Create; override;
    /// finalize the instance, and release its published properties
    destructor Destroy; override;
  end;

  /// abstract parent class able to store settings as JSON file
  TSynJsonFileSettings = class(TSynAutoCreateFields)
  protected
    fInitialJsonContent: RawUTF8;
    fFileName: TFileName;
  public
    /// read existing settings from a JSON content
    function LoadFromJson(var aJson: RawUTF8): boolean;
    /// read existing settings from a JSON file
    function LoadFromFile(const aFileName: TFileName): boolean; virtual;
    /// persist the settings as a JSON file, named from LoadFromFile() parameter
    procedure SaveIfNeeded; virtual;
    /// optional persistence file name, as set by LoadFromFile()
    property FileName: TFileName read fFileName;
  end;

  /// used by TRawUTF8ObjectCacheList to manage a list of information cache
  TRawUTF8ObjectCacheSettings = class(TSynPersistent)
  protected
    fTimeOutMS: integer;
    fPurgePeriodMS: integer;
  public
    /// will set default values to settings
    constructor Create; override;
  published
    /// period after which the cache information should be flushed
    // - use -1 to disable time out; any big value will be limited to 10 minutes
    // - default is 120000, i.e. 2 minutes
    property TimeOutMS: integer read fTimeOutMS write fTimeOutMS;
    // period after which TRawUTF8ObjectCacheList will search for expired entries
    // - use -1 to disable purge (not adviced, since may break process)
    // - default is 1000, i.e. 1 second
    property PurgePeriodMS: integer read fPurgePeriodMS write fPurgePeriodMS;
  end;

  TRawUTF8ObjectCacheList = class;

  /// maintain information cache for a given key
  // - after a given period of time, the entry is not deleted, but CacheClear
  // virtual method is called to release the associated data or services
  // - inherit from this abstract class to store your own key-defined information
  // or you own interface-based services
  TRawUTF8ObjectCache = class(TSynAutoCreateFieldsLocked)
  protected
    fKey: RawUTF8; // inherited class could publish fKey with a custom name
    fOwner: TRawUTF8ObjectCacheList;
    fTimeoutMS: integer;
    fTimeoutTix: Int64;
    /// should be called by inherited classes when information or services are set
    // - set fTimeoutTix according to fTimeoutMS, to enable timeout mechanism
    // - could be used when the content is refreshed, to increase the entry TTL
    // - caller should do Safe.Lock to ensure thread-safety
    procedure CacheSet; virtual;
    /// called by Destroy and TRawUTF8ObjectCacheList.DoPurge
    // - set fTimeoutTix := 0 (inherited should also release services interfaces)
    // - protected by Safe.Lock from TRawUTF8ObjectCacheList.DoPurge
    procedure CacheClear; virtual;
  public
    /// initialize the information cache entry
    // - should not be called directly, but by TRawUTF8ObjectCacheList.GetLocked
    constructor Create(aOwner: TRawUTF8ObjectCacheList; const aKey: RawUTF8); reintroduce; virtual;
    /// finalize the information cache entry
    // - will also call the virtual CacheClear method
    destructor Destroy; override;
    /// Dependency Injection using fOwner.OnKeyResolve, for the current Key
    function Resolve(const aInterface: TGUID; out Obj): boolean;
    /// access to the associated storage list
    property Owner: TRawUTF8ObjectCacheList read fOwner;
  end;
  /// class-reference type (metaclass) of a TRawUTF8ObjectCache
  // - used e.g. by TRawUTF8ObjectCacheClass.Create to generate the
  // expected cache instances
  TRawUTF8ObjectCacheClass = class of TRawUTF8ObjectCache;

  /// manage a list of information cache, identified by a hashed key
  // - you should better inherit from this class, to give a custom name and
  // constructor, or alter the default behavior
  // - will maintain a list of TRawUTF8ObjectCache instances
  TRawUTF8ObjectCacheList = class(TRawUTF8List)
  protected
    fSettings: TRawUTF8ObjectCacheSettings;
    fLog: TSynLogFamily;
    fLogEvent: TSynLogInfo;
    fClass: TRawUTF8ObjectCacheClass;
    fNextPurgeTix: Int64;
    fPurgeForceList: TRawUTF8List;
    fOnKeyResolve: TOnKeyResolve;
    procedure DoPurge; virtual;
    // returns fClass.Create by default: inherited classes may add custom check
    // or return nil if Key is invalid
    function NewObjectCache(const Key: RawUTF8): TRawUTF8ObjectCache; virtual;
  public
    /// initialize the cache-information for a given class
    // - inherited classes may reintroduce a new constructor, for ease of use
    constructor Create(aClass: TRawUTF8ObjectCacheClass;
      aSettings: TRawUTF8ObjectCacheSettings; aLog: TSynLogFamily; aLogEvent: TSynLogInfo;
      const aOnKeyResolve: TOnKeyResolve); reintroduce;
    /// finalize the cache information
    destructor Destroy; override;
    /// fill TRawUTF8ObjectCache with the matching key information
    // - an unknown key, but with a successful NewObjectCache() call, will
    // create and append a new fClass instance to the list (if onlyexisting
    // is left to its default FALSE)
    // - global or key-specific purge will be performed, if needed
    // - on success (true), output cache instance will be locked
    function GetLocked(const Key: RawUTF8; out cache: TRawUTF8ObjectCache;
      onlyexisting: boolean=false): boolean; virtual;
    /// you may call this method regularly to check for a needed purge
    // - if Settings.PurgePeriodMS is reached, each TRawUTF8ObjectCache instance
    // will check for its TimeOutMS and call CacheClear if information is outdated
    procedure TryPurge;
    /// register a key identifier so that next TryPurge will flush the entry
    // - a direct CacheClear may trigger a race condition in NewObjectCache:
    // so you may use this function e.g. from a SOA callback
    procedure AddToPurge(const Key: RawUTF8); virtual;
    /// this method will clear all associated information
    // - a regular Clear will destroy all TRawUTF8ObjectCache instances,
    // whereas this method will call CacheClear on each entry, so will
    // be more thread-safe and efficient in pratice
    procedure ForceCacheClear;
    /// access to the associated logging instance
    procedure Log(const TextFmt: RawUTF8; const TextArgs: array of const;
      Level: TSynLogInfo = sllNone);
    /// optional service locator for by-key Dependency Injection
    property OnKeyResolve: TOnKeyResolve read fOnKeyResolve write fOnKeyResolve;
  end;

var
  /// acccess to Zip Deflate compression in level 6 as a TSynCompress class
  AlgoDeflate: TAlgoCompress;
  /// acccess to Zip Deflate compression in level 1 as a TAlgoCompress class
  AlgoDeflateFast: TAlgoCompress;

const
  /// void HTTP Status Code (not a standard value, for internal use only)
  HTTP_NONE = 0;
  /// HTTP Status Code for "Continue"
  HTTP_CONTINUE = 100;
  /// HTTP Status Code for "Switching Protocols"
  HTTP_SWITCHINGPROTOCOLS = 101;
  /// HTTP Status Code for "Success"
  HTTP_SUCCESS = 200;
  /// HTTP Status Code for "Created"
  HTTP_CREATED = 201;
  /// HTTP Status Code for "Accepted"
  HTTP_ACCEPTED = 202;
  /// HTTP Status Code for "Non-Authoritative Information"
  HTTP_NONAUTHORIZEDINFO = 203;
  /// HTTP Status Code for "No Content"
  HTTP_NOCONTENT = 204;
  /// HTTP Status Code for "Reset Content"
  HTTP_RESETCONTENT = 205;
  /// HTTP Status Code for "Partial Content"
  HTTP_PARTIALCONTENT = 206;
  /// HTTP Status Code for "Multiple Choices"
  HTTP_MULTIPLECHOICES = 300;
  /// HTTP Status Code for "Moved Permanently"
  HTTP_MOVEDPERMANENTLY = 301;
  /// HTTP Status Code for "Found"
  HTTP_FOUND = 302;
  /// HTTP Status Code for "See Other"
  HTTP_SEEOTHER = 303;
  /// HTTP Status Code for "Not Modified"
  HTTP_NOTMODIFIED = 304;
  /// HTTP Status Code for "Use Proxy"
  HTTP_USEPROXY = 305;
  /// HTTP Status Code for "Temporary Redirect"
  HTTP_TEMPORARYREDIRECT = 307;
  /// HTTP Status Code for "Bad Request"
  HTTP_BADREQUEST = 400;
  /// HTTP Status Code for "Unauthorized"
  HTTP_UNAUTHORIZED = 401;
  /// HTTP Status Code for "Forbidden"
  HTTP_FORBIDDEN = 403;
  /// HTTP Status Code for "Not Found"
  HTTP_NOTFOUND = 404;
  // HTTP Status Code for "Method Not Allowed"
  HTTP_NOTALLOWED = 405;
  // HTTP Status Code for "Not Acceptable"
  HTTP_NOTACCEPTABLE = 406;
  // HTTP Status Code for "Proxy Authentication Required"
  HTTP_PROXYAUTHREQUIRED = 407;
  /// HTTP Status Code for "Request Time-out"
  HTTP_TIMEOUT = 408;
  /// HTTP Status Code for "Conflict"
  HTTP_CONFLICT = 409;
  /// HTTP Status Code for "Payload Too Large"
  HTTP_PAYLOADTOOLARGE = 413;
  /// HTTP Status Code for "Internal Server Error"
  HTTP_SERVERERROR = 500;
  /// HTTP Status Code for "Not Implemented"
  HTTP_NOTIMPLEMENTED = 501;
  /// HTTP Status Code for "Bad Gateway"
  HTTP_BADGATEWAY = 502;
  /// HTTP Status Code for "Service Unavailable"
  HTTP_UNAVAILABLE = 503;
  /// HTTP Status Code for "Gateway Timeout"
  HTTP_GATEWAYTIMEOUT = 504;
  /// HTTP Status Code for "HTTP Version Not Supported"
  HTTP_HTTPVERSIONNONSUPPORTED = 505;

  /// you can use this cookie value to delete a cookie on the browser side
  COOKIE_EXPIRED = '; Expires=Sat, 01 Jan 2010 00:00:01 GMT';

  /// internal HTTP content-type for efficient static file sending
  // - detected e.g. by http.sys' THttpApiServer.Request or via the NGINX
  // X-Accel-Redirect header's THttpServer.Process for direct sending
  // - the OutCustomHeader should contain the proper 'Content-type: ....'
  // corresponding to the file (e.g. by calling GetMimeContentType() function
  // from SynCommons supplyings the file name)
  // - should match HTTP_RESP_STATICFILE constant defined in SynCrtSock.pas unit
  STATICFILE_CONTENT_TYPE = '!STATICFILE';

  /// used to notify e.g. the THttpServerRequest not to wait for any response
  // from the client
  // - is not to be used in normal HTTP process, but may be used e.g. by
  // TWebSocketProtocolRest.ProcessFrame() to avoid to wait for an incoming
  // response from the other endpoint
  // - should match HTTP_RESP_NORESPONSE constant defined in SynCrtSock.pas unit
  NORESPONSE_CONTENT_TYPE = '!NORESPONSE';

  /// internal HTTP content-type Header for efficient static file sending
  STATICFILE_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+STATICFILE_CONTENT_TYPE;
  /// uppercase version of HTTP header for static file content serving
  STATICFILE_CONTENT_TYPE_HEADER_UPPPER = HEADER_CONTENT_TYPE_UPPER+STATICFILE_CONTENT_TYPE;

var
  /// convert any HTTP_* constant to a short English text
  // - see @http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html
  // - if SynCrtSock is linked (i.e. set mORMotHttpClient or mORMotHttpServer),
  // SynCrtSock StatusCodeToReason() function will be assigned, which is
  // somewhat faster, and more complete
  StatusCodeToErrorMessage: procedure(Code: integer; var result: RawUTF8);

/// convert any HTTP_* constant to an integer error code and its English text
// - see @http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html
// - will call StatusCodeToErrorMessage()
function StatusCodeToErrorMsg(Code: integer): shortstring;

/// returns true for successful HTTP status codes, i.e. in 200..399 range
// - will map mainly SUCCESS (200), CREATED (201), NOCONTENT (204),
// PARTIALCONTENT (206), NOTMODIFIED (304) or TEMPORARYREDIRECT (307) codes
// - any HTTP status not part of this range will be identified as erronous
// request in the internal server statistics
function StatusCodeIsSuccess(Code: integer): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// check the supplied HTTP header to not contain more than one EOL
// - to avoid unexpected HTTP body injection, e.g. from unsafe business code
function IsInvalidHttpHeader(head: PUTF8Char; headlen: PtrInt): boolean;

/// computes an URI with optional jwt authentication parameter
// - if AuthenticationBearer is set, will add its values as additional parameter:
// $ URI?authenticationbearer=URIAuthenticationBearer
function AuthURI(const URI, URIAuthenticationBearer: RawUTF8): RawUTF8;

type
  /// the available HTTP methods transmitted between client and server
  // - some custom verbs are available in addition to standard REST commands
  // - most of iana verbs are available
  // see http://www.iana.org/assignments/http-methods/http-methods.xhtml
  // - for basic CRUD operations, we consider Create=mPOST, Read=mGET,
  // Update=mPUT and Delete=mDELETE - even if it is not fully RESTful
  TSQLURIMethod = (
    mNone, mGET, mPOST, mPUT, mDELETE, mHEAD, mBEGIN, mEND, mABORT, mLOCK, mUNLOCK,
    mSTATE, mOPTIONS, mPROPFIND, mPROPPATCH, mTRACE, mCOPY, mMKCOL, mMOVE, mPURGE,
    mREPORT, mMKACTIVITY, mMKCALENDAR,mCHECKOUT, mMERGE, mNOTIFY, mPATCH, mSEARCH,
    mCONNECT);
  /// set of available HTTP methods transmitted between client and server
  TSQLURIMethods = set of TSQLURIMethod;

/// convert a string HTTP verb into its TSQLURIMethod enumerate
function ToMethod(const method: RawUTF8): TSQLURIMethod;

var
  /// the options used by TSynJsonFileSettings.SaveIfNeeded
  // - you can modify this global variable to customize the whole process
  SETTINGS_WRITEOPTIONS: TTextWriterWriteObjectOptions =
    [woHumanReadable, woStoreStoredFalse, woHumanReadableFullSetsAsStar,
     woHumanReadableEnumSetAsComment, woInt64AsHex];

  /// the options used by TServiceFactoryServer.OnLogRestExecuteMethod
  // - you can modify this global variable to customize the whole process
  SERVICELOG_WRITEOPTIONS: TTextWriterWriteObjectOptions =
    [woDontStoreDefault, woDontStoreEmptyString, woDontStore0,
     woHideSynPersistentPassword];

  /// the options used by TObjArraySerializer, TInterfacedObjectFake and
  // TServiceMethodExecute when serializing values as JSON
  // - used as DEFAULT_WRITEOPTIONS[DontStoreVoidJSON]
  // - you can modify this global variable to customize the whole process
  DEFAULT_WRITEOPTIONS: array[boolean] of TTextWriterWriteObjectOptions = (
    [woDontStoreDefault, woSQLRawBlobAsBase64],
    [woDontStoreDefault, woDontStoreEmptyString, woDontStore0, woSQLRawBlobAsBase64]);

{$ifdef MSWINDOWS}
{$ifdef ISDELPHIXE} // fix Delphi XE imcompatilibility
type
  TSecurityAttributes = packed record
    nLength: DWORD;
    lpSecurityDescriptor: Pointer;
    bInheritHandle: BOOL;
  end;
const
  SECURITY_DESCRIPTOR_REVISION = 1;
  SECURITY_DESCRIPTOR_MIN_LENGTH = 20;
{$endif ISDELPHIXE}
{$endif MSWINDOWS}


{ ******************* process monitoring / statistics }

type
  /// the time periods covered by TSynMonitorUsage process
  // - defines the resolution of information computed and stored
  TSynMonitorUsageGranularity = (
    mugUndefined,
    mugMinute,
    mugHour,
    mugDay,
    mugMonth,
    mugYear);

  /// defines one or several time periods for TSynMonitorUsage process
  TSynMonitorUsageGranularities = set of TSynMonitorUsageGranularity;

  /// how the TSynMonitorUsage storage IDs are computed
  // - stored e.g. in TSQLMonitorUsage.ID primary key (after a shift)
  // - it follows a 23 bit pattern of hour (5 bit), day (5 bit), month (4 bit),
  // year (9 bit - starting at 2016) so that it is monotonic over time
  // - by default, will store the information using mugHour granularity (i.e.
  // values for the 60 minutes in a record), and pseudo-hours of 29, 30 and 31
  // (see USAGE_ID_HOURMARKER[]) will identify mugDay, mugMonth and mugYear
  // consolidated statistics
  // - it will therefore store up to 24*365+365+12+1 = 9138 records per year
  // in the associated storage engine (so there is no actual need to purge it)
  {$ifdef USERECORDWITHMETHODS}TSynMonitorUsageID = record
    {$else}TSynMonitorUsageID = object{$endif}
  public
    /// the TID, as computed from time and granularity
    Value: integer;
    /// computes an ID corresponding to mugHour granularity of a given time
    // - minutes and seconds will be ignored
    // - mugHour granularity will store 0..59 information about each minute
    procedure From(Y,M,D,H: integer); overload;
    /// computes an ID corresponding to mugDay granularity of a given time
    // - hours, minutes and seconds will be merged
    // - mugDay granularity will store 0..23 information about each hour
    // - a pseudo hour of 29 (i.e. USAGE_ID_HOURMARKER[mugDay]) is used
    procedure From(Y,M,D: integer); overload;
    /// computes an ID corresponding to mugMonth granularity of a given time
    // - days, hours, minutes and seconds will be merged
    // - mugMonth granularity will store 0..31 information about each day
    // - a pseudo hour of 30 (i.e. USAGE_ID_HOURMARKER[mugMonth]) is used
    procedure From(Y,M: integer); overload;
    /// computes an ID corresponding to mugYear granularity of a given time
    // - months, days, hours, minutes and seconds will be merged
    // - mugYear granularity will store 0..11 information about each month
    // - a pseudo hour of 31 (i.e. USAGE_ID_HOURMARKER[mugYear]) is used
    procedure From(Y: integer); overload;
    /// computes an ID corresponding to a given time
    // - will set the ID with mugHour granularity, i.e. the information about
    // the given hour, stored as per minute 0..59 values
    // - minutes and seconds in supplied TimeLog value will therefore be ignored
    procedure FromTimeLog(const TimeLog: TTimeLog);
    /// computes an ID corresponding to the current UTC date/time
    // - minutes and seconds will be ignored
    procedure FromNowUTC;
    /// returns the date/time
    // - minutes and seconds will set to 0
    function ToTimeLog: TTimeLog;
    /// convert to Iso-8601 encoded text
    function Text(Expanded: boolean; FirstTimeChar: AnsiChar = 'T'): RawUTF8;
    /// retrieve the resolution of the stored information
    // - i.e. either mugHour, mugDay, mugMonth or mugYear, which will store
    // a true 0..23 hour value (for mugHour), or 29/30/31 pseudo-hour (i.e.
    // USAGE_ID_HOURMARKER[mugDay/mugMonth/mugYear])
    function Granularity: TSynMonitorUsageGranularity;
    /// change the resolution of the stored information
    procedure Truncate(gran: TSynMonitorUsageGranularity);
    /// low-level read of a time field stored in this ID, per granularity
    function GetTime(gran: TSynMonitorUsageGranularity; monthdaystartat0: boolean=false): integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// low-level modification of a time field stored in this ID, per granularity
    procedure SetTime(gran: TSynMonitorUsageGranularity; aValue: integer);
  end;

  TSynMonitorUsageTrackProp = record
    Info: PPropInfo;
    /// property type, as recognized by MonitorPropUsageValue()
    Kind: TSynMonitorType;
    Name: RawUTF8;
    Values: array[mugHour..mugYear] of TInt64DynArray;
    ValueLast: Int64;
  end;
  TSynMonitorUsageTrackPropDynArray = array of TSynMonitorUsageTrackProp;
  TSynMonitorUsageTrack = record
    Instance: TObject;
    Name: RawUTF8;
    Props: TSynMonitorUsageTrackPropDynArray;
  end;
  PSynMonitorUsageTrackProp = ^TSynMonitorUsageTrackProp;
  PSynMonitorUsageTrack = ^TSynMonitorUsageTrack;

  /// abstract class to track, compute and store TSynMonitor detailed statistics
  // - you should inherit from this class to implement proper data persistence,
  // e.g. using TSynMonitorUsageRest for ORM-based storage
  TSynMonitorUsage = class(TSynPersistentLock)
  protected
    fLog: TSynLogFamily;
    fTracked: array of TSynMonitorUsageTrack;
    fValues: array[mugHour..mugYear] of Variant;
    fCustomWritePropGranularity: TSynMonitorUsageGranularity;
    fLastInstance: TObject;
    fLastTrack: PSynMonitorUsageTrack;
    fPrevious: TTimeLogBits;
    fComment: RawUTF8;
    function TrackPropLock(Instance: TObject; Info: PPropInfo): PSynMonitorUsageTrackProp;
    // those methods will be protected (e.g. in Modified) by fSafe.Lock:
    procedure SavePrevious(Scope: TSynMonitorUsageGranularity);
    procedure Save(ID: TSynMonitorUsageID; Gran, Scope: TSynMonitorUsageGranularity);
    function Load(const Time: TTimeLogBits): boolean;
    procedure LoadTrack(var Track: TSynMonitorUsageTrack);
    // should be overriden with proper persistence storage:
    function SaveDB(ID: integer; const Track: variant; Gran: TSynMonitorUsageGranularity): boolean; virtual; abstract;
    function LoadDB(ID: integer; Gran: TSynMonitorUsageGranularity; out Track: variant): boolean; virtual; abstract;
    // may be overriden for testing purposes
    procedure SetCurrentUTCTime(out minutes: TTimeLogBits); virtual;
  public
    /// finalize the statistics, saving any pending information
    destructor Destroy; override;
    /// track the values of one named object instance
    // - will recognize the TSynMonitor* properties as TSynMonitorType from
    // RTTI, using MonitorPropUsageValue(), within any (nested) object
    // - the instance will be stored in fTracked[].Instance: ensure it will
    // stay available during the whole TSynMonitorUsage process
    function Track(Instance: TObject; const Name: RawUTF8=''): integer; overload; virtual;
    /// track the values of the given object instances
    // - will recognize the TSynMonitor* properties as TSynMonitorType from
    // RTTI, using MonitorPropUsageValue(), within any (nested) object
    // - instances will be stored in fTracked[].Instance: ensure they will
    // stay available during the whole TSynMonitorUsage process
    procedure Track(const Instances: array of TSynMonitor); overload;
    /// to be called when tracked properties changed on a tracked class instance
    function Modified(Instance: TObject): integer; overload;
    /// to be called when tracked properties changed on a tracked class instance
    function Modified(Instance: TObject; const PropNames: array of RawUTF8;
      ModificationTime: TTimeLog=0): integer; overload; virtual;
    /// some custom text, associated with the current stored state
    // - will be persistented by Save() methods
    property Comment: RawUTF8 read fComment write fComment;
  end;

const
  USAGE_VALUE_LEN: array[mugHour..mugYear] of integer = (60,24,31,12);
  USAGE_ID_SHIFT: array[mugHour..mugYear] of byte = (0,5,10,14);
  USAGE_ID_BITS: array[mugHour..mugYear] of byte = (5,5,4,9);
  USAGE_ID_MASK: array[mugHour..mugYear] of integer = (31,31,15,511);
  USAGE_ID_MAX: array[mugHour..mugYear] of cardinal = (23,30,11,127);
  USAGE_ID_HOURMARKER: array[mugDay..mugYear] of integer = (29,30,31);
  USAGE_ID_YEAROFFSET = 2016;

  /// kind of "cumulative" TSynMonitorType stored in TSynMonitor / TSynMonitorUsage
  // - those properties will have their values reset for each granularity level
  // - will recognize TSynMonitorTotalMicroSec, TSynMonitorTotalBytes,
  // TSynMonitorOneBytes, TSynMonitorBytesPerSec, TSynMonitorCount and
  // TSynMonitorCount64 types
  SYNMONITORVALUE_CUMULATIVE = [smvMicroSec,smvBytes,smvCount,smvCount64];


function ToText(gran: TSynMonitorUsageGranularity): PShortString; overload;

/// guess the kind of value stored in a TSynMonitor / TSynMonitorUsage property
// - will recognize TSynMonitorTotalMicroSec, TSynMonitorOneMicroSec,
// TSynMonitorTotalBytes, TSynMonitorOneBytes, TSynMonitorBytesPerSec,
// TSynMonitorCount and TSynMonitorCount64 types from supplied RTTI
function MonitorPropUsageValue(info: PPropInfo): TSynMonitorType;


{ ************ main ORM / SOA classes and types }

const
  /// the used TAuthSession.IDCardinal value if the session not started yet
  // - i.e. if the session handling is still in its handshaking phase
  CONST_AUTHENTICATION_SESSION_NOT_STARTED = 0;

  /// the used TAuthSession.IDCardinal value if authentication mode is not set
  // - i.e. if TSQLRest.HandleAuthentication equals FALSE
  CONST_AUTHENTICATION_NOT_USED = 1;

  /// maximum handled dimension for TSQLRecordRTree
  // - this value is the one used by SQLite3 R-Tree virtual table
  RTREE_MAX_DIMENSION = 5;

  /// used as "stored AS_UNIQUE" published property definition in TSQLRecord
  AS_UNIQUE = false;

  /// custom contract value to ignore contract validation from client side
  // - you could set the aContractExpected parameter to this value for
  // TSQLRestClientURI.ServiceDefine or TSQLRestClientURI.ServiceRegister
  // so that the contract won't be checked with the server
  // - it will be used e.g. if the remote server is not a mORMot server,
  // but a plain REST/HTTP server - e.g. for public API notifications
  SERVICE_CONTRACT_NONE_EXPECTED = '*';

  /// maximum number of methods handled by interfaces
  // - if you think this constant is too low, you are about to break
  // the "Interface Segregation" SOLID principle: so don't ask to increase
  // this value, we won't allow to write un-SOLID code! :)
  MAX_METHOD_COUNT = 128;

  /// maximum number of method arguments handled by interfaces
  // - if you consider this as a low value, you should better define some
  // records/classes as DTOs instead of multiplicating parameters: so don't
  // ask to increase this value, we rather encourage writing clean code
  // - used e.g. to avoid creating dynamic arrays if not needed, and
  // ease method calls
  MAX_METHOD_ARGS = 32;

type
  TSQLTable = class;

{$M+} { we need the RTTI information to be compiled for the published
        properties of these classes and their children (like TPersistent),
        to enable ORM - must be defined at the forward definition level }
  TSQLRecordProperties = class;
  TSQLModel = class;
  TSQLModelRecordProperties = class;
  TSQLRecord = class;      // published properties = ORM fields/columns
  TSQLRecordMany = class;
  TSQLAuthUser = class;
  TSQLRest = class;
  TSQLRestClient = class;
  {.$METHODINFO ON} // this will include public methods as RESTful callbacks :(
  TSQLRestServer = class;
  {.$METHODINFO OFF}
  TSQLRestStorage = class;
  TSQLRestStorageRemote = class;
  TSQLRestClientURI = class;
  TInterfaceFactory = class;
  TSQLRestBatch = class;
  TSQLRestBatchLocked = class;
{$M-}

  /// class-reference type (metaclass) of TSQLRecord
  TSQLRecordClass = class of TSQLRecord;

  PClass = ^TClass;
  PSQLRecordClass = ^TSQLRecordClass;

  /// a dynamic array storing TSQLRecord instances
  // - not used direcly, but as specialized T*ObjArray types
  TSQLRecordObjArray = array of TSQLRecord;

  /// a dynamic array used to store the TSQLRecord classes in a Database Model
  TSQLRecordClassDynArray = array of TSQLRecordClass;


  /// exception raised in case of incorrect TSQLTable.Step / Field*() use
  ESQLTableException = class(ESynException);

  /// generic parent class of all custom Exception types of this unit
  EORMException = class(ESynException);

  /// exception raised in case of TSQLRestBatch problem
  EORMBatchException = class(EORMException);

  /// exception raised in case of wrong Model definition
  EModelException = class(EORMException);

  /// exception raised in case of unexpected parsing error
  EParsingException = class(EORMException);

  /// exception raised in case of a Client-Server communication error
  ECommunicationException = class(EORMException);

  /// exception raised in case of an error in project implementation logic
  EBusinessLayerException = class(EORMException);

  /// exception raised in case of any authentication error
  ESecurityException = class(EORMException);

  /// exception dedicated to interface factory, e.g. services and mock/stubs
  EInterfaceFactoryException = class(ESynException);

  /// exception raised in case of Dependency Injection (aka IoC) issue
  EInterfaceResolverException = class(ESynException);

  /// exception dedicated to interface based service implementation
  EServiceException = class(EORMException);

  /// information about a TSQLRecord class property
  // - sftID for TSQLRecord properties, which are pointer(RecordID), not
  // any true class instance
  // - sftMany for TSQLRecordMany properties, for which no data is
  // stored in the table itself, but in a pivot table
  // - sftObject for e.g. TStrings TRawUTF8List TCollection instances
  TSQLPropInfoRTTIInstance = class(TSQLPropInfoRTTIPtrInt)
  protected
    fObjectClass: TClass;
  public
    /// will setup the corresponding ObjectClass property
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    /// direct access to the property class instance
    function GetInstance(Instance: TObject): TObject;
      {$ifdef HASINLINE}inline;{$endif}
    /// direct access to the property class instance
    procedure SetInstance(Instance, Value: TObject);
      {$ifdef HASINLINE}inline;{$endif}
    /// direct access to the property class
    // - can be used e.g. for TSQLRecordMany properties
    property ObjectClass: TClass read fObjectClass;
  end;

  /// information about a TRecordReference/TRecordReferenceToBeDeleted
  // published property
  // - identified as a sftRecord kind of property
  TSQLPropInfoRTTIRecordReference = class(TSQLPropInfoRTTIInt64)
  protected
    fCascadeDelete: boolean;
  public
    /// will identify TRecordReferenceToBeDeleted kind of field, and
    // setup the corresponding CascadeDelete property
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    /// TRUE if this sftRecord is a TRecordReferenceToBeDeleted
    property CascadeDelete: boolean read fCascadeDelete;
  end;

  /// information about a TID published property
  // - identified as a sftTID kind of property, optionally tied to a TSQLRecord
  // class, via its custom type name, e.g.
  // ! TSQLRecordClientID = type TID;  ->  TSQLRecordClient class
  TSQLPropInfoRTTITID = class(TSQLPropInfoRTTIRecordReference)
  protected
    fRecordClass: TSQLRecordClass;
  public
    /// will setup the corresponding RecordClass property from the TID type name
    // - the TSQLRecord type should have previously been registered to the
    // TJSONSerializer.RegisterClassForJSON list, e.g. in TSQLModel.Create, so
    // that e.g. 'TSQLRecordClientID' type name will match TSQLRecordClient
    // - in addition, the '...ToBeDeletedID' name pattern will set CascadeDelete
    constructor Create(aPropInfo: PPropInfo; aPropIndex: integer;
      aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions); override;
    /// the TSQLRecord class associated to this TID
    // - is computed from its type name - for instance, if you define:
    // ! type
    // !   TSQLRecordClientID = type TID;
    // !   TSQLOrder = class(TSQLRecord)
    // !   ...
    // !   published OrderedBy: TSQLRecordClientID read fOrderedBy write fOrderedBy;
    // !   ...
    // then this OrderedBy property will be tied to the TSQLRecordClient class
    // of the corresponding model, and the field value will be reset to 0 when
    // the targetting record is deleted (emulating a ON DELETE SET DEFAULT)
    // - equals TSQLRecord for plain TID field
    // - equals nil if T*ID type name doesn't match any registered class
    property RecordClass: TSQLRecordClass read fRecordClass;
    /// TRUE if this sftTID type name follows the '...ToBeDeletedID' pattern
    // - e.g. 'TSQLRecordClientToBeDeletedID' type name will match
    // TSQLRecordClient and set CascadeDelete
    // - is computed from its type name - for instance, if you define:
    // ! type
    // !   TSQLRecordClientToBeDeletedID = type TID;
    // !   TSQLOrder = class(TSQLRecord)
    // !   ...
    // !   published OrderedBy: TSQLRecordClientToBeDeletedID read fOrderedBy write fOrderedBy;
    // !   ...
    // then this OrderedBy property will be tied to the TSQLRecordClient class
    // of the corresponding model, and the whole record will be deleted when
    // the targetting record is deleted (emulating a ON DELETE CASCADE)
    property CascadeDelete: boolean read fCascadeDelete;
  end;

  /// information about a TRecordVersion published property
  // - identified as a sftRecordVersion kind of property, to track changes
  TSQLPropInfoRTTIRecordVersion = class(TSQLPropInfoRTTIInt64);

  /// information about a TSQLRecord class TSQLRecord property
  // - kind sftID, which are pointer(RecordID), not any true class instance
  // - will store the content just as an integer value
  // - will recognize any instance pre-allocated via Create*Joined() constructor
  TSQLPropInfoRTTIID = class(TSQLPropInfoRTTIInstance)
  public
    /// raise an exception if was created by Create*Joined() constructor
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    /// this method will recognize if the TSQLRecord was allocated by
    // a Create*Joined() constructor: in this case, it will write the ID
    // of the nested property, and not the PtrInt() transtyped value
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
  end;

  TSQLPropInfoRTTIIDObjArray = array of TSQLPropInfoRTTIID;

  /// information about a TSQLRecord class TStrings/TRawUTF8List/TCollection
  // property
  // - kind sftObject e.g. for TStrings TRawUTF8List TCollection TObjectList instances
  // - binary serialization will store textual JSON serialization of the
  // object, including custom serialization
  TSQLPropInfoRTTIObject = class(TSQLPropInfoRTTIInstance)
  protected
    procedure CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject); override;
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
    function GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal; override;
    procedure NormalizeValue(var Value: RawUTF8); override;
    procedure GetJSONValues(Instance: TObject; W: TJSONSerializer); override;
  end;

  /// information about a TSQLRecord class TSQLRecordMany property
  // - kind sftMany, for which no data is stored in the table itself, but in
  // a separated pivot table
  TSQLPropInfoRTTIMany = class(TSQLPropInfoRTTIInstance)
  public
    procedure SetValue(Instance: TObject; Value: PUTF8Char; wasString: boolean); override;
    procedure GetValueVar(Instance: TObject; ToSQL: boolean;
      var result: RawUTF8; wasSQLString: PBoolean); override;
    procedure GetBinary(Instance: TObject; W: TFileBufferWriter); override;
    function SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar; override;
  end;

  TSQLPropInfoRTTIManyObjArray = array of TSQLPropInfoRTTIMany;

  /// the kind of SQlite3 (virtual) table
  // - TSQLRecordFTS3/4/5 will be associated with vFTS3/vFTS4/vFTS5 values,
  // TSQLRecordRTree/TSQLRecordRTreeInteger with rRTree/rRTreeInteger, any native
  // SQlite3 table as vSQLite3, and a TSQLRecordVirtualTable*ID as
  // rCustomForcedID/rCustomAutoID
  // - a plain TSQLRecord class can be defined as rCustomForcedID (e.g. for
  // TSQLRecordMany) after registration for an external DB via a call to
  // VirtualTableExternalRegister() from mORMotDB unit
  TSQLRecordVirtualKind = (
    rSQLite3, rFTS3, rFTS4, rFTS5, rRTree, rRTreeInteger, rCustomForcedID, rCustomAutoID);

  /// kind of (static) database server implementation available
  // - sMainEngine will identify the default main SQlite3 engine
  // - sStaticDataTable will identify a TSQLRestStorageInMemory - i.e.
  // TSQLRestServer.fStaticData[] which can work without SQLite3
  // - sVirtualTable will identify virtual TSQLRestStorage classes - i.e.
  // TSQLRestServer.fStaticVirtualTable[] which points to SQLite3 virtual tables
  // (e.g. TObjectList or external databases)
  TSQLRestServerKind = (sMainEngine, sStaticDataTable, sVirtualTable);
  /// pointer to the kind of (static) database server implementation
  PSQLRestServerKind = ^TSQLRestServerKind;

  /// some information about a given TSQLRecord class properties
  // - used internaly by TSQLRecord, via a global cache handled by this unit:
  // you can access to each record's properties via TSQLRecord.RecordProps class
  // - such a global cache saves some memory for each TSQLRecord instance,
  // and allows faster access to most wanted RTTI properties
  TSQLRecordProperties = class
  protected
    fTable: TSQLRecordClass;
    fClassType: PClassType;
    fClassProp: PClassProp;
    fHasNotSimpleFields: boolean;
    fHasTypeFields: TSQLFieldTypes;
    fFields: TSQLPropInfoList;
    fSimpleFields: TSQLPropInfoObjArray;
    fSQLTableName: RawUTF8;
    fCopiableFields: TSQLPropInfoObjArray;
    fManyFields: TSQLPropInfoRTTIManyObjArray;
    fJoinedFields: TSQLPropInfoRTTIIDObjArray;
    fJoinedFieldsTable: TSQLRecordClassDynArray;
    fDynArrayFields: TSQLPropInfoRTTIDynArrayObjArray;
    fDynArrayFieldsHasObjArray: boolean;
    fBlobCustomFields: TSQLPropInfoObjArray;
    fBlobFields: TSQLPropInfoRTTIObjArray;
    fFilters: TSynFilterOrValidateObjArrayArray;
    fRecordManySourceProp: TSQLPropInfoRTTIInstance;
    fRecordManyDestProp: TSQLPropInfoRTTIInstance;
    fSQLTableNameUpperWithDot: RawUTF8;
    fSQLFillPrepareMany: RawUTF8;
    fSQLTableSimpleFieldsNoRowID: RawUTF8;
    fSQLTableUpdateBlobFields: RawUTF8;
    fSQLTableRetrieveBlobFields: RawUTF8;
    fSQLTableRetrieveAllFields: RawUTF8;
    fRecordVersionField: TSQLPropInfoRTTIRecordVersion;
    fWeakZeroClass: TObject;
    /// the associated TSQLModel instances
    // - e.g. allow O(1) search of a TSQLRecordClass in a model
    fModel: array of record
      /// one associated model
      Model: TSQLModel;
      /// the index in the Model.Tables[] array
      TableIndex: PtrInt;
      /// associated ORM parameters
      Properties: TSQLModelRecordProperties;
    end;
    fLock: TRTLCriticalSection;
    fModelMax: integer;
    fCustomCollation: TRawUTF8DynArray;
    /// add an entry in fModel[] / fModelMax
    procedure InternalRegisterModel(aModel: TSQLModel;
      aTableIndex: integer; aProperties: TSQLModelRecordProperties);
  public
    /// initialize the properties content
    constructor Create(aTable: TSQLRecordClass);
    /// release associated used memory
    destructor Destroy; override;

    /// return TRUE if the given name is either ID/RowID, either a property name
    function IsFieldName(const PropName: RawUTF8): boolean;
    /// return TRUE if the given name is either ID/RowID, either a property name,
    // or an aggregate function (MAX/MIN/AVG/SUM) on a valid property name
    function IsFieldNameOrFunction(const PropName: RawUTF8): boolean;
    /// set all bits corresponding to the supplied field names
    // - returns TRUE on success, FALSE if any field name is not existing
    function FieldBitsFromRawUTF8(const aFields: array of RawUTF8;
      var Bits: TSQLFieldBits): boolean; overload;
    /// set all bits corresponding to the supplied field names
    // - returns the matching fields set
    function FieldBitsFromRawUTF8(const aFields: array of RawUTF8): TSQLFieldBits; overload;
    /// set all bits corresponding to the supplied CSV field names
    // - returns TRUE on success, FALSE if any field name is not existing
    function FieldBitsFromCSV(const aFieldsCSV: RawUTF8;
      var Bits: TSQLFieldBits): boolean; overload;
    /// set all bits corresponding to the supplied CSV field names, including ID
    // - returns TRUE on success, FALSE if any field name is not existing
    // - this overloaded method will identify ID/RowID field name, and set
    // withID output parameter according to its presence
    // - if aFieldsCSV='*', Bits will contain all simple fields, and withID=true
    function FieldBitsFromCSV(const aFieldsCSV: RawUTF8;
      var Bits: TSQLFieldBits; out withID: boolean): boolean; overload;
    /// set all bits corresponding to the supplied CSV field names
    // - returns the matching fields set
    function FieldBitsFromCSV(const aFieldsCSV: RawUTF8): TSQLFieldBits; overload;
    /// set all simple bits corresponding to the simple fields, excluding some
    // - could be a convenient alternative to FieldBitsFromCSV() if only some
    // fields are to be excluded
    // - returns the matching fields set
    function FieldBitsFromExcludingCSV(const aFieldsCSV: RawUTF8;
      aOccasion: TSQLOccasion=soSelect): TSQLFieldBits;
    /// set all bits corresponding to the supplied BLOB field type information
    // - returns TRUE on success, FALSE if blob field is not recognized
    function FieldBitsFromBlobField(aBlobField: PPropInfo;
      var Bits: TSQLFieldBits): boolean;
    /// compute the CSV field names text from a set of bits
    function CSVFromFieldBits(const Bits: TSQLFieldBits): RawUTF8;
    /// set all field indexes corresponding to the supplied field names
    // - returns TRUE on success, FALSE if any field name is not existing
    function FieldIndexDynArrayFromRawUTF8(const aFields: array of RawUTF8;
      var Indexes: TSQLFieldIndexDynArray): boolean; overload;
    /// set all field indexes corresponding to the supplied field names
    // - returns the matching fields set
    function FieldIndexDynArrayFromRawUTF8(const aFields: array of RawUTF8): TSQLFieldIndexDynArray; overload;
    /// set all field indexes corresponding to the supplied CSV field names
    // - returns TRUE on success, FALSE if any field name is not existing
    function FieldIndexDynArrayFromCSV(const aFieldsCSV: RawUTF8;
      var Indexes: TSQLFieldIndexDynArray): boolean; overload;
    /// set all field indexes corresponding to the supplied CSV field names
    // - returns the matching fields set
    function FieldIndexDynArrayFromCSV(const aFieldsCSV: RawUTF8): TSQLFieldIndexDynArray; overload;
    /// set all field indexes corresponding to the supplied BLOB field type information
    // - returns TRUE on success, FALSE if blob field is not recognized
    function FieldIndexDynArrayFromBlobField(aBlobField: PPropInfo;
      var Indexes: TSQLFieldIndexDynArray): boolean;
    /// retrieve a Field property RTTI information from a Property Name
    // - this version returns nil if the property is not a BLOB field
    function BlobFieldPropFromRawUTF8(const PropName: RawUTF8): PPropInfo;
    /// retrieve a Field property RTTI information from a Property Name
    // - this version returns nil if the property is not a BLOB field
    function BlobFieldPropFromUTF8(PropName: PUTF8Char; PropNameLen: integer): PPropInfo;

    /// append a field name to a RawUTF8 Text buffer
    // - if FieldIndex=VIRTUAL_TABLE_ROWID_COLUMN (-1), appends 'RowID' or
    // 'ID' (if ForceNoRowID=TRUE) to Text
    // - on error (i.e. if FieldIndex is out of range) will return TRUE
    // - otherwise, will return FALSE and append the field name to Text
    function AppendFieldName(FieldIndex: Integer; var Text: RawUTF8; ForceNoRowID: boolean): boolean;
    /// return the first unique property of kind RawUTF8
    // - this property is mainly the "Name" property, i.e. the one with
    // "stored AS_UNIQUE" (i.e. "stored false") definition on most TSQLRecord
    // - if ReturnFirstIfNoUnique is TRUE and no unique property is found,
    // the first RawUTF8 property is returned anyway
    // - returns '' if no matching field was found
    function MainFieldName(ReturnFirstIfNoUnique: boolean=false): RawUTF8;
    /// return the SQLite3 field datatype for each specified field
    // - set to '' for fields with no column created in the database (e.g. sftMany)
    // - returns e.g. ' INTEGER, ' or ' TEXT COLLATE SYSTEMNOCASE, '
    function SQLFieldTypeToSQL(FieldIndex: integer): RawUTF8;
    /// set a custom SQlite3 text column collation for a specified field
    // - can be used e.g. to override the default COLLATE SYSTEMNOCASE of RawUTF8
    // - collations defined within our SynSQLite3 unit are named BINARY, NOCASE,
    // RTRIM and our custom SYSTEMNOCASE, ISO8601, WIN32CASE, WIN32NOCASE
    // - do nothing if FieldIndex is not valid, and returns false
    // - could be set in overridden class procedure TSQLRecord.InternalDefineModel
    // so that it will be common to all database models, for both client and server
    function SetCustomCollation(FieldIndex: integer; const aCollationName: RawUTF8): boolean; overload;
    /// set a custom SQlite3 text column collation for a specified field
    // - overloaded method which expects the field to be named
    function SetCustomCollation(const aFieldName, aCollationName: RawUTF8): boolean; overload;
    /// set a custom SQlite3 text column collation for a given field type
    // - can be used e.g. to override ALL default COLLATE SYSTEMNOCASE of RawUTF8,
    // or the default COLLATE ISO8601 of TDateTime, and let the generated SQLite3
    // file be available outside the scope of mORMot's SQLite3 engine
    // - collations defined within our SynSQLite3 unit are named BINARY, NOCASE,
    // RTRIM and our custom SYSTEMNOCASE, ISO8601, WIN32CASE, WIN32NOCASE
    // - could be set in overridden class procedure TSQLRecord.InternalDefineModel
    // so that it will be common to all database models, for both client and server
    // - note that you may inherit from TSQLRecordNoCase to use the NOCASE
    // standard SQLite3 collation for all descendant ORM objects
    procedure SetCustomCollationForAll(aFieldType: TSQLFieldType;
      const aCollationName: RawUTF8);
    /// allow to validate length of all text published properties of this table
    // - the "index" attribute of the RawUTF8/string published properties could
    // be used to specify a maximum length for external VARCHAR() columns
    // - SQLite3 will just ignore this "index" information, but it could be
    // handy to be able to validate the value length before sending to the DB
    // - this method will create TSynValidateText corresponding to the maximum
    // field size specified by the "index" attribute, to validate before write
    // - will expect the "index" value to be in UTF-16 codepoints, unless
    // IndexIsUTF8Length is set to TRUE, indicating UTF-8 length in "index"
    procedure SetMaxLengthValidatorForTextFields(IndexIsUTF8Length: boolean=false);
    /// allow to filter the length of all text published properties of this table
    // - the "index" attribute of the RawUTF8/string published properties could
    // be used to specify a maximum length for external VARCHAR() columns
    // - SQLite3 will just ignore this "index" information, but it could be
    // handy to be able to filter the value length before sending to the DB
    // - this method will create TSynFilterTruncate corresponding to the maximum
    // field size specified by the "index" attribute, to filter before write
    // - will expect the "index" value to be in UTF-16 codepoints, unless
    // IndexIsUTF8Length is set to TRUE, indicating UTF-8 length in "index"
    procedure SetMaxLengthFilterForTextFields(IndexIsUTF8Length: boolean=false);
    {$ifndef NOVARIANTS}
    /// customize the TDocVariant options for all variant published properties
    // - will change the TSQLPropInfoRTTIVariant.DocVariantOptions value
    // - use e.g. as SetVariantFieldDocVariantOptions(JSON_OPTIONS_FAST_EXTENDED)
    // - see also TSQLRecordNoCaseExtended root class
    procedure SetVariantFieldsDocVariantOptions(const Options: TDocVariantOptions);
    {$endif}
    /// return the UTF-8 encoded SQL statement source to alter the table for
    //  adding the specified field
    function SQLAddField(FieldIndex: integer): RawUTF8;

    /// create a TJSONWriter, ready to be filled with TSQLRecord.GetJSONValues
    // - you can use TSQLRecordProperties.FieldBitsFromCSV() or
    // TSQLRecordProperties.FieldBitsFromRawUTF8() to compute aFields
    function CreateJSONWriter(JSON: TStream; Expand, withID: boolean;
      const aFields: TSQLFieldBits; KnownRowsCount: integer;
      aBufSize: integer=8192): TJSONSerializer; overload;
    /// create a TJSONWriter, ready to be filled with TSQLRecord.GetJSONValues(W)
    // - you can use TSQLRecordProperties.FieldBitsFromCSV() or
    // TSQLRecordProperties.FieldBitsFromRawUTF8() to compute aFields
    function CreateJSONWriter(JSON: TStream; Expand, withID: boolean;
      const aFields: TSQLFieldIndexDynArray; KnownRowsCount: integer;
      aBufSize: integer=8192): TJSONSerializer; overload;
    /// create a TJSONWriter, ready to be filled with TSQLRecord.GetJSONValues(W)
    // - this overloaded method will call FieldBitsFromCSV(aFieldsCSV,bits,withID)
    // to retrieve the bits just like a SELECT (i.e. '*' for simple fields)
    function CreateJSONWriter(JSON: TStream; Expand: boolean;
       const aFieldsCSV: RawUTF8; KnownRowsCount: integer;
       aBufSize: integer=8192): TJSONSerializer; overload;
    /// set the W.ColNames[] array content + W.AddColumns
    procedure SetJSONWriterColumnNames(W: TJSONSerializer; KnownRowsCount: integer);
    /// save the TSQLRecord RTTI into a binary header
    // - used e.g. by TSQLRestStorageInMemory.SaveToBinary()
    procedure SaveBinaryHeader(W: TFileBufferWriter);
    /// ensure that the TSQLRecord RTTI matches the supplied binary header
    // - used e.g. by TSQLRestStorageInMemory.LoadFromBinary()
    function CheckBinaryHeader(var R: TFileBufferReader): boolean;
    /// convert a JSON array of simple field values into a matching JSON object
    function SaveSimpleFieldsFromJsonArray(var P: PUTF8Char;
      var EndOfObject: AnsiChar; ExtendedJSON: boolean): RawUTF8;

    /// register a custom filter (transformation) or validation rule to
    // the TSQMRecord class for a specified field
    // - this will be used by TSQLRecord.Filter and TSQLRecord.Validate
    // methods (in default implementation)
    // - will return FALSE in case of an invalid field index
    function AddFilterOrValidate(aFieldIndex: integer;
      aFilter: TSynFilterOrValidate): boolean; overload;
    /// register a custom filter (transformation) or validatation to the
    // TSQLRecord class for a specified field
    // - this will be used by TSQLRecord.Filter and TSQLRecord.Validate
    // methods (in default implementation)
    // - will raise an EModelException if the field name does not exist
    procedure AddFilterOrValidate(const aFieldName: RawUTF8;
      aFilter: TSynFilterOrValidate); overload;

    /// add a custom unmanaged fixed-size record property
    // - simple kind of records (i.e. those not containing reference-counted
    // members) do not have RTTI generated, at least in older versions of Delphi
    // - use this method within TSQLRecord.InternalRegisterCustomProperties
    // overridden method to define a custom record property with no
    // reference-counted types within (like strings) - typical use may be TGUID
    // - main parameters are the record size, in bytes, and the property pointer
    // - add an TSQLPropInfoRecordFixedSize instance to the internal list
    // - if aData2Text/aText2Data parameters are not defined, it will fallback
    // to TSQLPropInfo.BinaryToText() simple text Base64 encoding
    // - can be used to override the default TSQLRecord corresponding method:
    // !class procedure TSQLMyRecord.InternalRegisterCustomProperties(
    // !  Props: TSQLRecordProperties);
    // !begin
    // !  Props.RegisterCustomFixedSizeRecordProperty(self,SizeOf(TMyRec),'RecField',
    // !    @TSQLMyRecord(nil).fRecField, [], SizeOf(TMyRec));
    // !end;
    procedure RegisterCustomFixedSizeRecordProperty(aTable: TClass;
      aRecordSize: cardinal; const aName: RawUTF8;  aPropertyPointer: pointer;
      aAttributes: TSQLPropInfoAttributes; aFieldWidth: integer;
      aData2Text: TOnSQLPropInfoRecord2Text=nil;
      aText2Data: TOnSQLPropInfoRecord2Data=nil);
    /// add a custom record property from its RTTI definition
    // - handle any kind of record with TypeInfo() generated
    // - use this method within InternalRegisterCustomProperties overridden method
    // to define a custom record property containing reference-counted types
    // - main parameters are the record RTTI information, and the property pointer
    // - add an TSQLPropInfoRecordRTTI instance to the internal list
    // - can be used as such:
    // !class procedure TSQLMyRecord.InternalRegisterCustomProperties(
    // !  Props: TSQLRecordProperties);
    // !begin
    // !  Props.RegisterCustomRTTIRecordProperty(self,TypeInfo(TMyRec),'RecField',
    // !    @TSQLMyRecord(nil).fRecField);
    // !end;
    procedure RegisterCustomRTTIRecordProperty(aTable: TClass;
      aRecordInfo: PTypeInfo; const aName: RawUTF8; aPropertyPointer: pointer;
      aAttributes: TSQLPropInfoAttributes=[]; aFieldWidth: integer=0;
      aData2Text: TOnSQLPropInfoRecord2Text=nil;
      aText2Data: TOnSQLPropInfoRecord2Data=nil);
    /// add a custom property from its RTTI definition stored as JSON
    // - handle any kind of record with TypeInfo() generated
    // - use this method within InternalRegisterCustomProperties overridden method
    // to define a custom record property containing reference-counted types
    // - main parameters are the record RTTI information, and the property pointer
    // - add an TSQLPropInfoCustomJSON instance to the internal list
    // - can be used as such:
    // !class procedure TSQLMyRecord.InternalRegisterCustomProperties(
    // !  Props: TSQLRecordProperties);
    // !begin
    // !  Props.RegisterCustomPropertyFromRTTI(self,TypeInfo(TMyRec),'RecField',
    // !    @TSQLMyRecord(nil).fRecField);
    // !end;
    procedure RegisterCustomPropertyFromRTTI(aTable: TClass;
      aTypeInfo: PTypeInfo; const aName: RawUTF8; aPropertyPointer: pointer;
      aAttributes: TSQLPropInfoAttributes=[]; aFieldWidth: integer=0);
    /// add a custom property from its type name, stored as JSON
    // - handle any kind of registered record, including TGUID
    // - use this method within InternalRegisterCustomProperties overridden method
    // to define a custom record property containing reference-counted types
    // - main parameters are the record RTTI information, and the property pointer
    // - add an TSQLPropInfoCustomJSON instance to the internal list
    // - can be used as such:
    // !class procedure TSQLMyRecord.InternalRegisterCustomProperties(
    // !  Props: TSQLRecordProperties);
    // !begin
    // !  Props.RegisterCustomPropertyFromTypeName(self,'TGUID','GUID',
    // !    @TSQLMyRecord(nil).fGUID,[aIsUnique],38);
    // !end;
    procedure RegisterCustomPropertyFromTypeName(aTable: TClass;
      const aTypeName, aName: RawUTF8; aPropertyPointer: pointer;
      aAttributes: TSQLPropInfoAttributes=[]; aFieldWidth: integer=0);

    /// fast access to the RTTI properties attribute
    property TableClassType: PClassType read fClassType;
    /// fast access to the RTTI properties attribute
    property TableClassProp: PClassProp read fClassProp;
    /// if this class has any BLOB or TSQLRecodMany fields
    // - i.e. some fields to be ignored
    property HasNotSimpleFields: boolean read fHasNotSimpleFields;
    /// set of field types appearing in this record
    property HasTypeFields: TSQLFieldTypes read fHasTypeFields;
    /// list all fields, as retrieved from RTTI
    property Fields: TSQLPropInfoList read fFields;
    /// list all "simple" fields of this TSQLRecord
    // - by default, the TSQLRawBlob and TSQLRecordMany fields are not included
    // into this set: they must be read specificaly (in order to spare
    // bandwidth for BLOBs)
    // - dynamic arrays belong to simple fields: they are sent with other
    // properties content
    // - match inverted NOT_SIMPLE_FIELDS mask
    property SimpleFields: TSQLPropInfoObjArray read fSimpleFields;
    /// list all fields which can be copied from one TSQLRecord instance to another
    // - match COPIABLE_FIELDS mask, i.e. all fields except sftMany
    property CopiableFields: TSQLPropInfoObjArray read fCopiableFields;
    /// list all TSQLRecordMany fields of this TSQLRecord
    property ManyFields: TSQLPropInfoRTTIManyObjArray read fManyFields;
    /// list all TSQLRecord fields of this TSQLRecord
    // - ready to be used by TSQLTableJSON.CreateFromTables()
    // - i.e. the class itself then, all fields of type sftID (excluding sftMany)
    property JoinedFields: TSQLPropInfoRTTIIDObjArray read fJoinedFields;
    /// wrapper of all nested TSQLRecord class of this TSQLRecord
    // - ready to be used by TSQLTableJSON.CreateFromTables()
    // - i.e. the class itself as JoinedFieldsTable[0], then, all nested
    // TSQLRecord published properties (of type sftID, ergo excluding sftMany)
    // - equals nil if there is no nested TSQLRecord property (i.e. JoinedFields=nil)
    property JoinedFieldsTable: TSQLRecordClassDynArray read fJoinedFieldsTable;
    /// list of all sftBlobDynArray fields of this TSQLRecord
    property DynArrayFields: TSQLPropInfoRTTIDynArrayObjArray read fDynArrayFields;
    /// TRUE if any of the sftBlobDynArray fields of this TSQLRecord is a T*ObjArray
    // - used e.g. by TSQLRecord.Destroy to release all owned nested instances
    property DynArrayFieldsHasObjArray: boolean read fDynArrayFieldsHasObjArray;
    /// list of all sftBlobCustom fields of this TSQLRecord
    // - have been defined e.g. as TSQLPropInfoCustom custom definition
    property BlobCustomFields: TSQLPropInfoObjArray read fBlobCustomFields;
    /// list all BLOB fields of this TSQLRecord
    // - i.e. generic sftBlob fields (not sftBlobDynArray, sftBlobCustom nor
    // sftBlobRecord)
    property BlobFields: TSQLPropInfoRTTIObjArray read fBlobFields;
    /// all TSynFilter or TSynValidate instances registered per each field
    // - since validation and filtering are used within some CPU-consuming
    // part of the framework (like UI edition), both filters and validation
    // rules are grouped in the same list - for TSynTableFieldProperties there
    // are separated Filters[] and Validates[] arrays, for better performance
    property Filters: TSynFilterOrValidateObjArrayArray read fFilters;
    /// for a TSQLRecordMany class, points to the Source property RTTI
    property RecordManySourceProp: TSQLPropInfoRTTIInstance read fRecordManySourceProp;
    /// for a TSQLRecordMany class, points to the Dest property RTTI
    property RecordManyDestProp: TSQLPropInfoRTTIInstance read fRecordManyDestProp;
    /// points to any TRecordVersion field
    // - contains nil if no such sftRecordVersion field do exist
    // - will be used by low-level storage engine to compute and store the
    // monotonic version number during any write operation
    property RecordVersionField: TSQLPropInfoRTTIRecordVersion read fRecordVersionField;
    /// the Table name in the database in uppercase with a final '.'
    // - e.g. 'TEST.' for TSQLRecordTest class
    // - can be used with IdemPChar() for fast check of a table name
    property SQLTableNameUpperWithDot: RawUTF8 read fSQLTableNameUpperWithDot;
    /// returns 'COL1,COL2' with all COL* set to simple field names
    // - same value as SQLTableSimpleFields[false,false]
    // - this won't change depending on the ORM settings: so it can be safely
    // computed here and not in TSQLModelRecordProperties
    // - used e.g. by TSQLRecord.GetSQLValues
    property SQLTableSimpleFieldsNoRowID: RawUTF8 read fSQLTableSimpleFieldsNoRowID;
    /// returns 'COL1=?,COL2=?' with all BLOB columns names
    // - used e.g. by TSQLRestServerDB.UpdateBlobFields()
    property SQLTableUpdateBlobFields: RawUTF8 read fSQLTableUpdateBlobFields;
    /// returns 'COL1,COL2' with all BLOB columns names
    // - used e.g. by TSQLRestServerDB.RetrieveBlobFields()
    property SQLTableRetrieveBlobFields: RawUTF8 read fSQLTableRetrieveBlobFields;
  public
    /// bit set to 1 for indicating each TSQLFieldType fields of this TSQLRecord
    FieldBits: array[TSQLFieldType] of TSQLFieldBits;
    /// bit set to 1 for indicating TModTime/TSessionUserID fields
    // of this TSQLRecord (leaving TCreateTime untouched)
    // - as applied before an UPDATE
    // - i.e. sftModTime and sftSessionUserID fields
    ComputeBeforeUpdateFieldsBits: TSQLFieldBits;
    /// bit set to 1 for indicating TModTime/TCreateTime/TSessionUserID fields
    // of this TSQLRecord
    // - as applied before an INSERT
    // - i.e. sftModTime, sftCreateTime and sftSessionUserID fields
    ComputeBeforeAddFieldsBits: TSQLFieldBits;
    /// bit set to 1 for indicating fields to export, i.e. "simple" fields
    // - this array will handle special cases, like the TCreateTime fields
    // which shall not be included in soUpdate but soInsert and soSelect e.g.
    SimpleFieldsBits: array[TSQLOccasion] of TSQLFieldBits;
    /// number of fields to export, i.e. "simple" fields
    // - this array will handle special cases, like the TCreateTime fields
    // which shall not be included in soUpdate but soInsert and soSelect e.g.
    SimpleFieldsCount: array[TSQLOccasion] of integer;
    /// bit set to 1 for an unique field
    // - an unique field is defined as "stored AS_UNIQUE" (i.e. "stored false")
    // in its property definition
    IsUniqueFieldsBits: TSQLFieldBits;
    /// bit set to 1 for the smallest simple fields
    // - i.e. excluding non only sftBlob and sftMany, but also sftVariant,
    // sftBlobDynArray, sftBlobCustom and sftUTF8Custom fields
    // - may be used to minimize the transmitted content, e.g. when serializing
    // to JSON for the most
    SmallFieldsBits: TSQLFieldBits;
    /// bit set to 1 for the all fields storing some data
    // - match COPIABLE_FIELDS mask, i.e. all fields except sftMany
    CopiableFieldsBits: TSQLFieldBits;
    /// contains the main field index (e.g. mostly 'Name')
    // - the [boolean] is for [ReturnFirstIfNoUnique] version
    // - contains -1 if no field matches
    MainField: array[boolean] of integer;
    /// count of coordinate fields of a TSQLRecordRTree, before auxiliary columns
    RTreeCoordBoundaryFields: integer;
  published
    /// the TSQLRecord class
    property Table: TSQLRecordClass read fTable;
    /// the Table name in the database, associated with this TSQLRecord class
    // - 'TSQL' or 'TSQLRecord' chars are trimmed at the beginning of the ClassName
    // - or the ClassName is returned as is, if no 'TSQL' or 'TSQLRecord' at first
    property SQLTableName: RawUTF8 read fSQLTableName;
    /// returns 'COL1,COL2' with all COL* set to all field names, including
    // RowID, TRecordVersion and BLOBs
    // - this won't change depending on the ORM settings: so it can be safely
    // computed here and not in TSQLModelRecordProperties
    // - used e.g. by TSQLRest.InternalListJSON()
    property SQLTableRetrieveAllFields: RawUTF8 read fSQLTableRetrieveAllFields;
  end;

  TServiceFactoryServer = class;
  PSQLAccessRights = ^TSQLAccessRights;

  /// flags which may be set by the caller to notify low-level context
  // - llfHttps will indicates that the communication was made over HTTPS
  // - llfSecured is set if the transmission is encrypted or in-process,
  // using e.g. HTTPS/SSL/TLS or our proprietary AES/ECDHE algorithms
  // - llfWebsockets communication was made using WebSockets
  TSQLRestURIParamsLowLevelFlag = (llfHttps, llfSecured, llfWebsockets);

  /// some flags set by the caller to notify low-level context
  TSQLRestURIParamsLowLevelFlags = set of TSQLRestURIParamsLowLevelFlag;

  /// store all parameters for a Client or Server method call
  // - as used by TSQLRestServer.URI or TSQLRestClientURI.InternalURI
  {$ifdef USERECORDWITHMETHODS}TSQLRestURIParams = record
    {$else}TSQLRestURIParams = object{$endif}
  public
    /// input parameter containing the caller URI
    Url: RawUTF8;
    /// input parameter containing the caller method
    // - handle enhanced REST codes: LOCK/UNLOCK/BEGIN/END/ABORT
    Method: RawUTF8;
    /// input parameter containing the caller message headers
    // - you can use e.g. to retrieve the remote IP:
    // ! Call.Header(HEADER_REMOTEIP_UPPER)
    // ! or FindNameValue(Call.InHead,HEADER_REMOTEIP_UPPER)
    // but consider rather using TSQLRestServerURIContext.RemoteIP
    InHead: RawUTF8;
    /// input parameter containing the caller message body
    // - e.g. some GET/POST/PUT JSON data can be specified here
    InBody: RawUTF8;
    /// output parameter to be set to the response message header
    // - it is the right place to set the returned message body content type,
    // e.g. TEXT_CONTENT_TYPE_HEADER or HTTP_CONTENT_TYPE_HEADER: if not set,
    // the default JSON_CONTENT_TYPE_HEADER will be returned to the client,
    // meaning that the message is JSON
    // - you can use OutBodyType() function to retrieve the stored content-type
    OutHead: RawUTF8;
    /// output parameter to be set to the response message body
    OutBody: RawUTF8;
    /// output parameter to be set to the HTTP status integer code
    // - HTTP_NOTFOUND=404 e.g. if the url doesn't start with Model.Root (caller
    // can try another TSQLRestServer)
    OutStatus: cardinal;
    /// output parameter to be set to the database internal state
    OutInternalState: cardinal;
    /// associated RESTful access rights
    // - AccessRights must be handled by the TSQLRestServer child, according
    // to the Application Security Policy (user logging, authentification and
    // rights management) - making access rights a parameter allows this method
    // to be handled as pure stateless, thread-safe and session-free
    RestAccessRights: PSQLAccessRights;
    /// opaque reference to the protocol context which made this request
    // - may point e.g. to a THttpServerResp, a TWebSocketServerResp,
    // a THttpApiServer, a TSQLRestClientURI, a TFastCGIServer or a
    // TSQLRestServerNamedPipeResponse instance
    // - stores SynCrtSock's THttpServerConnectionID, i.e. a Int64 as expected
    // by http.sys, or an incremental rolling sequence of 31-bit integers for
    // THttpServer/TWebSocketServer, or maybe a raw PtrInt(self/THandle)
    LowLevelConnectionID: Int64;
    /// low-level properties of the current protocol context
    LowLevelFlags: TSQLRestURIParamsLowLevelFlags;
    /// initialize the non RawUTF8 values
    procedure Init; overload;
    /// initialize the input values
    procedure Init(const aURI,aMethod,aInHead,aInBody: RawUTF8); overload;
    /// retrieve the "Content-Type" value from InHead
    // - if GuessJSONIfNoneSet is TRUE, returns JSON if none was set in headers
    function InBodyType(GuessJSONIfNoneSet: boolean=True): RawUTF8;
    /// check if the "Content-Type" value from InHead is JSON
    // - if GuessJSONIfNoneSet is TRUE, assume JSON is used
    function InBodyTypeIsJson(GuessJSONIfNoneSet: boolean=True): boolean;
    /// retrieve the "Content-Type" value from OutHead
    // - if GuessJSONIfNoneSet is TRUE, returns JSON if none was set in headers
    function OutBodyType(GuessJSONIfNoneSet: boolean=True): RawUTF8;
    /// check if the "Content-Type" value from OutHead is JSON
    // - if GuessJSONIfNoneSet is TRUE, assume JSON is used
    function OutBodyTypeIsJson(GuessJSONIfNoneSet: boolean=True): boolean;
    /// just a wrapper around FindNameValue(InHead,UpperName)
    // - use e.g. as
    // ! Call.Header(HEADER_REMOTEIP_UPPER) or Call.Header(HEADER_BEARER_UPPER)
    // - consider rather using TSQLRestServerURIContext.InHeader[] or even
    // dedicated TSQLRestServerURIContext.RemoteIP/AuthenticationBearerToken
    function Header(UpperName: PAnsiChar): RawUTF8;
      {$ifdef HASINLINE}inline;{$endif}
    /// wrap FindNameValue(InHead,UpperName) with a cache store
    function HeaderOnce(var Store: RawUTF8; UpperName: PAnsiChar): RawUTF8;
  end;

  /// used to map set of parameters for a Client or Server method call
  PSQLRestURIParams = ^TSQLRestURIParams;

  /// callback event signature before/after a Client or Server method call
  // - to allow low-level interception of the request bodies e.g. for low-level
  // logging/audit, or on-the-fly encryption and/or signature of the content
  // - used by TSQLRest.OnDecryptBody and TSQLRest.OnEncryptBody - so the very
  // same callbacks may be used on both client and server sides
  // - for server-only process (e.g. to check for authorization), see rather
  // TSQLRestServer.OnBeforeURI and TSQLRestServer.OnAfterURI events
  // - used e.g. by TSQLRest.SetCustomEncryption method
  TNotifyRestBody = procedure(Sender: TSQLRest; var Body,Head,URL: RawUTF8) of object;

  /// points to the currently running service on the server side
  // - your code may use such a local pointer to retrieve the ServiceContext
  // threadvar once in a method, since threadvar access does cost some CPU
  // !var context: PServiceRunningContext;
  // !begin
  // !  context := @ServiceContext; // threadvar access once
  // !  ...
  PServiceRunningContext = ^TServiceRunningContext;

  TSQLRestServerURIContext = class;
  TAuthSession = class;

  /// used to identify the authentication failure reason
  // - as transmitted e.g. by TSQLRestServerURIContext.AuthenticationFailed or
  // TSQLRestServer.OnAuthenticationFailed
  TNotifyAuthenticationFailedReason = (
    afInvalidSignature,afRemoteServiceExecutionNotAllowed,
    afUnknownUser,afInvalidPassword,
    afSessionAlreadyStartedForThisUser,afSessionCreationAborted,
    afSecureConnectionRequired, afJWTRequired);

  /// will identify the currently running service on the server side
  // - is the type of the global ServiceContext threadvar
  // - to access the current TSQLRestServer instance (and e.g. its ORM/CRUD
  // or SOA methods), use Request.Server and not Factory.Server, which may not
  // be available e.g. if you run the service from the server side (so no
  // factory is involved)
  // - note that the safest (and slightly faster) access to the TSQLRestServer
  // instance associated with a service is to inherit your implementation
  // class from TInjectableObjectRest
  TServiceRunningContext = record
    /// the currently running service factory
    // - it can be used within server-side implementation to retrieve the
    // associated TSQLRestServer instance
    // - note that TServiceFactoryServer.Get() won't override this value, when
    // called within another service (i.e. if Factory is not nil)
    Factory: TServiceFactoryServer;
    /// the currently runnning context which launched the method
    // - low-level RESTful context is also available in its Call member
    // - Request.Server is the safe access point to the underlying TSQLRestServer,
    // unless the service is implemented via TInjectableObjectRest, so the
    // TInjectableObjectRest.Server property is preferred
    // - make available e.g. current session or authentication parameters
    // (including e.g. user details via Request.Server.SessionGetUser)
    Request: TSQLRestServerURIContext;
    /// the thread which launched the request
    // - is set by TSQLRestServer.BeginCurrentThread from multi-thread server
    // handlers - e.g. TSQLite3HttpServer or TSQLRestServerNamedPipeResponse
    RunningThread: TThread;
  end;

  /// possible service provider method options, e.g. about logging or execution
  // - see TServiceMethodOptions for a description of each available option
  TServiceMethodOption = (
    optExecLockedPerInterface,
    optExecInPerInterfaceThread, optFreeInPerInterfaceThread,
    {$ifndef LVCL}
    optExecInMainThread, optFreeInMainThread,
    optVariantCopiedByReference, optInterceptInputOutput,
    {$endif}
    optNoLogInput, optNoLogOutput,
    optErrorOnMissingParam, optForceStandardJSON, optDontStoreVoidJSON,
    optIgnoreException);
  /// how TServiceFactoryServer.SetOptions() will set the options value
  TServiceMethodOptionsAction = (moaReplace, moaInclude, moaExclude);

  /// set of per-method execution options for an interface-based service provider
  // - by default, mehthod executions are concurrent, for better server
  // responsiveness; if you set optExecLockedPerInterface, all methods of
  // a given interface will be executed with a critical section
  // - optExecInMainThread will force the method to be called within
  // a RunningThread.Synchronize() call - it can be used e.g. if your
  // implementation rely heavily on COM servers - by default, service methods
  // are called within the thread which received them, on multi-thread server
  // instances (e.g. TSQLite3HttpServer or TSQLRestServerNamedPipeResponse),
  // for better response time and CPU use (this is the technical reason why
  // service implementation methods have to handle multi-threading safety
  // carefully, e.g. by using TRTLCriticalSection mutex on purpose)
  // - optFreeInMainThread will force the _Release/Destroy method to be run
  // in the main thread: setting this option for any method will affect the
  // whole service class - is not set by default, for performance reasons
  // - optExecInPerInterfaceThread and optFreeInPerInterfaceThread will allow
  // creation of a per-interface dedicated thread
  // - if optInterceptInputOutput is set, TServiceFactoryServer.AddInterceptor()
  // events will have their Sender.Input/Output values defined
  // - if optNoLogInput/optNoLogOutput is set, TSynLog and ServiceLog() database
  // won't log any parameter values at input/output - this may be useful for
  // regulatory/safety purposes, e.g. to ensure that no sensitive information
  // (like a credit card number or a password), is logged during process -
  // consider using TInterfaceFactory.RegisterUnsafeSPIType() instead if you
  // prefer a more tuned filtering, for specific high-level types
  // - when parameters are transmitted as JSON object, any missing parameter
  // will be replaced by their default value, unless optErrorOnMissingParam
  // is defined to reject the call
  // - by default, it wil check for the client user agent, and use extended
  // JSON if none is found (e.g. from WebSockets), or if it contains 'mORMot':
  // you can set optForceStandardJSON to ensure standard JSON is always returned
  // - optDontStoreVoidJSON will reduce the JSON object verbosity by not writing
  // void (e.g. 0 or '') properties when serializing objects and records
  // - any exceptions will be propagated during execution, unless
  // optIgnoreException is set and the exception is trapped (not to be used
  // unless you know what you are doing)
  TServiceMethodOptions = set of TServiceMethodOption;

  /// class-reference type (metaclass) for storing interface-based service
  // execution statistics
  // - you could inherit from TSQLRecordServiceLog, and specify additional
  // fields corresponding to the execution context
  TSQLRecordServiceLogClass = class of TSQLRecordServiceLog;

  /// class-reference type (metaclass) for storing interface-based service
  // execution statistics used for DB-based asynchronous notifications
  // - as used by TServiceFactoryClient.SendNotifications
  TSQLRecordServiceNotificationsClass = class of TSQLRecordServiceNotifications;

  /// internal per-method list of execution context as hold in TServiceFactory
  TServiceFactoryExecution = record
    /// the list of denied TSQLAuthGroup ID(s)
    // - used on server side within TSQLRestServerURIContext.ExecuteSOAByInterface
    // - bit 0 for client TSQLAuthGroup.ID=1 and so on...
    // - is therefore able to store IDs up to 256
    // - void by default, i.e. no denial = all groups allowed for this method
    Denied: set of 0..255;
    /// execution options for this method (about thread safety or logging)
    Options: TServiceMethodOptions;
    /// where execution information should be written as TSQLRecordServiceLog
    LogRest: TSQLRest;
    /// the TSQLRecordServiceLog class to use, as defined in LogRest.Model
    LogClass: TSQLRecordServiceLogClass;
  end;
  /// points to the execution context of one method within TServiceFactory
  PServiceFactoryExecution = ^TServiceFactoryExecution;

  /// all commands which may be executed by TSQLRestServer.URI() method
  // - execSOAByMethod for method-based services
  // - execSOAByInterface for interface-based services
  // - execORMGet for ORM reads i.e. Retrieve*() methods
  // - execORMWrite for ORM writes i.e. Add Update Delete TransactionBegin
  // Commit Rollback methods
  TSQLRestServerURIContextCommand = (
    execNone, execSOAByMethod, execSOAByInterface, execORMGet, execORMWrite);

  /// class used to define the Client-Server expected routing
  // - most of the internal methods are declared as virtual, so it allows any
  // kind of custom routing or execution scheme
  // - TSQLRestRoutingREST and TSQLRestRoutingJSON_RPC classes
  // are provided in this unit, to allow RESTful and JSON/RPC protocols
  TSQLRestServerURIContextClass = class of TSQLRestServerURIContext;

  /// a set of potential actions to be executed from the server
  // - reSQL will indicate the right to execute any POST SQL statement (not only
  // SELECT statements)
  // - reSQLSelectWithoutTable will allow executing a SELECT statement with
  // arbitrary content via GET/LOCK (simple SELECT .. FROM aTable will be checked
  // against TSQLAccessRights.GET[] per-table right
  // - reService will indicate the right to execute the interface-based JSON-RPC
  // service implementation
  // - reUrlEncodedSQL will indicate the right to execute a SQL query encoded
  // at the URI level, for a GET (to be used e.g. with XMLHTTPRequest, which
  // forced SentData='' by definition), encoded as sql=.... inline parameter
  // - reUrlEncodedDelete will indicate the right to delete items using a
  // WHERE clause for DELETE verb at /root/TableName?WhereClause
  // - reOneSessionPerUser will force that only one session may be created
  // for one user, even if connection comes from the same IP: in this case,
  // you may have to set the SessionTimeOut to a small value, in case the
  // session is not closed gracefully
  // - by default, read/write access to the TSQLAuthUser table is disallowed,
  // for obvious security reasons: but you can define reUserCanChangeOwnPassword
  // so that the current logged user will be able to change its own password
  // - order of this set does matter, since it will be stored as a byte value
  // e.g. by TSQLAccessRights.ToString: ensure that new items will always be
  // appended to the list, not inserted within
  TSQLAllowRemoteExecute = set of (
    reSQL, reService, reUrlEncodedSQL, reUrlEncodedDelete, reOneSessionPerUser,
    reSQLSelectWithoutTable, reUserCanChangeOwnPassword);

  /// set the User Access Rights, for each Table
  // - one property for every and each URI method (GET/POST/PUT/DELETE)
  // - one bit for every and each Table in Model.Tables[]
  {$ifdef USERECORDWITHMETHODS}TSQLAccessRights = record
    {$else}TSQLAccessRights = object{$endif}
  public
    /// set of allowed actions on the server side
    AllowRemoteExecute: TSQLAllowRemoteExecute;
    /// GET method (retrieve record) table access bits
    // - note that a GET request with a SQL statement without a table (i.e.
    // on 'ModelRoot' URI with a SQL statement as SentData, as used in
    // TSQLRestClientURI.UpdateFromServer) will be checked for simple cases
    // (i.e. the first table in the FROM clause), otherwise will follow , whatever the bits
    // here are: since TSQLRestClientURI.UpdateFromServer() is called only
    // for refreshing a direct statement, it will be OK; you can improve this
    // by overriding the TSQLRestServer.URI() method
    // - if the REST request is LOCK, the PUT access bits will be read instead
    // of the GET bits value
    GET: TSQLFieldTables;
    /// POST method (create record) table access bits
    POST: TSQLFieldTables;
    /// PUT method (update record) table access bits
    // - if the REST request is LOCK, the PUT access bits will be read instead
    // of the GET bits value
    PUT: TSQLFieldTables;
    /// DELETE method (delete record) table access bits
    DELETE: TSQLFieldTables;
    /// wrapper method which can be used to set the CRUD abilities over a table
    // - C=Create, R=Read, U=Update, D=Delete rights
    procedure Edit(aTableIndex: integer; C, R, U, D: Boolean); overload;
    /// wrapper method which can be used to set the CRUD abilities over a table
    // - use TSQLOccasion set as parameter
    procedure Edit(aTableIndex: integer; aRights: TSQLOccasions); overload;
    /// wrapper method which can be used to set the CRUD abilities over a table
    // - will raise an EModelException if the supplied table is incorrect
    // - C=Create, R=Read, U=Update, D=Delete rights
    procedure Edit(aModel: TSQLModel; aTable: TSQLRecordClass; C, R, U, D: Boolean); overload;
    /// wrapper method which can be used to set the CRUD abilities over a table
    // - will raise an EModelException if the supplied table is incorrect
    // - use TSQLOccasion set as parameter
    procedure Edit(aModel: TSQLModel; aTable: TSQLRecordClass; aRights: TSQLOccasions); overload;
    /// serialize the content as TEXT
    // - use the TSQLAuthGroup.AccessRights CSV format
    function ToString: RawUTF8;
    /// unserialize the content from TEXT
    // - use the TSQLAuthGroup.AccessRights CSV format
    procedure FromString(P: PUTF8Char);
    /// validate mPost/mPut/mDelete action against those access rights
    // - used by TSQLRestServerURIContext.ExecuteORMWrite and
    // TSQLRestServer.EngineBatchSend methods for proper security checks
    function CanExecuteORMWrite(Method: TSQLURIMethod;
      Table: TSQLRecordClass; TableIndex: integer; const TableID: TID;
      Context: TSQLRestServerURIContext): boolean;
  end;

  /// used by TSQLRestServerURIContext.ClientKind to identify the currently
  // connected client
  TSQLRestServerURIContextClientKind = (ckUnknown, ckFramework, ckAJAX);
  //// used to customize TSQLRestServerURIContext.ClientSideInvoke process
  TSQLRestServerURIContextClientInvoke = set of (csiAsOctetStream);

  /// abstract calling context for a TSQLRestServerCallBack event handler
  // - having a dedicated class avoid changing the implementation methods
  // signature if the framework add some parameters or behavior to it
  // - see TSQLRestServerCallBack for general code use
  // - most of the internal methods are declared as virtual, so it allows any
  // kind of custom routing or execution scheme
  // - instantiated by the TSQLRestServer.URI() method using its ServicesRouting
  // property
  // - see TSQLRestRoutingREST and TSQLRestRoutingJSON_RPC for working inherited
  // classes - NEVER set this abstract TSQLRestServerURIContext class to
  // TSQLRest.ServicesRouting property !
  TSQLRestServerURIContext = class
  protected
    fInput: TRawUTF8DynArray; // even items are parameter names, odd are values
    fInputPostContentType: RawUTF8;
    fInputCookiesRetrieved: boolean;
    fInputCookies: array of record
      Name, Value: RawUTF8; // only computed if InCookie[] is used
    end;
    fInHeaderLastName: RawUTF8;
    fInHeaderLastValue: RawUTF8;
    fOutSetCookie: RawUTF8;
    fUserAgent: RawUTF8;
    fAuthenticationBearerToken: RawUTF8;
    fRemoteIP: RawUTF8;
    fSession: TAuthSession; // not published to avoid unexpected GPF on access
    fServiceListInterfaceMethodIndex: integer;
    fClientKind: TSQLRestServerURIContextClientKind;
    // just a wrapper over @ServiceContext threadvar
    fThreadServer: PServiceRunningContext;
    fSessionAccessRights: TSQLAccessRights; // fSession may be deleted meanwhile
    {$ifndef NOVARIANTS}
    function GetInput(const ParamName: RawUTF8): variant;
    function GetInputOrVoid(const ParamName: RawUTF8): variant;
    {$endif}
    function GetInputNameIndex(const ParamName: RawUTF8): PtrInt;
    function GetInputExists(const ParamName: RawUTF8): Boolean;
    function GetInputInt(const ParamName: RawUTF8): Int64;
    function GetInputDouble(const ParamName: RawUTF8): Double;
    procedure GetInputByName(const ParamName,InputName: RawUTF8; var result: RawUTF8);
    function GetInputUTF8(const ParamName: RawUTF8): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    function GetInputString(const ParamName: RawUTF8): string;
    function GetInputIntOrVoid(const ParamName: RawUTF8): Int64; {$ifdef HASINLINE}inline;{$endif}
    function GetInputHexaOrVoid(const ParamName: RawUTF8): cardinal;
    function GetInputDoubleOrVoid(const ParamName: RawUTF8): Double;
    function GetInputUTF8OrVoid(const ParamName: RawUTF8): RawUTF8;
    function GetInputStringOrVoid(const ParamName: RawUTF8): string;
    function GetInHeader(const HeaderName: RawUTF8): RawUTF8;
    procedure RetrieveCookies;
    function GetInCookie(CookieName: RawUTF8): RawUTF8;
    procedure SetInCookie(CookieName, CookieValue: RawUTF8);
    function GetUserAgent: RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    function GetRemoteIP: RawUTF8;  {$ifdef HASINLINE}inline;{$endif}
    function GetRemoteIPNotLocal: RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    function GetRemoteIPIsLocalHost: boolean; {$ifdef HASINLINE}inline;{$endif}
    function GetResourceFileName: TFileName;
    procedure SetOutSetCookie(aOutSetCookie: RawUTF8);
    procedure ServiceResultStart(WR: TTextWriter); virtual;
    procedure ServiceResultEnd(WR: TTextWriter; ID: TID); virtual;
    procedure InternalSetTableFromTableIndex(Index: integer); virtual;
    procedure InternalSetTableFromTableName(TableName: PUTF8Char); virtual;
    procedure InternalExecuteSOAByInterface; virtual;
    procedure StatsFromContext(Stats: TSynMonitorInputOutput;
      var Diff: Int64; DiffIsMicroSecs: boolean);
    /// event raised by ExecuteMethod() for interface parameters
    // - match TServiceMethodInternalExecuteCallback signature
    procedure ExecuteCallback(var Par: PUTF8Char; ParamInterfaceInfo: PTypeInfo;
      out Obj);
    /// retrieve RESTful URI routing
    // - should set URI, Table,TableIndex,TableRecordProps,TableEngine,
    // ID, URIBlobFieldName and Parameters members
    // - all Table* members will be set via a InternalSetTableFromTableName() call
    // - default implementation expects an URI encoded with
    // 'ModelRoot[/TableName[/TableID][/BlobFieldName]][?param=...]' format
    // - will also set URISessionSignaturePos and URIWithoutSignature members
    // - return FALSE in case of incorrect URI (e.g. does not match Model.Root)
    function URIDecodeREST: boolean; virtual;
    /// retrieve method-based SOA URI routing with optional RESTful mode
    // - should set MethodIndex member
    // - default RESTful implementation expects an URI encoded with
    // 'ModelRoot/MethodName' or 'ModelRoot/TableName[/TableID]/MethodName' formats
    procedure URIDecodeSOAByMethod; virtual;
    /// retrieve interface-based SOA
    // - should set Service member (and possibly ServiceMethodIndex)
    // - abstract implementation which is to be overridden
    procedure URIDecodeSOAByInterface; virtual; abstract;
    /// process authentication
    // - return FALSE in case of invalid signature, TRUE if authenticated
    function Authenticate: boolean; virtual;
    /// method called in case of authentication failure
    // - the failure origin is stated by the Reason parameter
    // - this default implementation will just set OutStatus := HTTP_FORBIDDEN
    // and call TSQLRestServer.OnAuthenticationFailed event (if any)
    procedure AuthenticationFailed(Reason: TNotifyAuthenticationFailedReason); virtual;
    /// direct launch of a method-based service
    // - URI() will ensure that MethodIndex>=0 before calling it
    procedure ExecuteSOAByMethod; virtual;
    /// direct launch of an interface-based service
    // - URI() will ensure that Service<>nil before calling it
    // - abstract implementation which is to be overridden
    procedure ExecuteSOAByInterface; virtual; abstract;
    /// handle GET/LOCK/UNLOCK/STATE verbs for ORM/CRUD process
    procedure ExecuteORMGet; virtual;
    /// handle POST/PUT/DELETE/BEGIN/END/ABORT verbs for ORM/CRUD process
    // - execution of this method is protected by a critical section
    procedure ExecuteORMWrite; virtual;
    /// launch the Execute* method  in the execution mode
    // set by Server.AcquireExecutionMode/AcquireExecutionLockedTimeOut
    // - this is the main process point from TSQLRestServer.URI()
    procedure ExecuteCommand;
  public
    /// the associated TSQLRestServer instance which executes its URI method
    Server: TSQLRestServer;
    /// the used Client-Server method (matching the corresponding HTTP Verb)
    // - this property will be set from incoming URI, even if RESTful
    // authentication is not enabled
    Method: TSQLURIMethod;
    /// the URI address, excluding trailing /info and ?par1=.... parameters
    // - can be either the table name (in RESTful protocol), or a service name
    URI: RawUTF8;
    /// same as Call^.URI, but without the &session_signature=... ending
    URIWithoutSignature: RawUTF8;
    /// points inside Call^.URI, after the 'root/' prefix
    URIAfterRoot: PUTF8Char;
    /// the optional Blob field name as specified in URI
    // - e.g. retrieved from "ModelRoot/TableName/TableID/BlobFieldName"
    URIBlobFieldName: RawUTF8;
    /// position of the &session_signature=... text in Call^.url string
    URISessionSignaturePos: integer;
    /// the Table as specified at the URI level (if any)
    Table: TSQLRecordClass;
    /// the index in the Model of the Table specified at the URI level (if any)
    TableIndex: integer;
    /// the RTTI properties of the Table specified at the URI level (if any)
    TableRecordProps: TSQLModelRecordProperties;
    /// the RESTful instance implementing the Table specified at the URI level (if any)
    // - equals TSQLRestServer most of the time, but may be an TSQLRestStorage
    // for any in-memory/MongoDB/virtual instance
    TableEngine: TSQLRest;
    /// the associated TSQLRecord.ID, as decoded from URI scheme
    // - this property will be set from incoming URI, even if RESTful
    // authentication is not enabled
    TableID: TID;
    /// the current execution command
    Command: TSQLRestServerURIContextCommand;
    /// the index of the callback published method within the internal class list
    MethodIndex: integer;
    /// the service identified by an interface-based URI
    Service: TServiceFactoryServer;
    /// the method index for an interface-based service
    // - Service member has already be retrieved from URI (so is not nil)
    // - 0..2 are the internal _free_/_contract_/_signature_ pseudo-methods
    ServiceMethodIndex: integer;
    /// access to the raw PServiceMethod information of an interface-based URI
    // - equals nil if ServiceMethodIndex in 0..2 (pseudo-methods)
    ServiceMethod: pointer;
    /// the JSON array of parameters for an the interface-based service
    // - Service member has already be retrieved from URI (so is not nil)
    ServiceParameters: PUTF8Char;
    /// the instance ID for interface-based services instance
    // - can be e.g. the client session ID for sicPerSession or the thread ID for
    // sicPerThread
    ServiceInstanceID: PtrUInt;
    /// the current execution context of an interface-based service
    // - maps to Service.fExecution[ServiceMethodIndex-SERVICE_PSEUDO_METHOD_COUNT]
    ServiceExecution: PServiceFactoryExecution;
    /// the current execution options of an interface-based service
    // - contain ServiceExecution.Options including optNoLogInput/optNoLogOutput
    // in case of TInterfaceFactory.RegisterUnsafeSPIType
    ServiceExecutionOptions: TServiceMethodOptions;
    /// force the interface-based service methods to return a JSON object
    // - default behavior is to follow Service.ResultAsJSONObject property value
    // (which own default is to return a more convenient JSON array)
    // - if set to TRUE, this execution context will FORCE the method to return
    // a JSON object, even if Service.ResultAsJSONObject=false: this may be
    // handy when the method is executed from a JavaScript content
    ForceServiceResultAsJSONObject: boolean;
    /// force the interface-based service methods to return a plain JSON object
    // - i.e. '{....}' instead of '{"result":{....}}'
    // - only set if ForceServiceResultAsJSONObject=TRUE and if no ID is about
    // to be returned
    // - could be used e.g. for stateless interaction with a (non mORMot)
    // stateless JSON REST Server
    ForceServiceResultAsJSONObjectWithoutResult: boolean;
    /// force the interface-based service methods to return a XML object
    // - default behavior is to follow Service.ResultAsJSONObject property value
    // (which own default is to return a more convenient JSON array)
    // - if set to TRUE, this execution context will FORCE the method to return
    // a XML object, by setting ForceServiceResultAsJSONObject then converting
    // the resulting JSON object into the corresponding XML via JSONBufferToXML()
    // - TSQLRestServerURIContext.InternalExecuteSOAByInterface will inspect the
    // Accept HTTP header to check if the answer should be XML rather than JSON
    ForceServiceResultAsXMLObject: boolean;
    /// specify a custom name space content when returning a XML object
    // - default behavior is to follow Service.ResultAsXMLObjectNameSpace
    // property (which is void by default)
    // - service may set e.g. XMLUTF8_NAMESPACE, which will append <content ...>
    // </content> around the generated XML data, to avoid validation problems
    // or set a particular XML name space, depending on the application
    ForceServiceResultAsXMLObjectNameSpace: RawUTF8;
    /// URI inlined parameters
    // - use UrlDecodeValue*() functions to retrieve the values
    // - for mPOST requests, will also be filled for following content types:
    // ! application/x-www-form-urlencoded or multipart/form-data
    Parameters: PUTF8Char;
    /// URI inlined parameters position in Call^.url string
    // - use Parameters field to retrieve the values
    ParametersPos: integer;
    /// access to all input/output parameters at TSQLRestServer.URI() level
    // - process should better call Results() or Success() methods to set the
    // appropriate answer or Error() method in case of an error
    // - low-level access to the call parameters can be made via this pointer
    Call: PSQLRestURIParams;
    /// the corresponding session TAuthSession.IDCardinal value
    // - equals 0 (CONST_AUTHENTICATION_SESSION_NOT_STARTED) if the session
    // is not started yet - i.e. if still in handshaking phase
    // - equals 1 (CONST_AUTHENTICATION_NOT_USED) if authentication mode
    // is not enabled - i.e. if TSQLRestServer.HandleAuthentication = FALSE
    Session: cardinal;
    /// the corresponding TAuthSession.User.GroupRights.ID value
    // - is undefined if Session is 0 or 1 (no authentication running)
    SessionGroup: integer;
    /// the corresponding TAuthSession.User.ID value
    // - is undefined if Session is 0 or 1 (no authentication running)
    SessionUser: TID;
    /// the corresponding TAuthSession.User.LogonName value
    // - is undefined if Session is 0 or 1 (no authentication running)
    SessionUserName: RawUTF8;
    /// the internal ID used to identify modelroot/_safe_ custom encryption
    SafeProtocolID: integer;
    /// the static instance corresponding to the associated Table (if any)
    {$ifdef FPC}&Static{$else}Static{$endif}: TSQLRest;
    /// the kind of static instance corresponding to the associated Table (if any)
    StaticKind: TSQLRestServerKind;
    /// optional error message which will be transmitted as JSON error (if set)
    // - contains e.g. TNotifyAuthenticationFailedReason text during
    // TSQLRestServer.OnAuthenticationFailed event call, or the reason of a
    // TSQLRestServer.RecordCanBeUpdated failure
    CustomErrorMsg: RawUTF8;
    /// high-resolution timimg of the execution command, in micro-seconds
    // - only set when TSQLRestServer.URI finished
    MicroSecondsElapsed: QWord;
    /// JWT validation information, as filled by AuthenticationCheck()
    JWTContent: TJWTContent;
    {$ifdef WITHLOG}
    /// associated logging instance for the current thread on the server
    // - you can use it to log some process on the server side
    Log: TSynLog;
    {$endif}
    /// initialize the execution context
    // - this method could have been declared as protected, since it should
    // never be called outside the TSQLRestServer.URI() method workflow
    // - should set Call, and Method members
    constructor Create(aServer: TSQLRestServer; const aCall: TSQLRestURIParams); virtual;
    /// finalize the execution context
    destructor Destroy; override;
    /// extract the input parameters from its URI
    // - you should not have to call this method directly, but rather
    // all the InputInt/InputDouble/InputUTF8/InputExists/... properties
    // - may be useful if you want to access directly to InputPairs[] with no
    // prior knowledge of the input parameter names
    // - you can specify a title text to optionally log the input array
    procedure FillInput(const LogInputIdent: RawUTF8='');
    /// retrieve one input parameter from its URI name as Int64
    // - raise an EParsingException if the parameter is not found
    property InputInt[const ParamName: RawUTF8]: Int64 read GetInputInt;
    /// retrieve one input parameter from its URI name as double
    // - raise an EParsingException if the parameter is not found
    property InputDouble[const ParamName: RawUTF8]: double read GetInputDouble;
    /// retrieve one input parameter from its URI name as RawUTF8
    // - raise an EParsingException if the parameter is not found
    property InputUTF8[const ParamName: RawUTF8]: RawUTF8 read GetInputUTF8;
    /// retrieve one input parameter from its URI name as a VCL string
    // - raise an EParsingException if the parameter is not found
    // - prior to Delphi 2009, some Unicode characters may be missing in the
    // returned AnsiString value
    property InputString[const ParamName: RawUTF8]: string read GetInputString;
    /// retrieve one input parameter from its URI name as Int64
    // - returns 0 if the parameter is not found
    property InputIntOrVoid[const ParamName: RawUTF8]: Int64 read GetInputIntOrVoid;
    /// retrieve one hexadecimal input parameter from its URI name as cardinal
    // - returns 0 if the parameter is not found
    property InputHexaOrVoid[const ParamName: RawUTF8]: cardinal read GetInputHexaOrVoid;
    /// retrieve one input parameter from its URI name as double
    // - returns 0 if the parameter is not found
    property InputDoubleOrVoid[const ParamName: RawUTF8]: double read GetInputDoubleOrVoid;
    /// retrieve one input parameter from its URI name as RawUTF8
    // - returns '' if the parameter is not found
    property InputUTF8OrVoid[const ParamName: RawUTF8]: RawUTF8 read GetInputUTF8OrVoid;
    /// retrieve one input parameter from its URI name as a VCL string
    // - returns '' if the parameter is not found
    // - prior to Delphi 2009, some Unicode characters may be missing in the
    // returned AnsiString value
    property InputStringOrVoid[const ParamName: RawUTF8]: string read GetInputStringOrVoid;
    /// retrieve one input parameter from its URI name as RawUTF8
    // - returns FALSE and call Error(ErrorMessageForMissingParameter) - which
    // may be a resourcestring - if the parameter is not found
    // - returns TRUE and set Value if the parameter is found
    function InputUTF8OrError(const ParamName: RawUTF8; out Value: RawUTF8;
      const ErrorMessageForMissingParameter: string): boolean;
    /// retrieve one input parameter from its URI name as RawUTF8
    // - returns supplied DefaultValue if the parameter is not found
    function InputUTF8OrDefault(const ParamName, DefaultValue: RawUTF8): RawUTF8;
    /// retrieve one input parameter from its URI name as an enumeration
    // - will expect the value to be specified as integer, or as the textual
    // representation of the enumerate, ignoring any optional lowercase prefix
    // as featured by TEnumType.GetEnumNameValue()
    // - returns TRUE and set ValueEnum if the parameter is found and correct
    // - returns FALSE and set ValueEnum to first item (i.e. DefaultEnumOrd) if
    // the parameter is not found, or not containing a correct value
    function InputEnum(const ParamName: RawUTF8; EnumType: PTypeInfo;
      out ValueEnum; DefaultEnumOrd: integer=0): boolean;
    /// return TRUE if the input parameter is available at URI
    // - even if InputUTF8['param']='', there may be '..?param=&another=2'
    property InputExists[const ParamName: RawUTF8]: Boolean read GetInputExists;
    {$ifndef NOVARIANTS}
    /// retrieve one input parameter from its URI name as variant
    // - if the parameter value is text, it is stored in the variant as
    // a generic VCL string content: so before Delphi 2009, you may loose
    // some characters at decoding from UTF-8 input buffer
    // - raise an EParsingException if the parameter is not found
    property Input[const ParamName: RawUTF8]: variant read GetInput; default;
    /// retrieve one input parameter from its URI name as variant
    // - if the parameter value is text, it is stored in the variant as
    // a RawUTF8: so before Delphi 2009, you won't loose any Unicode character,
    // but you should convert its value to AnsiString using UTF8ToString()
    // - returns Unassigned if the parameter is not found
    property InputOrVoid[const ParamName: RawUTF8]: variant read GetInputOrVoid;
    /// retrieve one input parameter from its URI name as variant
    // - returns FALSE and call Error(ErrorMessageForMissingParameter) - which
    // may be a resourcestring - if the parameter is not found
    // - returns TRUE and set Value if the parameter is found
    // - if the parameter value is text, it is stored in the variant as
    // a RawUTF8: so before Delphi 2009, you won't loose any Unicode character,
    // but you should convert its value to AnsiString using UTF8ToString()
    function InputOrError(const ParamName: RawUTF8; out Value: variant;
      const ErrorMessageForMissingParameter: string): boolean;
    /// retrieve all input parameters from URI as a variant JSON object
    // - returns Unassigned if no parameter was defined
    // - returns a JSON object with input parameters encoded as
    // ! {"name1":value1,"name2":value2...}
    // - optionally with a PServiceMethod information about the actual values types
    // - if the parameters were encoded as multipart, the JSON object
    // will be encoded with its textual values, or with nested objects, if
    // the data was supplied as binary:
    // ! {"name1":{"data":..,"filename":...,"contenttype":...},"name2":...}
    // since name1.data will be Base64 encoded, so you should better
    // use the InputAsMultiPart() method instead when working with binary
    function GetInputAsTDocVariant(const Options: TDocVariantOptions; ServiceMethod: pointer): variant;
    {$endif}
    /// decode any multipart/form-data POST request input
    // - returns TRUE and set MultiPart array as expected, on success
    function InputAsMultiPart(var MultiPart: TMultiPartDynArray): Boolean;
    /// low-level access to the input parameters, stored as pairs of UTF-8
    // - even items are parameter names, odd are values
    // - Input*[] properties should have been called previously to fill the
    // internal array, or by calling FillInput if you do not know the input
    // parameters which may appear
    property InputPairs: TRawUTF8DynArray read FInput;
    /// retrieve an incoming HTTP header
    // - the supplied header name is case-insensitive
    // - but rather call RemoteIP or UserAgent properties instead of
    // InHeader['remoteip'] or InHeader['User-Agent']
    property InHeader[const HeaderName: RawUTF8]: RawUTF8 read GetInHeader;
    /// retrieve an incoming HTTP cookie value
    // - cookie name are case-sensitive
    property InCookie[CookieName: RawUTF8]: RawUTF8 read GetInCookie write SetInCookie;
    /// define a new 'name=value' cookie to be returned to the client
    // - if not void, TSQLRestServer.URI() will define a new 'set-cookie: ...'
    // header in Call^.OutHead
    // - you can use COOKIE_EXPIRED as value to delete a cookie in the browser
    // - if no Path=/.. is included, it will append
    // $ '; Path=/'+Server.Model.Root+'; HttpOnly'
    property OutSetCookie: RawUTF8 read fOutSetCookie write SetOutSetCookie;
    /// retrieve the "User-Agent" value from the incoming HTTP headers
    property UserAgent: RawUTF8 read GetUserAgent;
    /// retrieve the "RemoteIP" value from the incoming HTTP headers
    property RemoteIP: RawUTF8 read GetRemoteIP;
    /// true if the "RemoteIP" value from the incoming HTTP headers is '127.0.0.1'
    property RemoteIPIsLocalHost: boolean read GetRemoteIPIsLocalHost;
    /// "RemoteIP" value from the incoming HTTP headers but '' for '127.0.0.1'
    property RemoteIPNotLocal: RawUTF8 read GetRemoteIPNotLocal;
    /// retrieve the "Authorization: Bearer <token>" value from incoming HTTP headers
    // - typically returns a JWT for statelesss self-contained authentication,
    // as expected by TJWTAbstract.Verify method
    // - as an alternative, a non-standard and slightly less safe way of
    // token transmission may be to encode its value as ?authenticationbearer=....
    // URI parameter (may be convenient when embedding resources in HTML DOM)
    function AuthenticationBearerToken: RawUTF8;
    /// validate "Authorization: Bearer <JWT>" content from incoming HTTP headers
    // - returns true on success, storing the payload in the JWTContent field
    // - set JWTContent.result = jwtNoToken if jwt is nil
    // - on failure (i.e. returns false), will set the error context as
    // 403 HTTP_FORBIDDEN so that you may directly write:
    // ! procedure TMyDaemon.Files(Ctxt: TSQLRestServerURIContext);
    // ! begin
    // !   if Ctxt.AuthenticationCheck(fJWT) then
    // !     Ctxt.ReturnFileFromFolder('c:\datafolder');
    // ! end;
    function AuthenticationCheck(jwt: TJWTAbstract): boolean; virtual;
    /// identify which kind of client is actually connected
    // - the "User-Agent" HTTP will be checked for 'mORMot' substring, and
    // set ckFramework on match
    // - either ckAjax for a classic (AJAX) browser, or any other kind of
    // HTTP client
    // - will be used e.g. by ClientSQLRecordOptions to check if the
    // current remote client expects standard JSON in all cases
    function ClientKind: TSQLRestServerURIContextClientKind;
    /// identify if the request is about a Table containing nested objects or
    // arrays, which could be serialized as JSON objects or arrays, instead
    // of plain JSON string (as stored in the database)
    // - will idenfity ClientKind=ckAjax, or check for rsoGetAsJsonNotAsString
    // in TSQLRestServer.Options
    function ClientSQLRecordOptions: TJSONSerializerSQLRecordOptions;
    /// true if called from TSQLRestServer.AdministrationExecute
    function IsRemoteAdministrationExecute: boolean;
    /// compute the file name corresponding to the URI
    // - e.g. '/root/methodname/toto/index.html' will return 'toto\index.html'
    property ResourceFileName: TFileName read GetResourceFileName;
    /// use this method to send back directly a result value to the caller
    // - expects Status to be either HTTP_SUCCESS, HTTP_NOTMODIFIED,
    // HTTP_CREATED, or HTTP_TEMPORARYREDIRECT, and will return as answer the
    // supplied Result content with no transformation
    // - if Status is an error code, it will call Error() method
    // - CustomHeader optional parameter can be set e.g. to
    // TEXT_CONTENT_TYPE_HEADER if the default JSON_CONTENT_TYPE is not OK,
    // or calling GetMimeContentTypeHeader() on the returned binary buffer
    // - if Handle304NotModified is TRUE and Status is HTTP_SUCCESS, the Result
    // content will be hashed (using crc32c) and in case of no modification
    // will return HTTP_NOTMODIFIED to the browser, without the actual result
    // content (to save bandwidth)
    // - set CacheControlMaxAge<>0 to include a Cache-Control: max-age=xxx header
    procedure Returns(const Result: RawUTF8; Status: integer=HTTP_SUCCESS;
      const CustomHeader: RawUTF8=''; Handle304NotModified: boolean=false;
      HandleErrorAsRegularResult: boolean=false; CacheControlMaxAge: integer=0;
      ServerHash: RawUTF8=''); overload;
    /// use this method to send back a JSON object to the caller
    // - this method will encode the supplied values e.g. as
    // ! JSONEncode(['name','John','year',1972]) = '{"name":"John","year":1972}'
    // - implementation is just a wrapper around Returns(JSONEncode([]))
    // - note that cardinal values should be type-casted to Int64() (otherwise
    // the integer mapped value will be transmitted, therefore wrongly)
    // - expects Status to be either HTTP_SUCCESS or HTTP_CREATED
    // - caller can set Handle304NotModified=TRUE for Status=HTTP_SUCCESS
    procedure Returns(const NameValuePairs: array of const; Status: integer=HTTP_SUCCESS;
      Handle304NotModified: boolean=false; HandleErrorAsRegularResult: boolean=false;
      const CustomHeader: RawUTF8=''); overload;
    /// use this method to send back any object as JSON document to the caller
    // - this method will call ObjectToJson() to compute the returned content
    // - you can customize SQLRecordOptions, to force the returned JSON
    // object to have its TSQLRecord nested fields serialized as true JSON
    // arrays or objects, or add an "ID_str" string field for JavaScript
    procedure Returns(Value: TObject; Status: integer=HTTP_SUCCESS;
      Handle304NotModified: boolean=false;
      SQLRecordOptions: TJSONSerializerSQLRecordOptions=[];
      const CustomHeader: RawUTF8=''); overload;
    /// use this method to send back any variant as JSON to the caller
    // - this method will call VariantSaveJSON() to compute the returned content
    procedure ReturnsJson(const Value: variant; Status: integer=HTTP_SUCCESS;
      Handle304NotModified: boolean=false; Escape: TTextWriterKind=twJSONEscape;
      MakeHumanReadable: boolean=false; const CustomHeader: RawUTF8='');
    /// uses this method to send back directly any binary content to the caller
    // - the exact MIME type will be retrieved using GetMimeContentTypeHeader(),
    // from the supplied Blob binary buffer, and optional a file name
    // - by default, the HTTP_NOTMODIFIED process will take place, to minimize
    // bandwidth between the server and the client
    // - set CacheControlMaxAge<>0 to include a Cache-Control: max-age=xxx header
    procedure ReturnBlob(const Blob: RawByteString; Status: integer=HTTP_SUCCESS;
      Handle304NotModified: boolean=true; const FileName: TFileName='';
      CacheControlMaxAge: integer=0);
    /// use this method to send back a file to the caller
    // - this method will let the HTTP server return the file content
    // - if Handle304NotModified is TRUE, will check the file age to ensure
    // that the file content will be sent back to the server only if it changed;
    // set CacheControlMaxAge<>0 to include a Cache-Control: max-age=xxx header
    // - if ContentType is left to default '', method will guess the expected
    // mime-type from the file name extension
    // - if the file name does not exist, a generic 404 error page will be
    // returned, unless an explicit redirection is defined in Error404Redirect
    // - you can also specify the resulting file name, as downloaded and written
    // by the client browser, in the optional AttachmentFileName parameter, if
    // the URI does not match the expected file name
    procedure ReturnFile(const FileName: TFileName;
      Handle304NotModified: boolean=false; const ContentType: RawUTF8='';
      const AttachmentFileName: RawUTF8=''; const Error404Redirect: RawUTF8='';
      CacheControlMaxAge: integer=0);
    /// use this method to send back a file from a local folder to the caller
    // - URIBlobFieldName value, as parsed from the URI, will containn the
    // expected file name in the local folder, using DefaultFileName if the
    // URI is void, and redirecting to Error404Redirect if the file is not found
    // - this method will let the HTTP server return the file content
    // - if Handle304NotModified is TRUE, will check the file age to ensure
    // that the file content will be sent back to the server only if it changed
    // set CacheControlMaxAge<>0 to include a Cache-Control: max-age=xxx header
    procedure ReturnFileFromFolder(const FolderName: TFileName;
      Handle304NotModified: boolean=true; const DefaultFileName: TFileName='index.html';
      const Error404Redirect: RawUTF8=''; CacheControlMaxAge: integer=0);
    /// use this method notify the caller that the resource URI has changed
    // - returns a HTTP_TEMPORARYREDIRECT status with the specified location,
    // or HTTP_MOVEDPERMANENTLY if PermanentChange is TRUE
    procedure Redirect(const NewLocation: RawUTF8; PermanentChange: boolean=false);
    /// use this method to send back a JSON object with a "result" field
    // - this method will encode the supplied values as a {"result":"...}
    // JSON object, as such for one value:
    // $ {"result":"OneValue"}
    // (with one value, you can just call TSQLRestClientURI.CallBackGetResult
    // method to call and decode this value)
    // or as a JSON object containing an array of values:
    // $ {"result":["One","two"]}
    // - expects Status to be either HTTP_SUCCESS or HTTP_CREATED
    // - caller can set Handle304NotModified=TRUE for Status=HTTP_SUCCESS and/or
    // set CacheControlMaxAge<>0 to include a Cache-Control: max-age=xxx header
    procedure Results(const Values: array of const; Status: integer=HTTP_SUCCESS;
      Handle304NotModified: boolean=false; CacheControlMaxAge: integer=0);
    /// use this method if the caller expect no data, just a status
    // - just wrap the overloaded Returns() method with no result value
    // - if Status is an error code, it will call Error() method
    // - by default, calling this method will mark process as successfull
    procedure Success(Status: integer=HTTP_SUCCESS); virtual;
    /// use this method to send back an error to the caller
    // - expects Status to not be HTTP_SUCCESS neither HTTP_CREATED,
    // and will send back a JSON error message to the caller, with the
    // supplied error text
    // - set CacheControlMaxAge<>0 to include a Cache-Control: max-age=xxx header
    // - if no ErrorMessage is specified, will return a default text
    // corresponding to the Status code
    procedure Error(const ErrorMessage: RawUTF8='';
      Status: integer=HTTP_BADREQUEST; CacheControlMaxAge: integer=0); overload; virtual;
    /// use this method to send back an error to the caller
    // - implementation is just a wrapper over Error(FormatUTF8(Format,Args))
    procedure Error(const Format: RawUTF8; const Args: array of const;
      Status: integer=HTTP_BADREQUEST; CacheControlMaxAge: integer=0); overload;
    /// use this method to send back an error to the caller
    // - will serialize the supplied exception, with an optional error message
    procedure Error(E: Exception; const Format: RawUTF8; const Args: array of const;
      Status: integer=HTTP_BADREQUEST); overload;
    /// implements a method-based service for live update of some settings
    // - should be called from a method-based service, e.g. Configuration()
    // - the settings are expected to be stored e.g. in a TSynAutoCreateFields
    // instance, potentially with nested objects
    // - accept the following REST methods to read and write the settings:
    // ! GET http://server:888/root/configuration
    // ! GET http://server:888/root/configuration/propname
    // ! GET http://server:888/root/configuration/propname?value=propvalue
    // - could be used e.g. as such:
    // ! procedure TMyRestServerMethods.Configuration(Ctxt: TSQLRestServerURIContext);
    // ! begin //  http://server:888/myrestserver/configuration/name?value=newValue
    // !   Ctxt.ConfigurationRestMethod(fSettings);
    // ! end;
    procedure ConfigurationRestMethod(SettingsStorage: TObject);
    /// at Client Side, compute URI and BODY according to the routing scheme
    // - abstract implementation which is to be overridden
    // - as input, method should be the method name to be executed,
    // params should contain the incoming parameters as JSON CSV (without []),
    // and clientDriven ID should contain the optional Client ID value
    // - at output, should update the HTTP uri corresponding to the proper
    // routing, and should return the corresponding HTTP body within sent
    class procedure ClientSideInvoke(var uri: RawUTF8; ctxt: TSQLRestServerURIContextClientInvoke;
      const method, params, clientDrivenID: RawUTF8; out sent,head: RawUTF8); virtual; abstract;
  end;

  /// calling context for a TSQLRestServerCallBack using simple REST for
  // interface-based services
  // - this class will use RESTful routing for interface-based services:
  // method name will be identified within the URI, as
  // $ /Model/Interface.Method[/ClientDrivenID]
  // e.g. for ICalculator.Add:
  // $ POST /root/Calculator.Add
  // $ (...)
  // $ [1,2]
  // or, for a sicClientDriven mode service:
  // $ POST /root/ComplexNumber.Add/1234
  // $ (...)
  // $ [20,30]
  // in this case, the sent content will be a JSON array of [parameters...]
  // - as an alternative, input parameters may be encoded at URI level (with
  // a size limit depending on the HTTP routers, whereas there is no such
  // limitation when they are transmitted as message body)
  // - one benefit of having .../ClientDrivenID encoded at URI is that it will
  // be more secured in our RESTful authentication scheme: each method and even
  // client driven session will be signed individualy
  TSQLRestRoutingREST = class(TSQLRestServerURIContext)
  protected
    /// retrieve interface-based SOA with URI RESTful routing
    // - should set Service member (and possibly ServiceMethodIndex)
    // - this overridden implementation expects an URI encoded with
    // '/Model/Interface.Method[/ClientDrivenID]' for this class, and
    // will set ServiceMethodIndex for next ExecuteSOAByInterface method call
    procedure URIDecodeSOAByInterface; override;
    /// direct launch of an interface-based service with URI RESTful routing
    // - this overridden implementation expects parameters to be sent as one JSON
    // array body (Delphi/AJAX way) or optionally with URI decoding (HTML way):
    // ! function TServiceCalculator.Add(n1, n2: integer): integer;
    // will accept such requests:
    // !  URL='root/Calculator.Add' and InBody='[ 1,2 ]'
    // !  URL='root/Calculator.Add?+%5B+1%2C2+%5D' // decoded as ' [ 1,2 ]'
    // !  URL='root/Calculator.Add?n1=1&n2=2'      // in any order, even missing
    procedure ExecuteSOAByInterface; override;
  public
    /// at Client Side, compute URI and BODY according to RESTful routing scheme
    // - e.g. on input uri='root/Calculator', method='Add', params='1,2' and
    // clientDrivenID='1234' -> on output uri='root/Calculator.Add/1234' and
    // sent='[1,2]'
    class procedure ClientSideInvoke(var uri: RawUTF8; ctxt: TSQLRestServerURIContextClientInvoke;
      const method, params, clientDrivenID: RawUTF8; out sent,head: RawUTF8); override;
  end;

  /// calling context for a TSQLRestServerCallBack using JSON/RPC for
  // interface-based services
  // - in this routing scheme, the URI will define the interface, then the
  // method name will be inlined with parameters, e.g.
  // $ POST /root/Calculator
  // $ (...)
  // $ {"method":"Add","params":[1,2]}
  // or, for a sicClientDriven mode service:
  // $ POST /root/ComplexNumber
  // $ (...)
  // $ {"method":"Add","params":[20,30],"id":1234}
  TSQLRestRoutingJSON_RPC = class(TSQLRestServerURIContext)
  protected
    /// retrieve interface-based SOA with URI JSON/RPC routing
    // - this overridden implementation expects an URI encoded with
    // '/Model/Interface' as for the JSON/RPC routing scheme, and won't
    // set ServiceMethodIndex at this level (but in ExecuteSOAByInterface)
    procedure URIDecodeSOAByInterface; override;
    /// direct launch of an interface-based service with URI JSON/RPC routing
    // - URI() will ensure that Service<>nil before calling it
    // - this overridden implementation expects parameters to be sent as part
    // of a JSON object body:
    // $ {"method":"Add","params":[20,30],"id":1234}
    procedure ExecuteSOAByInterface; override;
  public
    /// at Client Side, compute URI and BODY according to JSON/RPC routing scheme
    // - e.g. on input uri='root/Calculator', method='Add', params='1,2' and
    // clientDrivenID='1234' -> on output uri='root/Calculator' and
    // sent={"method":"Add","params":[1,2],"id":1234}
    class procedure ClientSideInvoke(var uri: RawUTF8; ctxt: TSQLRestServerURIContextClientInvoke;
      const method, params, clientDrivenID: RawUTF8; out sent,head: RawUTF8); override;
  end;

  /// method prototype to be used on Server-Side for method-based services
  // - will be routed as ModelRoot/[TableName/TableID/]MethodName RESTful requests
  // - this mechanism is able to handle some custom Client/Server request, similar
  // to the DataSnap technology, but in a KISS way; it's fully integrated in the
  // Client/Server architecture of our framework
  // - just add a published method of this type to any TSQLRestServer descendant
  // - when TSQLRestServer.URI receive a request for ModelRoot/MethodName
  // or ModelRoot/TableName/TableID/MethodName, it will check for a published method
  // in its self instance named MethodName which MUST be of TSQLRestServerCallBack
  // type (not checked neither at compile time neither at runtime: beware!) and
  // call it to handle the request
  // - important warning: the method implementation MUST be thread-safe
  // - when TSQLRestServer.URI receive a request for ModelRoot/MethodName,
  // it calls the corresponding published method with aRecord set to nil
  // - when TSQLRestServer.URI receive a request for ModelRoot/TableName/TableID/MethodName,
  // it calls the corresponding published method with aRecord pointing to a
  // just created instance of the corresponding class,  with its field ID set;
  // note that the only set field is ID: other fields of aRecord are not set, but
  // must secificaly be retrieved on purpose
  // - for ModelRoot/TableName/TableID/MethodName, the just created instance will
  // be freed by TSQLRestServer.URI when the method returns
  // - Ctxt.Parameters values are set from incoming URI, and each parameter can be
  // retrieved with a loop like this:
  // !  if not UrlDecodeNeedParameters(Ctxt.Parameters,'SORT,COUNT') then
  // !    exit;
  // !  while Ctxt.Parameters<>nil do begin
  // !    UrlDecodeValue(Ctxt.Parameters,'SORT=',aSortString);
  // !    UrlDecodeValueInteger(Ctxt.Parameters,'COUNT=',aCountInteger,@Ctxt.Parameters);
  // !  end;
  // - Ctxt.Call is set with low-level incoming and outgoing data from client
  // (e.g. Ctxt.Call.InBody contain POST/PUT data message)
  // - Ctxt.Session* will identify to the authentication session of the remote client
  // (CONST_AUTHENTICATION_NOT_USED=1 if authentication mode is not enabled or
  // CONST_AUTHENTICATION_SESSION_NOT_STARTED=0 if the session not started yet) -
  // code may use SessionGetUser() method to retrieve the user details
  // - Ctxt.Method will indicate the used HTTP verb (e.g. GET/POST/PUT..)
  // - if process succeeded, implementation shall call Ctxt.Results([]) method to
  // set a JSON response object with one "result" field name or Ctxt.Returns([])
  // with a JSON object described in Name/Value pairs; if the returned value is
  // not JSON_CONTENT_TYPE, use Ctxt.Returns() and its optional CustomHeader
  // parameter can specify a custom header like TEXT_CONTENT_TYPE_HEADER
  // - if process succeeded, and no data is expected to be returned to the caller,
  // implementation shall call overloaded Ctxt.Success() method with the
  // expected status (i.e. just Ctxt.Success will return HTTP_SUCCESS)
  // - if process failed, implementation shall call Ctxt.Error() method to
  // set the corresponding error message and error code number
  // - a typical implementation may be:
  // ! procedure TSQLRestServerTest.Sum(Ctxt: TSQLRestServerURIContext);
  // ! var a,b: TSynExtended;
  // ! begin
  // !   if UrlDecodeNeedParameters(Ctxt.Parameters,'A,B') then begin
  // !     while Ctxt.Parameters<>nil do begin
  // !       UrlDecodeExtended(Ctxt.Parameters,'A=',a);
  // !       UrlDecodeExtended(Ctxt.Parameters,'B=',b,@Ctxt.Parameters);
  // !     end;
  // !     Ctxt.Results([a+b]);
  // !     // same as: Ctxt.Returns(JSONEncode(['result',a+b]));
  // !     // same as: Ctxt.Returns(['result',a+b]);
  // !   end else
  // !     Ctxt.Error('Missing Parameter');
  // ! end;
  // - Client-Side can be implemented as you wish. By convention, it could be
  // appropriate to define in either TSQLRestServer (if to be called as
  // ModelRoot/MethodName), either TSQLRecord (if to be called as
  // ModelRoot/TableName[/TableID]/MethodName) a custom public or protected method,
  // calling TSQLRestClientURI.URL with the appropriate parameters, and named
  // (by convention) as MethodName; TSQLRestClientURI has dedicated methods
  // like CallBackGetResult, CallBackGet, CallBackPut and CallBack; see also
  // TSQLModel.getURICallBack and JSONDecode function
  // ! function TSQLRecordPeople.Sum(aClient: TSQLRestClientURI; a, b: double): double;
  // ! var err: integer;
  // ! begin
  // !   val(aClient.CallBackGetResult('sum',['a',a,'b',b]),result,err);
  // ! end;
  TSQLRestServerCallBack = procedure(Ctxt: TSQLRestServerURIContext) of object;

  /// description of a method-based service
  TSQLRestServerMethod = record
    /// the method name
    Name: RawUTF8;
    /// the event which will be executed for this method
    CallBack: TSQLRestServerCallBack;
    /// set to TRUE disable Authentication check for this method
    // - use TSQLRestServer.ServiceMethodByPassAuthentication() method
    ByPassAuthentication: boolean;
    /// detailed statistics associated with this method
    Stats: TSynMonitorInputOutput;
  end;

  /// used to store all method-based services of a TSQLRestServer instance
  TSQLRestServerMethods = array of TSQLRestServerMethod;

  /// pointer to a description of a method-based service
  PSQLRestServerMethod = ^TSQLRestServerMethod;

  /// the possible options for handling table names
  TSQLCheckTableName = (ctnNoCheck,ctnMustExist,ctnTrimExisting);

  /// the possible options for TSQLRestServer.CreateMissingTables and
  // TSQLRecord.InitializeTable methods
  // - itoNoAutoCreateGroups and itoNoAutoCreateUsers will avoid
  // TSQLAuthGroup.InitializeTable to fill the TSQLAuthGroup and TSQLAuthUser
  // tables with default records
  // - itoNoCreateMissingField will avoid to create the missing fields on a table
  // - itoNoIndex4ID won't create the index for the main ID field (do nothing
  // on SQLite3, by design - but may be used for tables on external databases)
  // - itoNoIndex4UniqueField won't create indexes for "stored AS_UNIQUE" fields
  // - itoNoIndex4NestedRecord won't create indexes for TSQLRecord fields
  // - itoNoIndex4RecordReference won't create indexes for TRecordReference fields
  // - itoNoIndex4TID won't create indexes for TID fields
  // - itoNoIndex4RecordVersion won't create indexes for TRecordVersion fields
  // - INITIALIZETABLE_NOINDEX constant contain all itoNoIndex* items
  TSQLInitializeTableOption = (
    itoNoAutoCreateGroups, itoNoAutoCreateUsers,
    itoNoCreateMissingField,
    itoNoIndex4ID, itoNoIndex4UniqueField,
    itoNoIndex4NestedRecord, itoNoIndex4RecordReference,
    itoNoIndex4TID, itoNoIndex4RecordVersion);

  /// the options to be specified for TSQLRestServer.CreateMissingTables and
  // TSQLRecord.InitializeTable methods
  TSQLInitializeTableOptions = set of TSQLInitializeTableOption;

  /// a dynamic array of TSQLRecordMany instances
  TSQLRecordManyObjArray = array of TSQLRecordMany;

  /// internal data used by TSQLRecord.FillPrepare()/FillPrepareMany() methods
  // - using a dedicated class will reduce memory usage for each TSQLRecord
  // instance (which won't need these properties most of the time)
  TSQLRecordFill = class
  protected
    /// associated table
    fTable: TSQLTable;
    /// current retrieved row
    fFillCurrentRow: integer;
    /// number of used items in TableMap[] array
    // - calculated in FillPrepare() or FillPrepareMany() methods
    fTableMapCount: integer;
    /// set by TSQLRecord.FillPrepareMany() to release M.fDestID^ instances
    fTableMapRecordManyInstances: TSQLRecordManyObjArray;
    /// map the published fields index
    // - calculated in FillPrepare() or FillPrepareMany() methods
    fTableMap: array of record
      /// the class instance to be filled from the TSQLTable
      // - can be a TSQLRecordMany instance after FillPrepareMany() method call
      Dest: TSQLRecord;
      /// the published property RTTI to be filled from the TSQLTable
      // - is nil for the RowID/ID field
      DestField: TSQLPropInfo;
      /// the column index in TSQLTable
      TableIndex: integer;
    end;
    /// mark all mapped or TModTime fields
    fTableMapFields: TSQLFieldBits;
    /// if Joined instances were initialized via TSQLRecord.CreateJoined()
    fJoinedFields: boolean;
    /// return fJoinedFields or false if self=nil
    function GetJoinedFields: boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// add a property to the fTableMap[] array
    // - aIndex is the column index in TSQLTable
    procedure AddMap(aRecord: TSQLRecord; aField: TSQLPropInfo; aIndex: integer); overload;
    /// add a property to the fTableMap[] array
    // - aIndex is the column index in TSQLTable
    procedure AddMap(aRecord: TSQLRecord; const aFieldName: RawUTF8; aIndex: integer); overload;
    /// add all simple property names, with  to the fTableMap[] array
    // - will map ID/RowID, then all simple fields of this TSQLRecord
    // - aIndex is the column index in TSQLTable
    procedure AddMapSimpleFields(aRecord: TSQLRecord; const aProps: array of TSQLPropInfo;
      var aIndex: integer);
  public
    /// finalize the mapping
    destructor Destroy; override;
    /// map all columns of a TSQLTable to a record mapping
    procedure Map(aRecord: TSQLRecord; aTable: TSQLTable; aCheckTableName: TSQLCheckTableName);
    /// reset the mapping
    // - is called e.g. by TSQLRecord.FillClose
    // - will free any previous Table if necessary
    // - will release TSQLRecordMany.Dest instances as set by TSQLRecord.FillPrepareMany()
    procedure UnMap;
    /// fill a TSQLRecord published properties from a TSQLTable row
    // - use the mapping prepared with Map() method
    function Fill(aRow: integer): Boolean; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// fill a TSQLRecord published properties from a TSQLTable row
    // - use the mapping prepared with Map() method
    // - aTableRow will point to the first column of the matching row
    procedure Fill(aTableRow: PPUtf8CharArray); overload;
    /// fill a TSQLRecord published properties from a TSQLTable row
    // - overloaded method using a specified destination record to be filled
    // - won't work with cross-reference mapping (FillPrepareMany)
    // - use the mapping prepared with Map() method
    // - aTableRow will point to the first column of the matching row
    procedure Fill(aTableRow: PPUtf8CharArray; aDest: TSQLRecord); overload;
    /// fill a TSQLRecord published properties from a TSQLTable row
    // - overloaded method using a specified destination record to be filled
    // - won't work with cross-reference mapping (FillPrepareMany)
    // - use the mapping prepared with Map() method
    function Fill(aRow: integer; aDest: TSQLRecord): Boolean; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// used to compute the updated field bits during a fill
    // - will return Props.SimpleFieldsBits[soUpdate] if no fill is in process
    procedure ComputeSetUpdatedFieldBits(Props: TSQLRecordProperties; out Bits: TSQLFieldBits);
    /// return all mapped fields, or [] if nil
    function TableMapFields: TSQLFieldBits;
    /// the TSQLTable stated as FillPrepare() parameter
    // - the internal temporary table is stored here for TSQLRecordMany
    // - this instance is freed by TSQLRecord.Destroy if fTable.OwnerMustFree=true
    property Table: TSQLTable read fTable;
    /// the current Row during a Loop
    property FillCurrentRow: integer read fFillCurrentRow;
    /// equals TRUE if the instance was initialized via TSQLRecord.CreateJoined()
    // TSQLRecord.CreateAndFillPrepareJoined()
    // - it means that all nested TSQLRecord are pre-allocated instances,
    // not trans-typed pointer(IDs)
    property JoinedFields: boolean read GetJoinedFields;
  end;

  /// event signature triggered by TSQLRestBatch.OnWrite
  // - also used by TSQLRestServer.RecordVersionSynchronizeSlave*() methods
  TOnBatchWrite = procedure(Sender: TSQLRestBatch; Event: TSQLOccasion;
    Table: TSQLRecordClass; const ID: TID; Value: TSQLRecord;
    const ValueFields: TSQLFieldBits) of object;

  /// used to store a BATCH sequence of writing operations
  // - is used by TSQLRest to process BATCH requests using BatchSend() method,
  // or TSQLRestClientURI for its Batch*() methods
  // - but you can create your own stand-alone BATCH process, so that it will
  // be able to make some transactional process - aka the "Unit Of Work" pattern
  TSQLRestBatch = class
  protected
    fRest: TSQLRest;
    fInternalBufferSize: integer;
    fCalledWithinRest: boolean;
    fBatch: TJSONSerializer;
    fBatchFields: TSQLFieldBits;
    fTable: TSQLRecordClass;
    fTablePreviousSendData: TSQLRecordClass;
    fTableIndex: integer;
    fBatchCount: integer;
    fDeletedRecordRef: TIDDynArray;
    fDeletedCount: integer;
    fAddCount: integer;
    fUpdateCount: integer;
    fDeleteCount: integer;
    fAutomaticTransactionPerRow: cardinal;
    fOptions: TSQLRestBatchOptions;
    fOnWrite: TOnBatchWrite;
    function GetCount: integer;
    function GetSizeBytes: cardinal;
    procedure SetExpandedJSONWriter(Props: TSQLRecordProperties;
      ForceResetFields, withID: boolean; const WrittenFields: TSQLFieldBits);
  public
    /// begin a BATCH sequence to speed up huge database changes
    // - each call to normal Add/Update/Delete methods will create a Server request,
    //   therefore can be slow (e.g. if the remote server has bad ping timing)
    // - start a BATCH sequence using this method, then call BatchAdd() BatchUpdate()
    //   or BatchDelete() methods to make some changes to the database
    // - when BatchSend will be called, all the sequence transactions will be sent
    //   as one to the remote server, i.e. in one URI request
    // - if BatchAbort is called instead, all pending BatchAdd/Update/Delete
    //   transactions will be aborted, i.e. ignored
    // - expect one TSQLRecordClass as parameter, which will be used for the whole
    //   sequence (in this case, you can't mix classes in the same BATCH sequence)
    // - if no TSQLRecordClass is supplied, the BATCH sequence will allow any
    //   kind of individual record in BatchAdd/BatchUpdate/BatchDelete
    // - return TRUE on success, FALSE if aTable is incorrect or a previous BATCH
    //   sequence was already initiated
    // - should normally be used inside a Transaction block: there is no automated
    //   TransactionBegin..Commit/RollBack generated in the BATCH sequence if
    //   you leave the default AutomaticTransactionPerRow=0 parameter - but
    //   this may be a concern with a lot of concurrent clients
    // - you should better set AutomaticTransactionPerRow > 0 to execute all
    //   BATCH processes within an unique transaction grouped by a given number
    //   of rows, on the server side - set AutomaticTransactionPerRow=maxInt if
    //   you want one huge transaction, or set a convenient value (e.g. 10000)
    //   depending on the back-end database engine abilities, if you want to
    //   retain the transaction log file small enough for the database engine
    // - BatchOptions could be set to tune the SQL execution, e.g. force INSERT
    //   OR IGNORE on internal SQLite3 engine
    // - InternalBufferSize could be set to some high value (e.g. 10 shl 20),
    //   if you expect a very high number of rows in this BATCH
    constructor Create(aRest: TSQLRest; aTable: TSQLRecordClass;
      AutomaticTransactionPerRow: cardinal=0; Options: TSQLRestBatchOptions=[];
      InternalBufferSize: cardinal=65536); virtual;
    /// finalize the BATCH instance
    destructor Destroy; override;
    /// reset the BATCH sequence so that you can re-use the same TSQLRestBatch
    procedure Reset(aTable: TSQLRecordClass; AutomaticTransactionPerRow: cardinal=0;
      Options: TSQLRestBatchOptions=[]); overload; virtual;
    /// reset the BATCH sequence to its previous state
    // - could be used to prepare a next chunk of values, after a call to
    // TSQLRest.BatchSend
    procedure Reset; overload;
    /// create a new member in current BATCH sequence
    // - work in BATCH mode: nothing is sent to the server until BatchSend call
    // - returns the corresponding index in the current BATCH sequence, -1 on error
    // - if SendData is true, content of Value is sent to the server as JSON
    // - if ForceID is true, client sends the Value.ID field to use this ID for
    // adding the record (instead of a database-generated ID)
    // - if Value is TSQLRecordFTS3/4/5, Value.ID is stored to the virtual table
    // - Value class MUST match the TSQLRecordClass used at BatchStart,
    // or may be of any kind if no class was specified
    // - BLOB fields are NEVER transmitted here, even if ForceBlobTransfert=TRUE
    // - if CustomFields is left void, the simple fields will be used; otherwise,
    // you can specify your own set of fields to be transmitted when SendData=TRUE
    // (including BLOBs, even if they will be Base64-encoded within JSON content) -
    // CustomFields could be computed by TSQLRecordProperties.FieldBitsFromCSV()
    // or TSQLRecordProperties.FieldBitsFromRawUTF8(), or by setting ALL_FIELDS
    // - this method will always compute and send TCreateTime/TModTime fields
    function Add(Value: TSQLRecord; SendData: boolean; ForceID: boolean=false;
      const CustomFields: TSQLFieldBits=[]; DoNotAutoComputeFields: boolean=false): integer;
    /// update a member in current BATCH sequence
    // - work in BATCH mode: nothing is sent to the server until BatchSend call
    // - returns the corresponding index in the current BATCH sequence, -1 on error
    // - Value class MUST match the TSQLRecordClass used at BatchStart,
    // or may be of any kind if no class was specified
    // - BLOB fields are NEVER transmitted here, even if ForceBlobTransfert=TRUE
    // - if Value has an opened FillPrepare() mapping, only the mapped fields
    // will be updated (and also ID and TModTime fields) - FillPrepareMany() is
    // not handled yet (all simple fields will be updated)
    // - if CustomFields is left void, the  simple fields will be used, or the
    // fields retrieved via a previous FillPrepare() call; otherwise, you can
    // specify your own set of fields to be transmitted (including BLOBs, even
    // if they will be Base64-encoded within the JSON content) - CustomFields
    // could be computed by TSQLRecordProperties.FieldBitsFromCSV()
    // or TSQLRecordProperties.FieldBitsFromRawUTF8()
    // - this method will always compute and send any TModTime fields, unless
    // DoNotAutoComputeFields is set to true
    // - if not all fields are specified, will reset the cache entry associated
    // with this value, unless ForceCacheUpdate is TRUE
    function Update(Value: TSQLRecord; const CustomFields: TSQLFieldBits=[];
      DoNotAutoComputeFields: boolean=false; ForceCacheUpdate: boolean=false): integer; overload; virtual;
    /// update a member in current BATCH sequence
    // - work in BATCH mode: nothing is sent to the server until BatchSend call
    // - is an overloaded method to Update(Value,FieldBitsFromCSV())
    function Update(Value: TSQLRecord; const CustomCSVFields: RawUTF8;
      DoNotAutoComputeFields: boolean=false; ForceCacheUpdate: boolean=false): integer; overload;
    /// delete a member in current BATCH sequence
    // - work in BATCH mode: nothing is sent to the server until BatchSend call
    // - returns the corresponding index in the current BATCH sequence, -1 on error
    // - deleted record class is the TSQLRecordClass used at BatchStart()
    // call: it will fail if no class was specified for this BATCH sequence
    function Delete(ID: TID): integer; overload;
    /// delete a member in current BATCH sequence
    // - work in BATCH mode: nothing is sent to the server until BatchSend call
    // - returns the corresponding index in the current BATCH sequence, -1 on error
    // - with this overloaded method, the deleted record class is specified:
    // no TSQLRecordClass shall have been set at BatchStart() call
    function Delete(Table: TSQLRecordClass; ID: TID): integer; overload;
    /// allow to append some JSON content to the internal raw buffer
    // - could be used to emulate Add/Update/Delete
    // - FullRow=TRUE will increment the global Count
    function RawAppend(FullRow: boolean=true): TTextWriter;
    /// allow to append some JSON content to the internal raw buffer for a POST
    // - could be used to emulate Add() with an already pre-computed JSON object
    // - returns the corresponding index in the current BATCH sequence, -1 on error
    function RawAdd(const SentData: RawUTF8): integer;
    /// allow to append some JSON content to the internal raw buffer for a PUT
    // - could be used to emulate Update() with an already pre-computed JSON object
    // - returns the corresponding index in the current BATCH sequence, -1 on error
    function RawUpdate(const SentData: RawUTF8; ID: TID): integer;
    /// close a BATCH sequence started by Start method
    // - Data is ready to be supplied to TSQLRest.BatchSend() overloaded method
    // - will also notify the TSQLRest.Cache for all deleted IDs
    // - you should not have to call it in normal use cases
    function PrepareForSending(out Data: RawUTF8): boolean; virtual;
    /// read only access to the associated TSQLRest instance
    property Rest: TSQLRest read fRest;
    /// how many times Add() has been called for this BATCH process
    property AddCount: integer read fAddCount;
    /// how many times Update() has been called for this BATCH process
    property UpdateCount: integer read fUpdateCount;
    /// how many times Delete() has been called for this BATCH process
    property DeleteCount: integer read fDeleteCount;
    /// this event handler will be triggerred by each Add/Update/Delete method
    property OnWrite: TOnBatchWrite read fOnWrite write fOnWrite;
  published
    /// read only access to the main associated TSQLRecord class (if any)
    property Table: TSQLRecordClass read fTable;
    /// retrieve the current number of pending transactions in the BATCH sequence
    property Count: integer read GetCount;
    /// retrieve the current JSON size of pending transaction in the BATCH sequence
    property SizeBytes: cardinal read GetSizeBytes;
  end;

  /// thread-safe class to store a BATCH sequence of writing operations
  TSQLRestBatchLocked = class(TSQLRestBatch)
  protected
    fTix: Int64;
    fSafe: TSynLocker;
    fThreshold: integer;
  public
    /// initialize the BATCH instance
    constructor Create(aRest: TSQLRest; aTable: TSQLRecordClass;
      AutomaticTransactionPerRow: cardinal=0; Options: TSQLRestBatchOptions=[];
      InternalBufferSize: cardinal=65536); override;
    /// finalize the BATCH instance
    destructor Destroy; override;
    /// reset the BATCH sequence so that you can re-use the same TSQLRestBatch
    procedure Reset(aTable: TSQLRecordClass; AutomaticTransactionPerRow: cardinal=0;
      Options: TSQLRestBatchOptions=[]); override;
    /// access to the locking methods of this instance
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: TSynLocker read fSafe;
    /// property set to the current GetTickCount64 value when Reset is called
    property ResetTix: Int64 read fTix write fTix;
    /// may be used to store a number of rows to flush the content
    property Threshold: integer read fThreshold write fThreshold;
  end;

  /// root class for defining and mapping database records
  // - inherits a class from TSQLRecord, and add published properties to describe
  // the table columns (see TPropInfo for SQL and Delphi type mapping/conversion)
  // - this published properties can be auto-filled from TSQLTable answer with
  // FillPrepare() and FillRow(), or FillFrom() with TSQLTable or JSON data
  // - these published properties can be converted back into UTF-8 encoded SQL
  // source with GetSQLValues or GetSQLSet or into JSON format with GetJSONValues
  // - BLOB fields are decoded to auto-freeing TSQLRawBlob properties
  // - any published property defined as a T*ObjArray dynamic array storage
  // of persistents (via TJSONSerializer.RegisterObjArrayForJSON) will be freed
  // - consider inherit from TSQLRecordNoCase and TSQLRecordNoCaseExtended if
  // you expect regular NOCASE collation and smaller (but not standard JSON)
  // variant fields persistence
  TSQLRecord = class(TObject)
  { note that every TSQLRecord has an Instance size of 20 bytes for private and
    protected fields (such as fID or fProps e.g.) }
  protected
    /// used by FillPrepare() and corresponding Fill*() methods
    fFill: TSQLRecordFill;
    /// internal properties getters (using fProps data for speed)
    function GetHasBlob: boolean;
    function GetSimpleFieldCount: integer;
    function GetFillCurrentRow: integer;
    function GetFillReachedEnd: boolean;
    function GetTable: TSQLTable;
  protected
    fInternalState: cardinal;
    fID: TID;
    /// virtual class method to be overridden to register some custom properties
    // - do nothing by default, but allow inherited classes to define some
    // properties, by adding some TSQLPropInfo instances to Props.Fields list,
    // or calling Props.RegisterCustomFixedSizeRecordProperty() or
    // Props.RegisterCustomRTTIRecordProperty() methods
    // - can also be used to specify a custom text collation, by calling
    // Props.SetCustomCollationForAll() or SetCustomCollation() methods
    // - do not call RecordProps from here (e.g. by calling AddFilter*): it
    // woult trigger a stack overflow, since at this state Props is not stored -
    // but rather use InternalDefineModel class method
    class procedure InternalRegisterCustomProperties(Props: TSQLRecordProperties); virtual;
    /// virtual class method to be overridden to define some record-level modeling
    // - do nothing by default, but allow inherited classes to define some
    // process which will take place after TSQLRecordProperties initialization
    // - this may be the place e.g. to call AddFilter*() methods, if you do not
    // want those to be written "in stone", and not manually when creating the
    // TSQLModel instance, or to call Props.SetCustomCollationForAll
    class procedure InternalDefineModel(Props: TSQLRecordProperties); virtual;
  {$ifdef MSWINDOWS}{$ifdef HASINLINE}
  public
  {$endif}{$endif}
    /// trick to get the ID even in case of a sftID published property
    function GetID: TID;
      {$ifdef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}
    /// trick to typecast the ID on 64-bit platform
    function GetIDAsPointer: pointer;
      {$ifdef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}
  public
    /// direct access to the TSQLRecord properties from RTTI
    // - TSQLRecordProperties is faster than e.g. the class function FieldProp()
    // - use internal the unused vmtAutoTable VMT entry to fast retrieve of a
    // class variable which is unique for each class ("class var" is unique only
    // for the class within it is defined, and we need a var for each class:
    // so even Delphi XE syntax is not powerful enough for our purpose, and the
    // vmtAutoTable trick if very fast, and works with all versions of Delphi -
    // including 64-bit target)
    class function RecordProps: TSQLRecordProperties;
      {$ifdef FPC_OR_PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}
    /// the Table name in the database, associated with this TSQLRecord class
    // - 'TSQL' or 'TSQLRecord' chars are trimmed at the beginning of the ClassName
    // - or the ClassName is returned as is, if no 'TSQL' or 'TSQLRecord' at first
    // - is just a wrapper around RecordProps.SQLTableName
    class function SQLTableName: RawUTF8;
      {$ifdef HASINLINE}inline;{$endif}
    /// register a custom filter (transformation) or validate to the
    // TSQLRecord class for a specified field
    // - this will be used by TSQLRecord.Filter and TSQLRecord.Validate
    // methods (in default implementation)
    // - will raise an EModelException on failure
    // - this function is just a wrapper around RecordProps.AddFilterOrValidate
    class procedure AddFilterOrValidate(const aFieldName: RawUTF8;
      aFilter: TSynFilterOrValidate);
    /// register a TSynFilterTrim and a TSynValidateText filters so that
    // the specified fields, after space trimming, won't be void
    class procedure AddFilterNotVoidText(const aFieldNames: array of RawUTF8);
    /// register a TSynFilterTrim and a TSynValidateText filters so that
    // all text fields, after space trimming, won't be void
    // - will only affect RAWTEXT_FIELDS
    class procedure AddFilterNotVoidAllTextFields;

    /// protect several TSQLRecord local variable instances
    // - specified as localVariable/recordClass pairs
    // - is a wrapper around TAutoFree.Several(...) constructor
    // - be aware that it won't implement a full ARC memory model, but may be
    // just used to avoid writing some try ... finally blocks on local variables
    // - use with caution, only on well defined local scope
    // - you may write for instance:
    // ! var info: TSQLBlogInfo;
    // !     article: TSQLArticle;
    // !     comment: TSQLComment;
    // ! begin
    // !   TSQLRecord.AutoFree([ // avoid several try..finally
    // !     @info,TSQLBlogInfo, @article,TSQLArticle, @comment,TSQLComment]);
    // !   .... now you can use info, article or comment
    // ! end; // will call info.Free article.Free and comment.Free
    // - warning: under FPC, you should assign the result of this method to
    // a local IAutoFree variable, or use a with TSQLRecord.AutoFree() do
    // statement - see http://bugs.freepascal.org/view.php?id=26602
    class function AutoFree(varClassPairs: array of pointer): IAutoFree; overload;
    /// protect one TSQLRecord local variable instance
    // - be aware that it won't implement a full ARC memory model, but may be
    // just used to avoid writing some try ... finally blocks on local variables
    // - use with caution, only on well defined local scope
    // - you may write for instance:
    // ! var info: TSQLBlogInfo;
    // ! begin
    // !   TSQLBlogInfo.AutoFree(info);
    // !   .... now you can use info
    // ! end; // will call info.Free
    // - warning: under FPC, you should assign the result of this method to
    // a local IAutoFree variable, or use a with TSQLRecord.AutoFree() do
    // statement - see http://bugs.freepascal.org/view.php?id=26602
    class function AutoFree(var localVariable): IAutoFree; overload;
    /// read and protect one TSQLRecord local variable instance
    // - is a wrapper around TAutoFree.Create(localVariable,Create(Rest,ID))
    // - be aware that it won't implement a full ARC memory model, but may be
    // just used to avoid writing some try ... finally blocks on local variables
    // - use with caution, only on well defined local scope
    // - warning: under FPC, you should assign the result of this method to
    // a local IAutoFree variable, or use a with TSQLRecord.AutoFree() do
    // statement - see http://bugs.freepascal.org/view.php?id=26602
    class function AutoFree(var localVariable; Rest: TSQLRest; ID: TID): IAutoFree; overload;
    /// FillPrepare and protect one TSQLRecord local variable instance
    // - is a wrapper around TAutoFree.Create(localVariable,CreateAndFillPrepare(Rest,...))
    // - be aware that it won't implement a full ARC memory model, but may be
    // just used to avoid writing some try ... finally blocks on local variables
    // - use with caution, only on well defined local scope
    // - warning: under FPC, you should assign the result of this method to
    // a local IAutoFree variable, or use a with TSQLRecord.AutoFree() do
    // statement - see http://bugs.freepascal.org/view.php?id=26602
    class function AutoFree(var localVariable; Rest: TSQLRest;
      const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
      const aCustomFieldsCSV: RawUTF8=''): IAutoFree; overload;
    /// FillPrepare and protect one TSQLRecord local variable instance
    // - is a wrapper around TAutoFree.Create(localVariable,CreateAndFillPrepare(Rest,...))
    // - be aware that it won't implement a full ARC memory model, but may be
    // just used to avoid writing some try ... finally blocks on local variables
    // - use with caution, only on well defined local scope
    // - warning: under FPC, you should assign the result of this method to
    // a local IAutoFree variable, or use a with TSQLRecord.AutoFree() do
    // statement - see http://bugs.freepascal.org/view.php?id=26602
    class function AutoFree(var localVariable; Rest: TSQLRest;
      const FormatSQLWhere: RawUTF8; const ParamsSQLWhere,BoundsSQLWhere: array of const;
      const aCustomFieldsCSV: RawUTF8=''): IAutoFree; overload;

    /// get the captions to be used for this class
    // - if Action is nil, return the caption of the table name
    // - if Action is not nil, return the caption of this Action (lowercase left-trimed)
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    // - internally call UnCamelCase() then System.LoadResStringTranslate() if available
    // - ForHint is set to TRUE when the record caption name is to be displayed inside
    // the popup hint of a button (i.e. the name must be fully qualified, not
    // the default short version)
    // - is not part of TSQLRecordProperties because has been declared as virtual
    class function CaptionName(Action: PRawUTF8=nil; ForHint: boolean=false): string; virtual;
    /// get the captions to be used for this class
    // - just a wrapper calling CaptionName() virtual method, from a ShortString pointer
    class function CaptionNameFromRTTI(Action: PShortString): string;
    /// virtual method called when the associated table is created in the database
    // - if FieldName is '', initialization regarding all fields must be made;
    // if FieldName is specified, initialization regarding this field must be processed
    // - override this method in order to initialize indexs or create default records
    // - by default, create indexes for all TRecordReference properties, and
    // for all TSQLRecord inherited properties (i.e. of sftID type, that is
    // an INTEGER field containing the ID of the pointing record)
    // - the options specified at CreateMissingTables() are passed to this method,
    // within the context of an opened DB transaction, in which missing tables
    // and fields have already been added
    // - is not part of TSQLRecordProperties because has been declared as virtual
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); virtual;

    /// filter/transform the specified fields values of the TSQLRecord instance
    // - by default, this will perform all TSynFilter as registered by
    // [RecordProps.]AddFilterOrValidate()
    // - inherited classes may add some custom filtering/transformation here, if
    // it's not needed nor mandatory to create a new TSynFilter class type: in
    // this case, the function has to return TRUE if the filtering took place,
    // and FALSE if any default registered TSynFilter must be processed
    // - the default aFields parameter will process all fields
    function Filter(const aFields: TSQLFieldBits=[0..MAX_SQLFIELDS-1]): boolean; overload; virtual;
    ///  filter/transform the specified fields values of the TSQLRecord instance
    // - this version will call the overloaded Filter() method above
    // - return TRUE if all field names were correct and processed, FALSE otherwise
    function Filter(const aFields: array of RawUTF8): boolean; overload;
    /// validate the specified fields values of the current TSQLRecord instance
    // - by default, this will perform all TSynValidate as registered by
    //  [RecordProps.]AddFilterOrValidate()
    // - it will also check if any UNIQUE field value won't be duplicated
    // - inherited classes may add some custom validation here, if it's not needed
    //  nor mandatory to create a new TSynValidate class type: in this case, the
    //  function has to return an explicit error message (as a generic VCL string)
    //  if the custom validation failed, or '' if the validation was successful:
    //  in this later case, all default registered TSynValidate are processed
    // - the default aFields parameter will process all fields
    // - if aInvalidFieldIndex is set, it will contain the first invalid field
    //  index found
    // - caller SHOULD always call the Filter() method before calling Validate()
    function Validate(aRest: TSQLRest; const aFields: TSQLFieldBits=[0..MAX_SQLFIELDS-1];
      aInvalidFieldIndex: PInteger=nil; aValidator: PSynValidate=nil): string; overload; virtual;
    ///  validate the specified fields values of the current TSQLRecord instance
    // - this version will call the overloaded Validate() method above
    // - returns '' if all field names were correct and processed, or an
    // explicit error message (translated in the current language) on error
    // - if aInvalidFieldIndex is set, it will contain the first invalid field index
    function Validate(aRest: TSQLRest; const aFields: array of RawUTF8;
      aInvalidFieldIndex: PInteger=nil; aValidator: PSynValidate=nil): string; overload;
    /// filter (transform) then validate the specified fields values of the TSQLRecord
    // - this version will call the overloaded Filter() and Validate() methods
    // and display the faulty field name at the beginning of the error message
    // - returns true if all field names were correct and processed, or false
    // and an explicit error message (translated in the current language) on error
    function FilterAndValidate(aRest: TSQLRest; out aErrorMessage: string;
      const aFields: TSQLFieldBits=[0..MAX_SQLFIELDS-1];
      aValidator: PSynValidate=nil): boolean; overload;
    /// filter (transform) then validate the specified fields values of the TSQLRecord
    // - this version will call the overloaded Filter() and Validate() methods
    // and return '' on validation success, or an error message with the faulty
    // field names at the beginning
    function FilterAndValidate(aRest: TSQLRest;
      const aFields: TSQLFieldBits=[0..MAX_SQLFIELDS-1];
      aValidator: PSynValidate=nil): RawUTF8; overload;
    /// should modify the record content before writing to the Server
    // - this default implementation will update any sftModTime / TModTime,
    // sftCreateTime / TCreateTime and sftSessionUserID / TSessionUserID
    // properties content with the exact server time stamp
    // - you may override this method e.g. for custom calculated fields
    // - note that this is computed only on the Client side, before sending
    // back the content to the remote Server: therefore, TModTime / TCreateTime
    // fields are a pure client ORM feature - it won't work directly at REST level
    procedure ComputeFieldsBeforeWrite(aRest: TSQLRest; aOccasion: TSQLEvent); virtual;

    /// this constructor initializes the record
    // - auto-instanciate any TSQLRecordMany instance defined in published properties
    // - override this method if you want to use some internal objects (e.g.
    // TStringList or TCollection as published property)
    constructor Create; overload; virtual;
    /// this constructor initializes the record and set the simple fields
    // with the supplied values
    // - the aSimpleFields parameters must follow explicitely the order of
    // published properties of the aTable class, excepting the TSQLRawBlob and
    // TSQLRecordMany kind (i.e. only so called "simple fields") - in
    // particular, parent properties must appear first in the list
    // - the aSimpleFields must have exactly the same count of parameters as
    // there are "simple fields" in the published properties
    // - will raise an EORMException in case of wrong supplied values
    constructor Create(const aSimpleFields: array of const; aID: TID); overload;
    /// this constructor initializes the object as above, and fills its content
    // from a client or server connection
    // - if ForUpdate is true, the REST method is LOCK and not GET: it tries to lock
    // the corresponding record, then retrieve its content; caller has to call
    // UnLock() method after Value usage, to release the record
    constructor Create(aClient: TSQLRest; aID: TID;
      ForUpdate: boolean=false); overload;
    /// this constructor initializes the object and fills its content from a client
    // or server connection, from a TSQLRecord published property content
    // - is just a wrapper around Create(aClient,PtrInt(aPublishedRecord))
    // or Create(aClient,aPublishedRecord.ID)
    // - a published TSQLRecord property is not a class instance, but a typecast to
    // TObject(RecordID) - you can also use its ID property
    // - if ForUpdate is true, the REST method is LOCK and not GET: it tries to lock
    // the corresponding record, then retrieve its content; caller has to call
    // UnLock() method after Value usage, to release the record
    constructor Create(aClient: TSQLRest; aPublishedRecord: TSQLRecord;
      ForUpdate: boolean=false); overload;
    /// this constructor initializes the object as above, and fills its content
    //  from a client or server connection, using a specified WHERE clause
    //  - the WHERE clause should use inlined parameters (like 'Name=:('Arnaud'):')
    //  for better server speed - note that you can use FormatUTF8() as such:
    //  ! aRec := TSQLMyRec.Create(Client,FormatUTF8('Salary>? AND Salary<?',[],[1000,2000]));
    //  or call the overloaded contructor with BoundsSQLWhere array of parameters
    constructor Create(aClient: TSQLRest; const aSQLWhere: RawUTF8); overload;
    /// this constructor initializes the object as above, and fills its content
    // from a client or server connection, using a specified WHERE clause
    // with parameters
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL/DateTimeToSQL for TDateTime, or directly any integer / double /
    // currency / RawUTF8 values to be bound to the request as parameters
    // - note that this method prototype changed with revision 1.17 of the
    // framework: array of const used to be ParamsSQLWhere and '%' in the
    // FormatSQLWhere statement, whereas it now expects bound parameters as '?'
    constructor Create(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const); overload;
    /// this constructor initializes the object as above, and fills its content
    // from a client or server connection, using a specified WHERE clause
    // with parameters
    // - the FormatSQLWhere clause will replace all '%' chars with the supplied
    // ParamsSQLWhere[] values, and all '?' chars with BoundsSQLWhere[] values,
    // as :(...): inlined parameters - you should either call:
    // ! Rec := TSQLMyRecord.Create(aClient,'Count=:(%):'[aCount],[]);
    // or (letting the inlined parameters being computed by FormatUTF8)
    // !  Rec := TSQLMyRecord.Create(aClient,'Count=?',[],[aCount]);
    // or even better, using the other Create overloaded constructor:
    // !  Rec := TSQLMyRecord.Create(aClient,'Count=?',[aCount]);
    // - using '?' and BoundsSQLWhere[] is perhaps more readable in your code, and
    // will in all case create a request with :(..): inline parameters, with
    // automatic RawUTF8 quoting if necessary
    constructor Create(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
      const ParamsSQLWhere, BoundsSQLWhere: array of const); overload;
    /// this constructor initializes the object as above, and fills its content
    // from a supplied JSON content
    // - is a wrapper around Create + FillFrom() methods
    // - use JSON data, as exported by GetJSONValues(), expanded or not
    // - make an internal copy of the JSONTable RawUTF8 before calling
    // FillFrom() below
    constructor CreateFrom(const JSONRecord: RawUTF8); overload;
    /// this constructor initializes the object as above, and fills its content
    // from a supplied JSON buffer
    // - is a wrapper around Create + FillFrom() methods
    // - use JSON data, as exported by GetJSONValues(), expanded or not
    // - the data inside P^ is modified (unescaped and transformed in-place):
    // don't call CreateFrom(pointer(JSONRecord)) but CreateFrom(JSONRecord) which
    // makes a temporary copy of the JSONRecord text variable before parsing
    constructor CreateFrom(P: PUTF8Char); overload;
    {$ifndef NOVARIANTS}
    /// this constructor initializes the object as above, and fills its content
    // from a supplied TDocVariant object document
    // - is a wrapper around Create + FillFrom() methods
    constructor CreateFrom(const aDocVariant: variant); overload;
    {$endif}

    /// this constructor initializes the object as above, and prepares itself to
    // loop through a statement using a specified WHERE clause
    // - this method creates a TSQLTableJSON, retrieves all records corresponding
    // to the WHERE clause, then call FillPrepare - previous Create(aClient)
    // methods retrieve only one record, this one more multiple rows
    // - you should then loop for all rows using 'while Rec.FillOne do ...'
    // - the TSQLTableJSON will be freed by TSQLRecord.Destroy
    // - the WHERE clause should use inlined parameters (like 'Name=:('Arnaud'):')
    // for better server speed - note that you can use FormatUTF8() as such:
    // ! aRec := TSQLMyRec.CreateAndFillPrepare(Client,FormatUTF8('Salary>? AND Salary<?',[],[1000,2000]));
    // or call the overloaded CreateAndFillPrepare() contructor directly with
    // BoundsSQLWhere array of parameters
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // - default aCustomFieldsCSV='' will retrieve all simple table fields
    // - if aCustomFieldsCSV='*', it will retrieve all fields, including BLOBs
    // - aCustomFieldsCSV can also be set to a CSV field list to retrieve only
    // the needed fields, and save remote bandwidth - note that any later
    // Update() will update all simple fields, so potentially with wrong
    // values; but BatchUpdate() can be safely used since it will
    constructor CreateAndFillPrepare(aClient: TSQLRest; const aSQLWhere: RawUTF8;
      const aCustomFieldsCSV: RawUTF8=''); overload;
    /// this constructor initializes the object as above, and prepares itself to
    // loop through a statement using a specified WHERE clause
    // - this method creates a TSQLTableJSON, retrieves all records corresponding
    // to the WHERE clause, then call FillPrepare - previous Create(aClient)
    // methods retrieve only one record, this one more multiple rows
    // - you should then loop for all rows using 'while Rec.FillOne do ...'
    // - the TSQLTableJSON will be freed by TSQLRecord.Destroy
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL/DateTimeToSQL for TDateTime, or directly any integer / double /
    // currency / RawUTF8 values to be bound to the request as parameters
    // - note that this method prototype changed with revision 1.17 of the
    // framework: array of const used to be ParamsSQLWhere and '%' in the
    // FormatSQLWhere statement, whereas it now expects bound parameters as '?'
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // - default aCustomFieldsCSV='' will retrieve all simple table fields, but
    // you may need  to access only one or several fields, and will save remote
    // bandwidth by specifying the needed fields
    // - if aCustomFieldsCSV='*', it will retrieve all fields, including BLOBs
    // - note that you should not use this aCustomFieldsCSV optional parameter if
    // you want to Update the retrieved record content later, since any
    // missing fields will be left with previous values - but BatchUpdate() can be
    // safely used after FillPrepare (will set only ID, TModTime and mapped fields)
    constructor CreateAndFillPrepare(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8=''); overload;
    /// this constructor initializes the object as above, and prepares itself to
    // loop through a statement using a specified WHERE clause
    // - this method creates a TSQLTableJSON, retrieves all records corresponding
    // to the WHERE clause, then call FillPrepare - previous Create(aClient)
    // methods retrieve only one record, this one more multiple rows
    // - you should then loop for all rows using 'while Rec.FillOne do ...'
    // - the TSQLTableJSON will be freed by TSQLRecord.Destroy
    // - the FormatSQLWhere clause will replace all '%' chars with the supplied
    // ParamsSQLWhere[] supplied values, and bind all '?' chars as parameters
    // with BoundsSQLWhere[] values
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // - default aCustomFieldsCSV='' will retrieve all simple table fields, but
    // you may need  to access only one or several fields, and will save remote
    // bandwidth by specifying the needed fields
    // - if aCustomFieldsCSV='*', it will retrieve all fields, including BLOBs
    // - note that you should not use this aCustomFieldsCSV optional parameter if
    // you want to Update the retrieved record content later, since any
    // missing fields will be left with previous values - but BatchUpdate() can be
    // safely used after FillPrepare (will set only ID, TModTime and mapped fields)
    constructor CreateAndFillPrepare(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
      const ParamsSQLWhere, BoundsSQLWhere: array of const;
      const aCustomFieldsCSV: RawUTF8=''); overload;
    /// this constructor initializes the object as above, and prepares itself to
    // loop through a given list of IDs
    // - this method creates a TSQLTableJSON, retrieves all records corresponding
    // to the specified IDs, then call FillPrepare - previous Create(aClient)
    // methods retrieve only one record, this one more multiple rows
    // - you should then loop for all rows using 'while Rec.FillOne do ...'
    // - the TSQLTableJSON will be freed by TSQLRecord.Destroy
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // - default aCustomFieldsCSV='' will retrieve all simple table fields, but
    // you may need  to access only one or several fields, and will save remote
    // bandwidth by specifying the needed fields
    // - if aCustomFieldsCSV='*', it will retrieve all fields, including BLOBs
    // - note that you should not use this aCustomFieldsCSV optional parameter if
    // you want to Update the retrieved record content later, since any
    // missing fields will be left with previous values - but BatchUpdate() can be
    // safely used after FillPrepare (will set only ID, TModTime and mapped fields)
    constructor CreateAndFillPrepare(aClient: TSQLRest; const aIDs: array of Int64;
      const aCustomFieldsCSV: RawUTF8=''); overload;
    /// this constructor initializes the object, and prepares itself to loop
    // through a specified JSON table, which will use a private copy
    // - this method creates a TSQLTableJSON, fill it with the supplied JSON buffer,
    // then call FillPrepare - previous Create(aClient) methods retrieve only
    // one record, this one more multiple rows
    // - you should then loop for all rows using 'while Rec.FillOne do ...'
    // - the TSQLTableJSON will be freed by TSQLRecord.Destroy
    constructor CreateAndFillPrepare(const aJSON: RawUTF8); overload;
    /// this constructor initializes the object, and prepares itself to loop
    // through a specified JSON table buffer, which will be modified in-place
    // - this method creates a TSQLTableJSON, fill it with the supplied JSON buffer,
    // then call FillPrepare - previous Create(aClient) methods retrieve only
    // one record, this one more multiple rows
    // - you should then loop for all rows using 'while Rec.FillOne do ...'
    // - the TSQLTableJSON will be freed by TSQLRecord.Destroy
    constructor CreateAndFillPrepare(aJSON: PUTF8Char; aJSONLen: integer); overload;
    /// this constructor initializes the object from its ID, including all
    // nested TSQLRecord properties, through a JOINed statement
    // - by default, Create(aClient,aID) will return only the one-to-one
    // nested TSQLRecord published properties IDs trans-typed as pointer - this
    // constructor allow to retrieve the nested values in one statement
    // - use this constructor if you want all TSQLRecord published properties to
    // be allocated, and loaded with the corresponding values
    // - Free/Destroy will release these instances
    // - warning: if you call Update() after it, only the main object will be
    // updated, not the nested TSQLRecord properties
    constructor CreateJoined(aClient: TSQLRest; aID: TID);
    /// this constructor initializes the object, and prepares itself to loop
    // nested TSQLRecord properties, through a JOINed statement and a WHERE clause
    // - by default, CreateAndFillPrepare() will return only the one-to-one
    // nested TSQLRecord published properties IDs trans-typed as pointer - this
    // constructor allow to retrieve the nested values in one statement
    //  - this method creates a TSQLTableJSON, fill it with the supplied JSON buffer,
    // then call FillPrepare - previous CreateJoined() method retrieve only
    // one record, this one more multiple rows
    // - you should then loop for all rows using 'while Rec.FillOne do ...'
    // - use this constructor if you want all TSQLRecord published properties to
    // be allocated, and loaded with the corresponding values
    // - Free/Destroy will release these instances
    // - warning: if you call Update() after it, only the main object will be
    // updated, not the nested TSQLRecord properties
    constructor CreateAndFillPrepareJoined(aClient: TSQLRest;
      const aFormatSQLJoin: RawUTF8; const aParamsSQLJoin, aBoundsSQLJoin: array of const);
    /// this constructor initializes the object including all TSQLRecordMany properties,
    // and prepares itself to loop through a JOINed statement
    // - the created instance will have all its TSQLRecordMany Dest property allocated
    // with proper instance (and not only pointer(DestID) e.g.), ready to be
    // consumed during a while FillOne do... loop (those instances will be
    // freed by TSQLRecord.FillClose or Destroy) - and the Source property
    // won't contain pointer(SourceID) but the main TSQLRecord instance
    // - the aFormatSQLJoin clause will define a WHERE clause for an automated
    // JOINed statement, including TSQLRecordMany published properties (and
    // their nested properties)
    // - a typical use could be the following:
    // ! aProd := TSQLProduct.CreateAndFillPrepareMany(Database,
    // !   'Owner=? and Categories.Dest.Name=? and (Sizes.Dest.Name=? or Sizes.Dest.Name=?)',[],
    // !   ['mark','for boy','small','medium']);
    // ! if aProd<>nil then
    // ! try
    // !   while aProd.FillOne do
    // !     //  here e.g. aProd.Categories.Dest are instantied (and Categories.Source=aProd)
    // !     writeln(aProd.Name,' ',aProd.Owner,' ',aProd.Categories.Dest.Name,' ',aProd.Sizes.Dest.Name);
    // !   //  you may also use aProd.FillTable to fill a grid, e.g.
    // !   //  (do not forget to set aProd.FillTable.OwnerMustFree := false)
    // ! finally
    // !   aProd.Free; //  will also free aProd.Categories/Sizes instances
    // ! end;
    // this will execute a JOINed SELECT statement similar to the following:
    // $ select p.*, c.*, s.*
    // $ from Product p, Category c, Categories cc, Size s, Sizes ss
    // $ where c.id=cc.dest and cc.source=p.id and
    // $  s.id=ss.dest and ss.source=p.id and
    // $  p.Owner='mark' and c.Name='for boy' and (s.Name='small' or s.Name='medium')
    // - you SHALL call explicitely the FillClose method before using any
    // methods of nested TSQLRecordMany instances which may override the Dest
    // instance content (e.g. ManySelect) to avoid any GPF
    // - the aFormatSQLJoin clause will replace all '%' chars with the supplied
    // aParamsSQLJoin[] supplied values, and bind all '?' chars as bound
    // parameters with aBoundsSQLJoin[] values
    constructor CreateAndFillPrepareMany(aClient: TSQLRest; const aFormatSQLJoin: RawUTF8;
      const aParamsSQLJoin, aBoundsSQLJoin: array of const);

    /// this method create a clone of the current record, with same ID and properties
    // - copy all COPIABLE_FIELDS, i.e. all fields excluding tftMany (because
    // those fields don't contain any data, but a TSQLRecordMany instance
    // which allow to access to the pivot table data)
    // - you can override this method to allow custom copy of the object,
    // including (or not) published properties copy
    function CreateCopy: TSQLRecord; overload; virtual;
    /// this method create a clone of the current record, with same ID and properties
    // - overloaded method to copy the specified properties
    function CreateCopy(const CustomFields: TSQLFieldBits): TSQLRecord; overload;
    /// set the bits corresponding to non-void (0,'') copiable fields
    function GetNonVoidFields: TSQLFieldBits;
    /// release the associated memory
    // - in particular, release all TSQLRecordMany instance created by the
    // constructor of this TSQLRecord
    destructor Destroy; override;

    /// return the UTF-8 encoded SQL source to create the table containing the
    // published fields of a TSQLRecord child
    // - a 'ID INTEGER PRIMARY KEY' field is always created first (mapping
    // SQLite3 RowID)
    // - AnsiString are created as TEXT COLLATE NOCASE (fast SQLite3 7bits compare)
    // - RawUnicode and RawUTF8 are created as TEXT COLLATE SYSTEMNOCASE
    // (i.e. use our fast UTF8IComp() for comparaison)
    // - TDateTime are created as TEXT COLLATE ISO8601
    // (which calls our very fast ISO TEXT to Int64 conversion routine)
    // - an individual bit set in UniqueField forces the corresponding field to
    // be marked as UNIQUE (an unique index is automaticaly created on the specified
    // column); use TSQLModel fIsUnique[] array, which set the bits values
    // to 1 if a property field was published with "stored AS_UNIQUE"
    // (i.e. "stored false")
    // - this method will handle TSQLRecordFTS* classes like FTS* virtual tables,
    // TSQLRecordRTree as RTREE virtual table, and TSQLRecordVirtualTable*ID
    // classes as corresponding Delphi designed virtual tables
    // - is not part of TSQLRecordProperties because has been declared as virtual
    // so that you could specify a custom SQL statement, per TSQLRecord type
    // - anyway, don't call this method directly, but use TSQLModel.GetSQLCreate()
    // - the aModel parameter is used to retrieve the Virtual Table module name,
    // and can be ignored for regular (not virtual) tables
    class function GetSQLCreate(aModel: TSQLModel): RawUTF8; virtual;
    /// return the Class Type of the current TSQLRecord
    function RecordClass: TSQLRecordClass;
      {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}
    /// return the RTTI property information for this record
    function ClassProp: PClassProp;
      {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}
    /// return the TRecordReference Int64 value pointing to this record
    function RecordReference(Model: TSQLModel): TRecordReference;

    /// return the UTF-8 encoded SQL source to INSERT the values contained
    // in the current published fields of a TSQLRecord child
    // - only simple fields name (i.e. not TSQLRawBlob/TSQLRecordMany) are updated:
    // BLOB fields are ignored (use direct update via dedicated methods instead)
    // - format is '(COL1, COL2) VALUES ('VAL1', 'VAL2')' if some column was ignored
    // (BLOB e.g.)
    // - format is 'VALUES ('VAL1', 'VAL2')' if all columns values are available
    // - is not used by the ORM (do not use prepared statements) - only here
    // for conveniency
    function GetSQLValues: RawUTF8;
    /// return the UTF-8 encoded SQL source to UPDATE the values contained
    // in the current published fields of a TSQLRecord child
    // - only simple fields name (i.e. not TSQLRawBlob/TSQLRecordMany) are retrieved:
    // BLOB fields are ignored (use direct access via dedicated methods instead)
    // - format is 'COL1='VAL1', COL2='VAL2''
    // - is not used by the ORM (do not use prepared statements) - only here
    // for conveniency
    function GetSQLSet: RawUTF8;
    /// return the UTF-8 encoded JSON objects for the values of this TSQLRecord
    // - layout and fields should have been set at TJSONSerializer construction:
    // to append some content to an existing TJsonSerializer, call the
    // AppendAsJsonObject() method
    procedure GetJSONValues(W : TJSONSerializer); overload;
    /// return the UTF-8 encoded JSON objects for the values of this TSQLRecord
    // - the JSON buffer will be finalized if needed (e.g. non expanded mode),
  	// and the supplied TJSONSerializer instance will be freed by this method
    // - layout and fields should have been set at TJSONSerializer construction:
    // to append some content to an existing TJsonSerializer, call the
    // AppendAsJsonObject() method
    procedure GetJSONValuesAndFree(JSON : TJSONSerializer); overload;
    /// return the UTF-8 encoded JSON objects for the values contained
    // in the current published fields of a TSQLRecord child
    // - only simple fields (i.e. not TSQLRawBlob/TSQLRecordMany) are retrieved:
    //   BLOB fields are ignored (use direct access via dedicated methods instead)
    // - if Expand is true, JSON data is an object, for direct use with any Ajax or .NET client:
    // ! {"col1":val11,"col2":"val12"}
    // - if Expand is false, JSON data is serialized (as used in TSQLTableJSON)
    // ! { "fieldCount":1,"values":["col1","col2",val11,"val12",val21,..] }
    // - if withID is true, then the first ID field value is included
    // - you can customize SQLRecordOptions, e.g. if sftObject/sftBlobDynArray
    // property instance will be serialized as a JSON object or array, not a
    // JSON string (which is the default, as expected by the database storage),
    // or if an "ID_str" string field should be added for JavaScript
    procedure GetJSONValues(JSON: TStream; Expand, withID: boolean;
      Occasion: TSQLOccasion; SQLRecordOptions: TJSONSerializerSQLRecordOptions=[]); overload;
    /// same as overloaded GetJSONValues(), but returning result into a RawUTF8
    // - if UsingStream is not set, it will use a temporary THeapMemoryStream instance
    function GetJSONValues(Expand, withID: boolean; Occasion: TSQLOccasion;
      UsingStream: TCustomMemoryStream=nil; SQLRecordOptions: TJSONSerializerSQLRecordOptions=[]): RawUTF8; overload;
    /// same as overloaded GetJSONValues(), but allowing to set the fields to
    // be retrieved, and returning result into a RawUTF8
    function GetJSONValues(Expand, withID: boolean;
      const Fields: TSQLFieldBits; SQLRecordOptions: TJSONSerializerSQLRecordOptions=[]): RawUTF8; overload;
    /// same as overloaded GetJSONValues(), but allowing to set the fields to
    // be retrieved, and returning result into a RawUTF8
    function GetJSONValues(Expand, withID: boolean;
      const FieldsCSV: RawUTF8; SQLRecordOptions: TJSONSerializerSQLRecordOptions=[]): RawUTF8; overload;
    /// will append the record fields as an expanded JSON object
    // - GetJsonValues() will expect a dedicated TJSONSerializer, whereas this
    // method will add the JSON object directly to any TJSONSerializer
    // - by default, will append the simple fields, unless the Fields optional
    // parameter is customized to a non void value
    procedure AppendAsJsonObject(W: TJSONSerializer; Fields: TSQLFieldBits=[]);
    /// will append all the FillPrepare() records as an expanded JSON array
    // - generates '[{rec1},{rec2},...]' using a loop similar to:
    // ! while FillOne do .. AppendJsonObject() ..
    // - if FieldName is set, the JSON array will be written as a JSON property,
    // i.e. surrounded as '"FieldName":[....],' - note the ',' at the end
    // - by default, will append the simple fields, unless the Fields optional
    // parameter is customized to a non void value
    // - see also TSQLRest.AppendListAsJsonArray for a high-level wrapper method
    procedure AppendFillAsJsonArray(const FieldName: RawUTF8;
       W: TJSONSerializer; Fields: TSQLFieldBits=[]);
    {$ifndef NOVARIANTS}
    /// change TDocVariantData.Options for all variant published fields
    // - may be used to replace e.g. JSON_OPTIONS_FAST_EXTENDED by JSON_OPTIONS_FAST
    procedure ForceVariantFieldsOptions(aOptions: TDocVariantOptions=JSON_OPTIONS_FAST);
    {$endif}
    /// write the field values into the binary buffer
    // - won't write the ID field (should be stored before, with the Count e.g.)
    procedure GetBinaryValues(W: TFileBufferWriter); overload;
    /// write the field values into the binary buffer
    // - won't write the ID field (should be stored before, with the Count e.g.)
    procedure GetBinaryValues(W: TFileBufferWriter; const aFields: TSQLFieldBits); overload;
    /// write the simple field values (excluding ID) into the binary buffer
    procedure GetBinaryValuesSimpleFields(W: TFileBufferWriter);
    /// set the field values from a binary buffer
    // - won't read the ID field (should be read before, with the Count e.g.)
    // - PEnd should point just after the P input buffer, to avoid buffer overflow
    // - returns true on success, or false in case of invalid content in P^ e.g.
    // - P is updated to the next pending content after the read values
    function SetBinaryValues(var P: PAnsiChar; PEnd: PAnsiChar): Boolean;
    /// set the simple field values from a binary buffer
    // - won't read the ID field (should be read before, with the Count e.g.)
    // - PEnd should point just after the P input buffer, to avoid buffer overflow
    // - returns true on success, or false in case of invalid content in P^ e.g.
    // - P is updated to the next pending content after the read values,
    function SetBinaryValuesSimpleFields(var P: PAnsiChar; PEnd: PAnsiChar): Boolean;
    /// write the record fields into RawByteString a binary buffer
    // - same as GetBinaryValues(), but also writing the ID field first
    function GetBinary: RawByteString;
    /// set the record fields from a binary buffer saved by GetBinary()
    // - same as SetBinaryValues(), but also reading the ID field first
    // - PEnd should point to the end of the P input buffer, to avoid any overflow
    function SetBinary(P,PEnd: PAnsiChar): Boolean; overload;
    /// set the record fields from a binary buffer saved by GetBinary()
    // - same as SetBinaryValues(), but also reading the ID field first
    function SetBinary(const binary: RawByteString): Boolean; overload;
    /// set all field values from a supplied array of TSQLVar values
    // - Values[] array must match the RecordProps.Field[] order: will return
    // false if the Values[].VType does not match RecordProps.FieldType[]
    function SetFieldSQLVars(const Values: TSQLVarDynArray): boolean;
    /// retrieve a field value from a given property name, as encoded UTF-8 text
    // - you should use strong typing and direct property access, following
    // the ORM approach of the framework; but in some cases (a custom Grid
    // display, for instance), it could be useful to have this method available
    // - will return '' in case of wrong property name
    // - BLOB and dynamic array fields are returned as '\uFFF0base64encodedbinary'
    function GetFieldValue(const PropName: RawUTF8): RawUTF8;
    /// set a field value of a given property name, from some encoded UTF-8 text
    // - you should use strong typing and direct property access, following
    // the ORM approach of the framework; but in some cases (a custom Grid
    // display, for instance), it could be useful to have this method available
    // - won't do anything in case of wrong property name
    // - expect BLOB and dynamic array fields encoded as SQlite3 BLOB literals
    // ("x'01234'" e.g.) or '\uFFF0base64encodedbinary'
    procedure SetFieldValue(const PropName: RawUTF8; Value: PUTF8Char);
    {$ifndef NOVARIANTS}
    /// retrieve the record content as a TDocVariant custom variant object
    function GetAsDocVariant(withID: boolean; const withFields: TSQLFieldBits;
      options: PDocVariantOptions=nil; replaceRowIDWithID: boolean=false): variant; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// retrieve the record content as a TDocVariant custom variant object
    procedure GetAsDocVariant(withID: boolean; const withFields: TSQLFieldBits;
      var result: variant; options: PDocVariantOptions=nil; ReplaceRowIDWithID: boolean=false); overload;
    /// retrieve the simple record content as a TDocVariant custom variant object
    function GetSimpleFieldsAsDocVariant(withID: boolean=true;
      options: PDocVariantOptions=nil): variant;
    /// retrieve the published property value into a Variant
    // - will set the Variant type to the best matching kind according to the
    // property type
    // - will return a null variant in case of wrong property name
    // - BLOB fields are returned as SQlite3 BLOB literals ("x'01234'" e.g.)
    // - dynamic array fields are returned as a Variant array
    function GetFieldVariant(const PropName: string): Variant;
    /// set the published property value from a Variant value
    // - will convert from the variant type into UTF-8 text before setting the
    // value (so will work with any kind of Variant)
    // - won't do anything in case of wrong property name
    // - expect BLOB fields encoded as SQlite3 BLOB literals ("x'01234'" e.g.)
    procedure SetFieldVariant(const PropName: string; const Source: Variant);
    {$endif}

    /// prepare to get values from a TSQLTable result
    // - then call FillRow(1..Table.RowCount) to get any row value
    // - or you can also loop through all rows with
    // ! while Rec.FillOne do
    // !   dosomethingwith(Rec);
    // - the specified TSQLTable is stored in an internal fTable protected field
    // - set aCheckTableName if you want e.g. the Field Names from the Table
    // any pending 'TableName.' trimmed before matching to the current record
    procedure FillPrepare(Table: TSQLTable; aCheckTableName: TSQLCheckTableName=ctnNoCheck); overload;
    /// prepare to get values from a SQL where statement
    // - returns true in case of success, false in case of an error during SQL request
    // - then call FillRow(1..Table.RowCount) to get any row value
    // - or you can also loop through all rows with
    // ! while Rec.FillOne do
    // !   dosomethingwith(Rec);
    // - a temporary TSQLTable is created then stored in an internal fTable protected field
    // - if aSQLWhere is left to '', all rows are retrieved as fast as possible
    // (e.g. by-passing SQLite3 virtual table modules for external databases)
    // - the WHERE clause should use inlined parameters (like 'Name=:('Arnaud'):')
    // for better server speed - note that you can use FormatUTF8() as such:
    // ! aRec.FillPrepare(Client,FormatUTF8('Salary>? AND Salary<?',[],[1000,2000]));
    // or call the overloaded FillPrepare() method directly with  BoundsSQLWhere
    // array of parameters
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // - default aCustomFieldsCSV='' will retrieve all simple table fields, but
    // you may need  to access only one or several fields, and will save remote
    // bandwidth by specifying the needed fields
    // - if aCustomFieldsCSV='*', it will retrieve all fields, including BLOBs
    // - note that you should not use this aCustomFieldsCSV optional parameter if
    // you want to Update the retrieved record content later, since any
    // missing fields will be left with previous values - but BatchUpdate() can be
    // safely used after FillPrepare (will set only ID, TModTime and mapped fields)
    function FillPrepare(aClient: TSQLRest; const aSQLWhere: RawUTF8='';
      const aCustomFieldsCSV: RawUTF8=''; aCheckTableName: TSQLCheckTableName=ctnNoCheck): boolean; overload;
    /// prepare to get values using a specified WHERE clause with '%' parameters
    // - returns true in case of success, false in case of an error during SQL request
    // - then call FillRow(1..Table.RowCount) to get any row value
    // - or you can also loop through all rows with
    // ! while Rec.FillOne do
    // !   dosomethingwith(Rec);
    // - a temporary TSQLTable is created then stored in an internal fTable protected field
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL/DateTimeToSQL for TDateTime, or directly any integer / double /
    // currency / RawUTF8 values to be bound to the request as parameters
    // - note that this method prototype changed with revision 1.17 of the
    // framework: array of const used to be ParamsSQLWhere and '%' in the
    // FormatSQLWhere statement, whereas it now expects bound parameters as '?'
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // - default aCustomFieldsCSV='' will retrieve all simple table fields, but
    // you may need  to access only one or several fields, and will save remote
    // bandwidth by specifying the needed fields
    // - if aCustomFieldsCSV='*', it will retrieve all fields, including BLOBs
    // - note that you should not use this aCustomFieldsCSV optional parameter if
    // you want to Update the retrieved record content later, since any
    // missing fields will be left with previous values - but BatchUpdate() can be
    // safely used after FillPrepare (will set only ID, TModTime and mapped fields)
    function FillPrepare(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8=''): boolean; overload;
    /// prepare to get values using a specified WHERE clause with '%' and '?' parameters
    // - returns true in case of success, false in case of an error during SQL request
    // - then call FillRow(1..Table.RowCount) to get any row value
    // - or you can also loop through all rows with
    // ! while Rec.FillOne do
    // !   dosomethingwith(Rec);
    // - a temporary TSQLTable is created then stored in an internal fTable
    // protected field
    // - the FormatSQLWhere clause will replace all '%' chars with the supplied
    // ParamsSQLWhere[] supplied values, and bind all '?' chars as bound
    // parameters with BoundsSQLWhere[] values
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // - default aCustomFieldsCSV='' will retrieve all simple table fields, but
    // you may need  to access only one or several fields, and will save remote
    // bandwidth by specifying the needed fields
    // - if aCustomFieldsCSV='*', it will retrieve all fields, including BLOBs
    // - note that you should not use this aCustomFieldsCSV optional parameter if
    // you want to Update the retrieved record content later, since any
    // missing fields will be left with previous values - but BatchUpdate() can be
    // safely used after FillPrepare (will set only ID, TModTime and mapped fields)
    function FillPrepare(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
      const ParamsSQLWhere, BoundsSQLWhere: array of const;
      const aCustomFieldsCSV: RawUTF8=''): boolean; overload;
    /// prepare to get values from a list of IDs
    // - returns true in case of success, false in case of an error during SQL request
    // - then call FillRow(1..Table.RowCount) to get any row value
    // - or you can also loop through all rows with
    // ! while Rec.FillOne do
    // !   dosomethingwith(Rec);
    // - a temporary TSQLTable is created then stored in an internal fTable protected field
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // - default aCustomFieldsCSV='' will retrieve all simple table fields, but
    // you may need  to access only one or several fields, and will save remote
    // bandwidth by specifying the needed fields
    // - if aCustomFieldsCSV='*', it will retrieve all fields, including BLOBs
    // - note that you should not use this aCustomFieldsCSV optional parameter if
    // you want to Update the retrieved record content later, since any
    // missing fields will be left with previous values - but BatchUpdate() can be
    // safely used after FillPrepare (will set only ID, TModTime and mapped fields)
    function FillPrepare(aClient: TSQLRest; const aIDs: array of Int64;
      const aCustomFieldsCSV: RawUTF8=''): boolean; overload;
    // / prepare to loop through a JOINed statement including TSQLRecordMany fields
    // - all TSQLRecordMany.Dest published fields will now contain a true TSQLRecord
    // instance, ready to be filled with the JOINed statement results (these
    // instances will be released at FillClose) - the same for Source which will
    // point to the self instance
    // - the aFormatSQLJoin clause will define a WHERE clause for an automated
    // JOINed statement, including TSQLRecordMany published properties (and
    // their nested properties)
    // - returns true in case of success, false in case of an error during SQL request
    // - a typical use could be the following:
    // ! if aProd.FillPrepareMany(Database,
    // !    'Owner=? and Categories.Dest.Name=? and (Sizes.Dest.Name=? or Sizes.Dest.Name=?)',[],
    // !    ['mark','for boy','small','medium']) then
    // !   while aProd.FillOne do
    // !     //  here e.g. aProd.Categories.Dest are instantied (and Categories.Source=aProd)
    // !     writeln(aProd.Name,' ',aProd.Owner,' ',aProd.Categories.Dest.Name,' ',aProd.Sizes.Dest.Name);
    // !   //  you may also use aProd.FillTable to fill a grid, e.g.
    // !   //  (do not forget to set aProd.FillTable.OwnerMustFree := false)
    // this will execute a JOINed SELECT statement similar to the following:
    // $ select p.*, c.*, s.*
    // $ from Product p, Category c, Categories cc, Size s, Sizes ss
    // $ where c.id=cc.dest and cc.source=p.id and
    // $  s.id=ss.dest and ss.source=p.id and
    // $  p.Owner='mark' and c.Name='for boy' and (s.Name='small' or s.Name='medium')
    // - the FormatSQLWhere clause will replace all '%' chars with the supplied
    // ParamsSQLWhere[] supplied values, and bind all '?' chars as parameters
    // with BoundsSQLWhere[] values
    // - you SHALL call explicitely the FillClose method before using any
    // methods of nested TSQLRecordMany instances which may override the Dest
    // instance content (e.g. ManySelect) to avoid any GPF
    // - is used by TSQLRecord.CreateAndFillPrepareMany constructor
    function FillPrepareMany(aClient: TSQLRest; const aFormatSQLJoin: RawUTF8;
      const aParamsSQLJoin, aBoundsSQLJoin: array of const): boolean;
    /// compute a JOINed statement including TSQLRecordMany fields
    // - is called by FillPrepareMany() to retrieve the JSON of the corresponding
    // request: so you could use this method to retrieve directly the same
    // information, ready to be transmitted (e.g. as RawJSON) to a client
    function EnginePrepareMany(aClient: TSQLRest; const aFormatSQLJoin: RawUTF8;
      const aParamsSQLJoin, aBoundsSQLJoin: array of const;
      out ObjectsClass: TSQLRecordClassDynArray; out SQL: RawUTF8): RawUTF8;
    /// fill all published properties of an object from a TSQLTable prepared row
    // - FillPrepare() must have been called before
    // - if Dest is nil, this object values are filled
    // - if Dest is not nil, this object values will be filled, but it won't
    // work with TSQLRecordMany properties (i.e. after FillPrepareMany call)
    // - ID field is updated if first Field Name is 'ID'
    // - Row number is from 1 to Table.RowCount
    // - setter method (write Set*) is called if available
    // - handle UTF-8 SQL to Delphi values conversion (see TPropInfo mapping)
    // - this method has been made virtual e.g. so that a calculated value can be
    // used in a custom field
    function FillRow(aRow: integer; aDest: TSQLRecord=nil): boolean; virtual;
    /// fill all published properties of this object from the next available
    // TSQLTable prepared row
    // - FillPrepare() must have been called before
    // - the Row number is taken from property FillCurrentRow
    // - return true on success, false if no more Row data is available
    // - internally call FillRow() to update published properties values
    function FillOne(aDest: TSQLRecord=nil): boolean;
    /// go to the first prepared row, ready to loop through all rows with FillOne()
    // - the Row number (property FillCurrentRow) is reset to 1
    // - return true on success, false if no Row data is available
    // - you can use it e.g. as:
    // ! while Rec.FillOne do
    // !   dosomethingwith(Rec);
    // ! if Rec.FillRewind then
    // !   while Rec.FillOne do
    // !     dosomeotherthingwith(Rec);
    function FillRewind: boolean;
    /// close any previous FillPrepare..FillOne loop
    // - is called implicitely by FillPrepare() call to release any previous loop
    // - release the internal hidden TSQLTable instance if necessary
    // - is not mandatory if the TSQLRecord is released just after, since
    // TSQLRecord.Destroy will call it
    // - used e.g. by FillFrom methods below to avoid any GPF/memory confusion
    procedure FillClose;
    /// will iterate over all FillPrepare items, appending them as a JSON array
    // - creates a JSON array of all record rows, using
    // ! while FillOne do GetJSONValues(W)...
    procedure AppendFillAsJsonValues(W: TJSONSerializer);

    /// fill all published properties of this object from a TSQLTable result row
    // - call FillPrepare() then FillRow(Row)
    procedure FillFrom(Table: TSQLTable; Row: integer); overload;
    /// fill all published properties of this object from a JSON result row
    // - create a TSQLTable from the JSON data
    // - call FillPrepare() then FillRow(Row)
    procedure FillFrom(const JSONTable: RawUTF8; Row: integer); overload;
    /// fill all published properties of this object from a JSON object result
    // - use JSON data, as exported by GetJSONValues()
    // - JSON data may be expanded or not
    // - make an internal copy of the JSONTable RawUTF8 before calling
    // FillFrom() below
    // - if FieldBits is defined, it will store the identified field index
    procedure FillFrom(const JSONRecord: RawUTF8; FieldBits: PSQLFieldBits=nil); overload;
    /// fill all published properties of this object from a JSON result
    // - the data inside P^ is modified (unescaped and transformed): don't call
    // FillFrom(pointer(JSONRecordUTF8)) but FillFrom(JSONRecordUTF8) which makes
    // a temporary copy of the JSONRecordUTF8 text
    // - use JSON data, as exported by GetJSONValues()
    // - JSON data may be expanded or not
    // - if FieldBits is defined, it will store the identified field index
    procedure FillFrom(P: PUTF8Char; FieldBits: PSQLFieldBits=nil); overload;
    /// fill all published properties of this object from another object
    // - source object must be a parent or of the same class as the current record
    // - copy all COPIABLE_FIELDS, i.e. all fields excluding tftMany (because
    // those fields don't contain any data, but a TSQLRecordMany instance
    // which allow to access to the pivot table data)
    procedure FillFrom(aRecord: TSQLRecord); overload;
    /// fill the specified properties of this object from another object
    // - source object must be a parent or of the same class as the current record
    // - copy the fields, as specified by their bit index in the source record;
    // you may use aRecord.GetNonVoidFields if you want to update some fields
    procedure FillFrom(aRecord: TSQLRecord; const aRecordFieldBits: TSQLFieldBits); overload;
    {$ifndef NOVARIANTS}
    /// fill all published properties of this object from a supplied TDocVariant
    // object document
    // - is a wrapper around VariantSaveJSON() + FillFrom() methods
    procedure FillFrom(const aDocVariant: variant); overload;
    {$endif}
    /// fill a published property value of this object from a UTF-8 encoded value
    // - see TPropInfo about proper Delphi / UTF-8 type mapping/conversion
    // - use this method to fill a BLOB property, i.e. a property defined with
    // type TSQLRawBlob, since by default all BLOB properties are not
    // set by the standard Retrieve() method (to save bandwidth)
    // - if FieldBits is defined, it will store the identified field index
    procedure FillValue(PropName, Value: PUTF8Char; wasString: boolean;
      FieldBits: PSQLFieldBits=nil);

    /// return true if all published properties values in Other are identical to
    // the published properties of this object
    // - instances must be of the same class type
    // - only simple fields (i.e. not TSQLRawBlob/TSQLRecordMany) are compared
    // - comparison is much faster than SameValues() below
    function SameRecord(Reference: TSQLRecord): boolean;
    /// return true if all published properties values in Other are identical to
    // the published properties of this object
    // - work with different classes: Reference properties name must just be
    // present in the calling object
    // - only simple fields (i.e. not TSQLRawBlob/TSQLRecordMany) are compared
    // - compare the text representation of the values: fields may be of different
    // type, encoding or precision, but still have same values
    function SameValues(Reference: TSQLRecord): boolean;
    /// clear the values of all published properties, and also the ID property
    procedure ClearProperties; overload;
    /// clear the values of specified published properties
    // - '' will leave the content untouched, '*' will clear all simple fields
    procedure ClearProperties(const aFieldsCSV: RawUTF8); overload;
    /// set the simple fields with the supplied values
    // - the aSimpleFields parameters must follow explicitely the order of published
    // properties of the supplied aTable class, excepting the TSQLRawBlob and
    // TSQLRecordMany kind (i.e. only so called "simple fields") - in particular,
    // parent properties must appear first in the list
    // - the aSimpleFields must have exactly the same count of parameters as there are
    // "simple fields" in the published properties
    // - return true on success, but be aware that the field list must match
    // the field layout, otherwise if may return true but will corrupt data
    function SimplePropertiesFill(const aSimpleFields: array of const): boolean;
    /// initialize a TDynArray wrapper to map dynamic array property values
    // - if the field name is not existing or not a dynamic array, result.IsVoid
    // will be TRUE
    function DynArray(const DynArrayFieldName: RawUTF8): TDynArray; overload;
    /// initialize a TDynArray wrapper to map dynamic array property values
    // - this overloaded version expect the dynamic array to have been defined
    // with a not null index attribute, e.g.
    // ! published
    // !   property Ints: TIntegerDynArray index 1 read fInts write fInts;
    // !   property Currency: TCurrencyDynArray index 2 read fCurrency write fCurrency;
    // - if the field index is not existing or not a dynamic array, result.IsVoid
    // will be TRUE
    function DynArray(DynArrayFieldIndex: integer): TDynArray; overload;

    /// this property stores the record's integer ID
    // - if this TSQLRecord is not a instance, but a field value in a published
    //  property of type sftID (i.e. TSQLRecord(aID)), this method will try
    //  to retrieve it; but prefered method is to typecast it via PtrInt(aProperty),
    //  because GetID() relies on some low-level Windows memory mapping trick, and
    //  will recognize an ID value up to 1,048,576 (i.e. $100000)
    // - notice: the Setter should not be used usualy; you should not have to write
    //  aRecord.ID := someID in your code, since the ID is set during Retrieve or
    //  Add of the record
    // - use IDValue property for direct read/write access to the record's ID
    // field, if you know that this TSQLRecord is a true allocated class instance
    property ID: TID read GetID;
    /// this property gives direct access to the record's integer ID
    // - using IDValue expects this TSQLRecord to be a true instance, not a
    // transtyped sftID (i.e. TSQLRecord(aID))
    property IDValue: TID read fID write fID;
    /// this read-only property can be used to retrieve the ID as a TSQLRecord object
    // - published properties of type TSQLRecord (one-to-many relationship) do not
    // store real class instances (only exception is if they inherit from
    // TSQLRecordMany) - you can use this value to assign a TSQLRecord instance
    // to a published property, as such:
    // ! Main := TSQLRecordMain.Create;
    // ! Client.Add(Main);
    // ! Detail := TSQLRecordDetail.Create;
    // ! Detail.Main := Main.AsTSQLRecord; // will store Main.ID in MAIN column
    // ! Client.Add(Detail);
    // - is especially useful on 64-bit plaform, since on 32-bit:
    // ! Detail.Main := pointer(Main.ID)
    // compiles (whereas it won't on 64-bit) and is the same than platform-independent
    // ! Detail.Main := Main.AsTSQLRecord;
    // - using Main.AsTSQLRecord will ensure that the ID is retrieved, even
    // if Main itself is not a true instance
    // - if the stored ID is bigger than 32-bit, then it will raise an
    // EORMException: in this case, you should use a TID / T*ID kind of
    // published property, and not a TSQLRecord, which is limited to the
    // pointer size
    property AsTSQLRecord: pointer read GetIDAsPointer;
    /// this property is set to true, if any published property is a BLOB (TSQLRawBlob)
    property HasBlob: boolean read GetHasBlob;
    /// this property returns the published property count with any valid
    // database field except TSQLRawBlob/TSQLRecordMany
    // - by default, the TSQLRawBlob (BLOB) fields are not included into this set:
    // they must be read specificaly (in order to spare bandwidth)
    // - TSQLRecordMany fields are not accessible directly, but as instances
    // created by TSQLRecord.Create
    property SimpleFieldCount: integer read GetSimpleFieldCount;
    /// this property contains the TSQLTable after a call to FillPrepare()
    property FillTable: TSQLTable read GetTable;
    /// this property contains the current row number (beginning with 1),
    // initialized to 1 by FillPrepare(), which will be read by FillOne
    property FillCurrentRow: integer read GetFillCurrentRow;
    /// this property is set to true, if all rows have been browsed after
    // FillPrepare / while FillOne do ...
    property FillReachedEnd: boolean read GetFillReachedEnd;
    /// used internally by FillPrepare() and corresponding Fill*() methods
    property FillContext: TSQLRecordFill read fFill;
    /// this property contains the internal state counter of the server database
    // when the data was retrieved from it
    // - can be used to check if retrieved data may be out of date
    property InternalState: cardinal read fInternalState;
  published
    { published properties in inherited classes will be interpreted as SQL fields }
  end;

  PSQLRecord = ^TSQLRecord;
  TSQLRecordArray = array[0..MaxInt div SizeOf(TSQLRecord)-1] of TSQLRecord;
  PSQLRecordArray = ^TSQLRecordArray;

  /// root class for defining and mapping database records with case-insensitive
  // NOCASE collation
  // - abstract ancestor, from which you may inherit your own ORM classes
  // - by default, any sftUTF8Text field (RawUTF8, UnicodeString, WideString
  // properties) will use our Unicode SYSTEMNOCASE SQLite3 collation, which calls
  // UTF8ILComp() to handle most western languages, but is not standard
  // - you may inherit from this class to ensure any text field will use the
  // faster and SQLite3 built-in NOCASE collation, handling only 7-bit A-Z chars
  // - inherit from TSQLRecordNoCase or TSQLRecordCaseSensitive if you expect
  // your text fields to contain only basic (un)accentued ASCCI characters, and
  // to be opened by any standard/ SQlite3 library or tool (outside of
  // SynSQLite3.pas/SynDBExplorer)
  TSQLRecordNoCase = class(TSQLRecord)
  protected
    /// will call Props.SetCustomCollationForAll(sftUTF8Text,'NOCASE')
    class procedure InternalDefineModel(Props: TSQLRecordProperties); override;
  end;

  /// root class for defining and mapping database records with case-sensitive
  // BINARY collation
  // - abstract ancestor, from which you may inherit your own ORM classes
  // - by default, any sftUTF8Text field (RawUTF8, UnicodeString, WideString
  // properties) will use our Unicode SYSTEMNOCASE SQLite3 collation, which calls
  // UTF8ILComp() to handle most western languages, but is not standard
  // - you may inherit from this class to ensure any text field will use the
  // faster and SQLite3 built-in BINARY collation, which is case-sensitive
  // - inherit from TSQLRecordNoCase or TSQLRecordCaseSensitive if you expect
  // your text fields to contain only basic (un)accentued ASCCI characters, and
  // to be opened by any standard/ SQlite3 library or tool (outside of
  // SynSQLite3.pas/SynDBExplorer)
  TSQLRecordCaseSensitive = class(TSQLRecord)
  protected
    /// will call Props.SetCustomCollationForAll(sftUTF8Text,'BINARY')
    class procedure InternalDefineModel(Props: TSQLRecordProperties); override;
  end;

  /// database records with NOCASE collation and JSON_OPTIONS_FAST_EXTENDED variants
  // - abstract ancestor, from which you may inherit your own ORM classes
  TSQLRecordNoCaseExtended = class(TSQLRecordNoCase)
  protected
    /// will call Props.SetVariantFieldsDocVariantOptions(JSON_OPTIONS_FAST_EXTENDED);
    class procedure InternalDefineModel(Props: TSQLRecordProperties); override;
  end;

  /// database records with BINARY collation and JSON_OPTIONS_FAST_EXTENDED variants
  // - abstract ancestor, from which you may inherit your own ORM classes
  TSQLRecordCaseSensitiveExtended = class(TSQLRecordCaseSensitive)
  protected
    /// will call Props.SetVariantFieldsDocVariantOptions(JSON_OPTIONS_FAST_EXTENDED);
    class procedure InternalDefineModel(Props: TSQLRecordProperties); override;
  end;

  /// database records with NOCASE collation and JSON_OPTIONS_FAST_EXTENDED
  // variants, and itoNoIndex4TID option to avoid indexes on TID/T*ID properties
  // - abstract ancestor, from which you may inherit your own ORM classes
  TSQLRecordNoCaseExtendedNoID = class(TSQLRecordNoCaseExtended)
  public
    /// overriden method forcing no index creation on TID/T*ID properties
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
  end;

  /// allow on-the-fly translation of a TSQLTable grid value
  // - should return valid JSON value of the given cell (i.e. quoted strings,
  // or valid JSON object/array) unless HumanFriendly is defined
  // - e.g. TSQLTable.OnExportValue property will customize TSQLTable's
  // GetJSONValues, GetHtmlTable, and GetCSVValues methods returned content
  TOnSQLTableGetValue = function(Sender: TSQLTable; Row, Field: integer;
    HumanFriendly: boolean): RawJSON of object;

  /// store TSQLFieldType and RTTI for a given TSQLTable field
  TSQLTableFieldType = record
    /// the field kind, as in JSON (match TSQLPropInfo.SQLFieldTypeStored)
    ContentType: TSQLFieldType;
    /// how this field could be stored in a database
    // - equals ftUnknown if InitFields guessed the field type, or for sftVariant
    ContentDB: TSQLDBFieldType;
    /// the field size in bytes; -1 means not computed yet
    ContentSize: integer;
    /// used for sftEnumerate, sftSet and sftBlobDynArray fields
    ContentTypeInfo: pointer;
    /// the corresponding index in fQueryTables[]
    TableIndex: integer;
  end;
  PSQLTableFieldType = ^TSQLTableFieldType;

  /// wrapper to an ORM result table, staticaly stored as UTF-8 text
  // - contain all result in memory, until destroyed
  // - first row contains the field names
  // - following rows contains the data itself
  // - GetString() can be used in a TDrawString
  // - will be implemented as TSQLTableJSON for remote access through optimized
  // JSON content
  TSQLTable = class
  protected
    fRowCount: integer;
    fFieldCount: integer;
    /// contains the data, as returned by sqlite3_get_table()
    fResults: PPUTF8CharArray;
    fFieldType: array of TSQLTableFieldType;
    fFieldTypeAllRows: boolean;
    /// the field names
    fFieldNames: TRawUTF8DynArray;
    /// used by FieldIndex() for fast O(log(n)) binary search
    fFieldNameOrder: TCardinalDynArray;
    /// contain the fResults[] pointers, after a IDColumnHide() call
    fIDColumn, fNotIDColumn: TPUTF8CharDynArray;
    /// index of a 'ID' field, -1 if none (e.g. after IDColumnHide method call)
    fFieldIndexID: integer;
    /// the internal state counter of the database when the data was retrieved
    fInternalState: cardinal;
    /// contains the parameters used for sorting
    fSortParams: TSQLTableSortParams;
    /// contains the TSQLRecord instances created by NewRecord method
    fOwnedRecords: TSynObjectList;
    /// if the TSQLRecord is the owner of this table, i.e. if it must free it
    fOwnerMustFree: Boolean;
    /// current cursor row (1..RowCount), as set by the Step() method
    fStepRow: integer;
    /// information about the Query sourcing this result set
    fQueryTables: TSQLRecordClassDynArray;
    fQueryColumnTypes: array of TSQLFieldType;
    fQuerySQL: RawUTF8;
    fQueryTableNameFromSQL: RawUTF8;
    fQueryTableIndexFromSQL: integer; // -2=nosearch -1=notfound fQueryTables[0..n]
    /// field length information
    fFieldLengthMean: TIntegerDynArray;
    fFieldLengthMeanSum: integer;
    /// column bit set at parsing to mark a string value (e.g. "..." in JSON)
    fFieldParsedAsString: set of 0..255;
    fOnExportValue: TOnSQLTableGetValue;
    /// avoid GPF when TSQLTable is nil
    function GetRowCount: integer; {$ifdef HASINLINE}inline;{$endif}
    /// fill the fFieldType[] array (from fQueryTables[] or fResults[] content)
    procedure InitFieldTypes;
    /// fill the internal fFieldNames[] array
    procedure InitFieldNames;
    /// guess the property type information from ORM
    function FieldPropFromTables(const PropName: RawUTF8;
      out PropInfo: TSQLPropInfo; out TableIndex: integer): TSQLFieldType;
    function GetQueryTableNameFromSQL: RawUTF8;
  public
    /// initialize the result table
    // - you can optionaly associate the corresponding TSQLRecordClass types,
    // by which the results were computed (it will use RTTI for column typing)
    constructor Create(const aSQL: RawUTF8);
    /// initialize the result table
    // - you can associate the corresponding TSQLRecordClass types,
    // by which the results were computed (it will use RTTI for column typing)
    constructor CreateFromTables(const Tables: array of TSQLRecordClass; const aSQL: RawUTF8);
    /// initialize the result table
    // - you can set the expected column types matching the results column layout
    constructor CreateWithColumnTypes(const ColumnTypes: array of TSQLFieldType; const aSQL: RawUTF8);
    /// free associated memory and owned records
    destructor Destroy; override;
    /// read-only access to a particular field value, as UTF-8 encoded buffer
    // - if Row and Fields are correct, returns a pointer to the UTF-8 buffer,
    // or nil if the corresponding JSON was null or ""
    // - if Row and Fields are not correct, returns nil
    function Get(Row,Field: integer): PUTF8Char; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as RawUTF8 text
    function GetU(Row,Field: integer): RawUTF8; overload;
    /// read-only access to a particular field value, as UTF-8 encoded buffer
    // - points to memory buffer allocated by Init()
    function Get(Row: integer; const FieldName: RawUTF8): PUTF8Char; overload;
    /// read-only access to a particular field value, as RawUTF8 text
    function GetU(Row: integer; const FieldName: RawUTF8): RawUTF8; overload;
    /// read-only access to a particular field value, as Win Ansi text
    function GetA(Row,Field: integer): WinAnsiString;
    /// read-only access to a particular field value, as Win Ansi text shortstring
    function GetS(Row,Field: integer): shortstring;
    {$ifndef NOVARIANTS}
    /// read-only access to a particular field value, as a Variant
    // - text will be stored as RawUTF8 (as varString type)
    // - will try to use the most approriate Variant type for conversion (will
    // use e.g. TDateTime for sftDateTime, or a TDocVariant for JSON objects
    // in a sftVariant column) - so you should better set the exact field types
    // (e.g. from ORM) before calling this method
    function GetVariant(Row,Field: integer): variant; overload;
    /// read-only access to a particular field value, as a Variant
    // - text will be stored as RawUTF8 (as varString type)
    // - will try to use the most approriate Variant type for conversion (will
    // use e.g. TDateTime for sftDateTime, or a TDocVariant for JSON objects
    // in a sftVariant column) - so you should better set the exact field types
    // (e.g. from ORM) before calling this method
    procedure GetVariant(Row,Field: integer; var result: variant); overload;
    /// read-only access to a particular field, via a lookup field name
    // - will call GetVariant() on the corresponding field
    // - returns null if the lookup did not have any match
    function GetValue(const aLookupFieldName,aLookupValue,aValueFieldName: RawUTF8): variant;
    {$endif}
    /// read-only access to a particular field value, as VCL string text
    // - the global UTF8ToString() function will be used for the conversion:
    // for proper i18n handling before Delphi 2009, you should use the
    // overloaded method with aUTF8ToString=Language.UTF8ToString
    function GetString(Row,Field: integer): string;
    /// read-only access to a particular field value, as fast Unicode string text
    // - SynUnicode is either WideString, either UnicodeString, depending on the
    // Delphi compiler revision, to ensure fastest native Unicode process available
    function GetSynUnicode(Row,Field: integer): SynUnicode;
    /// fill a unicode buffer with a particular field value
    // - return number of wide characters written in Dest^
    function GetWP(Row,Field: integer; Dest: PWideChar; MaxDestChars: cardinal): integer;
    /// read-only access to a particular field value, as UTF-16 Unicode text
    // - Raw Unicode is WideChar(zero) terminated
    // - its content is allocated to contain all WideChars (not trimed to 255,
    // like GetWP() above
    function GetW(Row,Field: integer): RawUnicode;
    /// read-only access to a particular field value, as integer value
    function GetAsInteger(Row,Field: integer): integer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as integer value
    function GetAsInteger(Row: integer; const FieldName: RawUTF8): integer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as Int64 value
    function GetAsInt64(Row,Field: integer): Int64; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as Int64 value
    function GetAsInt64(Row: integer; const FieldName: RawUTF8): Int64; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as extended value
    function GetAsFloat(Row,Field: integer): TSynExtended; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as extended value
    function GetAsFloat(Row: integer; const FieldName: RawUTF8): TSynExtended; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as TDateTime value
    // - sftDateTime/sftDateTimeMS will be converted from ISO-8601 text
    // - sftTimeLog, sftModTime, sftCreateTime will expect the content to be
    // encoded as a TTimeLog Int64 value - as sftInteger may have been
    // identified by TSQLTable.InitFieldTypes
    // - sftUnixTime/sftUnixMSTime field will call UnixTimeToDateTime/UnixMSTimeToDateTime
    // - for sftTimeLog, sftModTime, sftCreateTime or sftUnixTime fields, you
    // may have to force the column type, since it may be identified as sftInteger
    // or sftCurrency by default from its JSON number content, e.g. via:
    // ! aTable.SetFieldType('FieldName',sftModTime);
    // - sftCurrency,sftFloat will return the corresponding double value
    // - any other types will try to convert ISO-8601 text }
    function GetAsDateTime(Row,Field: integer): TDateTime; overload;
    /// read-only access to a particular field value, as TDateTime value
    function GetAsDateTime(Row: integer; const FieldName: RawUTF8): TDateTime; overload;
    /// read-only access to a particular field value, as currency value
    function GetAsCurrency(Row,Field: integer): currency; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as currency value
    function GetAsCurrency(Row: integer; const FieldName: RawUTF8): currency; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, ready to be displayed
    // - mostly used with Row=0, i.e. to get a display value from a field name
    // - use "string" type, i.e. UnicodeString for Delphi 2009+
    // - value is first un-camel-cased: 'OnLine' value will return 'On line' e.g.
    // - then System.LoadResStringTranslate() is called if available
    function GetCaption(Row,Field: integer): string;
    /// read-only access to a particular Blob value
    // - a new TSQLRawBlob is created
    // - Blob data is converted from SQLite3 BLOB literals (X'53514C697465' e.g.)
    // or Base-64 encoded content ('\uFFF0base64encodedbinary')
    // - prefered manner is to directly use REST protocol to retrieve a blob field
    function GetBlob(Row,Field: integer): TSQLRawBlob;
    /// read-only access to a particular Blob value
    // - a new TBytes is created
    // - Blob data is converted from SQLite3 BLOB literals (X'53514C697465' e.g.)
    //   or Base-64 encoded content ('\uFFF0base64encodedbinary')
    // - prefered manner is to directly use REST protocol to retrieve a blob field
    function GetBytes(Row,Field: integer): TBytes;
    /// read-only access to a particular Blob value
    // - a new TCustomMemoryStream is created - caller shall free its instance
    // - Blob data is converted from SQLite3 BLOB literals (X'53514C697465' e.g.)
    //   or Base-64 encoded content ('\uFFF0base64encodedbinary')
    // - prefered manner is to directly use REST protocol to retrieve a blob field
    function GetStream(Row,Field: integer): TStream;
    /// read-only access to a particular field value, as VCL text
    // - Client is one TSQLClient instance (used to display TRecordReference via
    // the associated TSQLModel)
    // - returns the Field Type
    // - return generic string Text, i.e. UnicodeString for Delphi 2009+, ready
    // to be displayed to the VCL, for sftEnumerate, sftTimeLog,
    // sftUnixTime/sftUnixMSTime and sftRecord/sftRecordVersion/sftID/sftTID
    // - returns '' as string Text, if text can by displayed directly
    // with Get*() methods above
    // - returns '' for other properties kind, if UTF8ToString is nil,
    // or the ready to be displayed value if UTF8ToString event is set
    // (to be used mostly with Language.UTF8ToString)
    // - CustomFormat can optionaly set a custom format string, e.g. '%f' or '%n'
    // or complex FormatFloat()/FormatCurr() syntax (as '#,##0.00') for sftFloat
    // and sftCurrency columns (instead of plain JSON float value), or
    // date/time format as expected by FormatDateTime() for all date time kind
    // of fields (as sftDateTime, sftDateTimeMS, sftTimeLog, sftModTime,
    // sftCreateTime, sftUnixTime, sftUnixMSTime)
    function ExpandAsString(Row,Field: integer; Client: TObject; out Text: string;
      const CustomFormat: string=''): TSQLFieldType;
    /// read-only access to a particular field value, as VCL text
    // - this method is just a wrapper around ExpandAsString method, returning
    // the content as a SynUnicode string type (i.e. UnicodeString since Delphi
    // 2009, and WideString for non Unicode versions of Delphi)
    // - it is used by the reporting layers of the framework (e.g. TSQLRibbon.AddToReport)
    function ExpandAsSynUnicode(Row,Field: integer; Client: TObject; out Text: SynUnicode): TSQLFieldType;
    /// read-only access to a particular DateTime field value
    // - expect SQLite3 TEXT field in ISO 8601 'YYYYMMDD hhmmss' or
    // 'YYYY-MM-DD hh:mm:ss' format
    function GetDateTime(Row,Field: integer): TDateTime;
    /// read-only access to a particular TTimeLog field value
    // - return the result as TTimeLogBits.Text() Iso-8601 encoded text
    function GetTimeLog(Row,Field: integer; Expanded: boolean; FirstTimeChar: AnsiChar = 'T'): RawUTF8;
    /// widechar length (UTF-8 decoded as UTF-16) of a particular field value
    // - could be used with VCL's UnicodeString, or for Windows API
    function LengthW(Row,Field: integer): integer;
    /// get all values for a specified field into a dynamic RawUTF8 array
    // - don't perform any conversion, but just create an array of raw PUTF8Char data
    // - returns the number of rows in Values[]
    function GetRowValues(Field: integer; out Values: TRawUTF8DynArray): integer; overload;
    /// get all values for a specified field into a dynamic Integer array
    // - returns the number of rows in Values[]
    function GetRowValues(Field: integer; out Values: TInt64DynArray): integer; overload;
    /// get all values for a specified field as CSV
    // - don't perform any conversion, but create a CSV from raw PUTF8Char data
    function GetRowValues(Field: integer; const Sep: RawUTF8=',';
      const Head: RawUTF8=''; const Trail: RawUTF8=''): RawUTF8; overload;
    /// get all values lengths for a specified field into a PIntegerArray
    // - returns the total length as result, and fill LenStore with all rows
    // individual lengths using StrLen() - caller should eventually call
    // LenStore.Done to release any temp memory
    // - returns 0 if Field is invalid or no data is stored in this TSQLTable -
    // don't call LenStore.Done in this case
    function GetRowLengths(Field: integer; var LenStore: TSynTempBuffer): integer;
    {$ifndef NOVARIANTS}
    /// retrieve a field value in a variant
    // - returns null if the row/field is incorrect
    // - expand* methods will allow to return human-friendly representations
    procedure GetAsVariant(row,field: integer; out value: variant;
      expandTimeLogAsText,expandEnumsAsText,expandHugeIDAsUniqueIdentifier: boolean;
      options: TDocVariantOptions=JSON_OPTIONS_FAST);
    /// retrieve a row value as a variant, ready to be accessed via late-binding
    // - Row parameter numbering starts from 1 to RowCount
    // - this method will return a TDocVariant containing a copy of all
    // field values of this row, uncoupled to the TSQLTable instance life time
    // - expand* methods will allow to return human-friendly representations
    procedure ToDocVariant(Row: integer; out doc: variant;
      options: TDocVariantOptions=JSON_OPTIONS_FAST;
      expandTimeLogAsText: boolean=false; expandEnumsAsText: boolean=false;
      expandHugeIDAsUniqueIdentifier: boolean=false); overload;
    /// retrieve all row values as a dynamic array of variants, ready to be
    // accessed via late-binding
    // - if readonly is TRUE, will contain an array of TSQLTableRowVariant, which
    // will point directly to the TSQLTable, which should remain allocated
    // - if readonly is FALSE, will contain an array of TDocVariant, containing
    // a copy of all field values of this row, uncoupled to the TSQLTable instance
    // - readonly=TRUE is faster to allocate (around 4 times for 10,000 rows), but
    // may be slightly slower to access than readonly=FALSE, if all values are
    // likely be accessed later in the process
    procedure ToDocVariant(out docs: TVariantDynArray; readonly: boolean); overload;
    /// retrieve all row values as a TDocVariant of kind dvArray, ready to be
    // accessed via late-binding
    // - if readonly is TRUE, will contain an array of TSQLTableRowVariant, which
    // will point directly to the TSQLTable, which should remain allocated
    // - if readonly is FALSE, will contain an array of TDocVariant, containing
    // a copy of all field values of this row, uncoupled to the TSQLTable instance
    // - readonly=TRUE is faster to allocate (around 4 times for 10,000 rows), but
    // may be slightly slower to access than readonly=FALSE, if all values are
    // likely be accessed later in the process
    procedure ToDocVariant(out docarray: variant; readonly: boolean); overload;
      // {$ifdef HASINLINE}inline;{$endif} won't reset docarray as required
    {$endif NOVARIANTS}

    /// save the table values in JSON format
    // - JSON data is added to TJSONWriter, with UTF-8 encoding, and not flushed
    // - if Expand is true, JSON data is an array of objects, for direct use
    // with any Ajax or .NET client:
    // & [ {"col1":val11,"col2":"val12"},{"col1":val21,... ]
    // - if W.Expand is false, JSON data is serialized (used in TSQLTableJSON)
    // & { "fieldCount":1,"values":["col1","col2",val11,"val12",val21,..] }
    // - RowFirst and RowLast can be used to ask for a specified row extent
    // of the returned data (by default, all rows are retrieved)
    // - IDBinarySize will force the ID field to be stored as hexadecimal text
    procedure GetJSONValues(W: TJSONWriter; RowFirst: integer=0;
      RowLast: integer=0; IDBinarySize: integer=0); overload;
    /// same as the overloaded method, but appending an array to a TStream
    procedure GetJSONValues(JSON: TStream; Expand: boolean;
      RowFirst: integer=0; RowLast: integer=0; IDBinarySize: integer=0); overload;
    /// same as the overloaded method, but returning result into a RawUTF8
    function GetJSONValues(Expand: boolean; IDBinarySize: integer=0;
      BufferSize: integer=0): RawUTF8; overload;
    /// save the table as CSV format, into a stream
    // - if Tab=TRUE, will use TAB instead of ',' between columns
    // - you can customize the ',' separator - use e.g. the global ListSeparator
    // variable (from SysUtils) to reflect the current system definition (some
    // country use ',' as decimal separator, for instance our "douce France")
    // - AddBOM will add a UTF-8 Byte Order Mark at the beginning of the content
    procedure GetCSVValues(Dest: TStream; Tab: boolean; CommaSep: AnsiChar=',';
      AddBOM: boolean=false; RowFirst: integer=0; RowLast: integer=0); overload;
    /// save the table as CSV format, into a string variable
    // - if Tab=TRUE, will use TAB instead of ',' between columns
    // - you can customize the ',' separator - use e.g. the global ListSeparator
    // variable (from SysUtils) to reflect the current system definition (some
    // country use ',' as decimal separator, for instance our "douce France")
    // - AddBOM will add a UTF-8 Byte Order Mark at the beginning of the content
    function GetCSVValues(Tab: boolean; CommaSep: AnsiChar=',';
      AddBOM: boolean=false; RowFirst: integer=0; RowLast: integer=0): RawUTF8; overload;
    /// save the table in 'schemas-microsoft-com:rowset' XML format
    // - this format is used by ADODB.recordset, easily consumed by MS apps
    // - see @https://synopse.info/forum/viewtopic.php?pid=11691#p11691
    procedure GetMSRowSetValues(Dest: TStream; RowFirst,RowLast: integer); overload;
    /// save the table in 'schemas-microsoft-com:rowset' XML format
    // - this format is used by ADODB.recordset, easily consumed by MS apps
    // - see @https://synopse.info/forum/viewtopic.php?pid=11691#p11691
    function GetMSRowSetValues: RawUTF8; overload;
    /// save the table in Open Document Spreadsheet compressed format
    // - this is a set of XML files compressed in a zip container
    // - this method will return the raw binary buffer of the file
    // - see @https://synopse.info/forum/viewtopic.php?id=2133
    function GetODSDocument(withColumnTypes: boolean=false): RawByteString;
    /// append the table content as a HTML <table> ... </table>
    procedure GetHtmlTable(Dest: TTextWriter); overload;
    /// save the table as a <html><body><table> </table></body></html> content
    function GetHtmlTable(const Header: RawUTF8='<head><style>table,th,td'+
      '{border: 1px solid black;border-collapse: collapse;}th,td{padding: 5px;'+
      'font-family: sans-serif;}</style></head>'#10): RawUTF8; overload;
    /// get the Field index of a FieldName
    // - return -1 if not found, index (0..FieldCount-1) if found
    function FieldIndex(FieldName: PUTF8Char): integer; overload;
    /// get the Field index of a FieldName
    // - return -1 if not found, index (0..FieldCount-1) if found
    function FieldIndex(const FieldName: RawUTF8): integer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// get the Field index of a FieldName
    // - raise an ESQLTableException if not found, index (0..FieldCount-1) if found
    function FieldIndexExisting(const FieldName: RawUTF8): integer; overload;
    /// get the Field indexes of several Field names
    // - could be used to speed-up field access in a TSQLTable loop, avoiding
    // a FieldIndex(aFieldName) lookup for each value
    // - returns the number of matching Field names
    // - set -1 in FieldIndexes[]^ if not found, index (0..FieldCount-1) if found
    function FieldIndex(const FieldNames: array of RawUTF8;
      const FieldIndexes: array of PInteger): integer; overload;
    /// get the Field indexes of several Field names
    // - raise an ESQLTableException if not found
    // - set FieldIndexes[]^ to the index (0..FieldCount-1) if found
    // - could be used to speed-up field access in a TSQLTable loop, avoiding
    // a FieldIndex(aFieldName) lookup for each value, as such:
    //! list := TSQLTableJSON.Create('',pointer(json),length(json));
    //! list.FieldIndexExisting(
    //!   ['FirstName','LastName','YearOfBirth','YearOfDeath','RowID','Data'],
    //!   [@FirstName,@LastName,@YearOfBirth,@YearOfDeath,@RowID,@Data]);
    //! for i := 1 to list.RowCount do begin
    //!   Check(list.Get(i,FirstName)<>nil);
    //!   Check(list.Get(i,LastName)<>nil);
    //!   Check(list.GetAsInteger(i,YearOfBirth)<10000);
    procedure FieldIndexExisting(const FieldNames: array of RawUTF8;
      const FieldIndexes: array of PInteger); overload;
    /// retrieve all field names as a RawUTF8 dynamic array
    function FieldNames: TRawUTF8DynArray;
    /// get the Field content (encoded as UTF-8 text) from a property name
    // - return nil if not found
    function FieldValue(const FieldName: RawUTF8; Row: integer): PUTF8Char;
      {$ifdef HASINLINE}inline;{$endif}
    /// sort result Rows, according to a specific field
    // - default is sorting by ascending order (Asc=true)
    // - you can specify a Row index to be updated during the sort in PCurrentRow
    // - sort is very fast, even for huge tables (more faster than any indexed
    // SQL query): 500,000 rows are sorted instantly
    // - this optimized sort implementation does the comparison first by the
    // designed field, and, if the field value is identical, the ID value is
    // used (it will therefore sort by time all identical values)
    procedure SortFields(Field: integer; Asc: boolean=true;
      PCurrentRow: PInteger=nil; FieldType: TSQLFieldType=sftUnknown;
      CustomCompare: TUTF8Compare=nil); overload;
    /// sort result Rows, according to a specific field
    // - overloaded method allowing to specify the field by its name
    procedure SortFields(const FieldName: RawUTF8; Asc: boolean=true;
      PCurrentRow: PInteger=nil; FieldType: TSQLFieldType=sftUnknown;
      CustomCompare: TUTF8Compare=nil); overload;
    /// sort result Rows, according to some specific fields
    // - is able to make multi-field sort
    // - both Fields[] and Asc[] arrays should have the same count, otherwise
    // default Asc[]=true value will be assumed
    // - set any Fields[]=-1 to identify the ID column (even if is hidden)
    // - if CustomCompare=[], which use the default comparison function for the
    // field type, unless you set as many custom comparison function items
    // as in the Fields[] and Asc[] parameters
    procedure SortFields(const Fields: array of integer;
      const Asc: array of boolean; const CustomCompare: array of TUTF8Compare); overload;
    /// sort result Rows, according to the Bits set to 1 first
    procedure SortBitsFirst(var Bits);
    /// guess the field type from first non null data row
    // - if QueryTables[] are set, exact field type and enumerate TypeInfo() is
    // retrieved from the Delphi RTTI; otherwise, get from the cells content
    // - return sftUnknown is all data fields are null
    // - sftBlob is returned if the field is encoded as SQLite3 BLOB literals
    // (X'53514C697465' e.g.)
    // - since TSQLTable data is PUTF8Char, string type is sftUTF8Text only
    function FieldType(Field: integer): TSQLFieldType; overload;
    /// guess the field type from first non null data row
    // - if QueryTables[] are set, exact field type and (enumerate) TypeInfo() is
    // retrieved from the Delphi RTTI; otherwise, get from the cells content
    // - return sftUnknown is all data fields are null
    // - sftBlob is returned if the field is encoded as SQLite3 BLOB literals
    // (X'53514C697465' e.g.)
    // - since TSQLTable data is PUTF8Char, string type is sftUTF8Text only
    function FieldType(Field: integer; out FieldTypeInfo: PSQLTableFieldType): TSQLFieldType; overload;
    /// get the appropriate Sort comparison function for a field,
    // nil if not available (bad field index or field is blob)
    // - field type is guessed from first data row
    function SortCompare(Field: integer): TUTF8Compare;
    /// get the mean of characters length of all fields
    // - the character length is for the first line of text only (stop counting
    // at every newline character, i.e. #10 or #13 char)
    // - return the sum of all mean of character lengths
    function CalculateFieldLengthMean(var aResult: TIntegerDynArray;
      FromDisplay: boolean=false): integer;
    /// get the mean of characters length of this field
    // - the character length is for the first line of text only (stop counting
    // at every newline character, i.e. #10 or #13 char)
    // - very fast: calculated only once for all fields
    function FieldLengthMean(Field: integer): cardinal;
    /// get the sum of all mean of characters length of all fields
    // - very fast: calculated only once for all fields
    function FieldLengthMeanSum: cardinal;
    /// get the maximum number of characters of this field
    function FieldLengthMax(Field: integer; NeverReturnsZero: boolean=false): cardinal;
    /// get the record class (i.e. the table) associated to a field
    // - is nil if this table has no QueryTables property
    // - very fast: calculated only once for all fields
    function FieldTable(Field: integer): TSQLRecordClass;
    /// force the mean of characters length for every field
    // - expect as many parameters as fields in this table
    // - override internal fFieldLengthMean[] and fFieldLengthMeanSum values
    procedure SetFieldLengthMean(const Lengths: array of cardinal);
    /// set the exact type of a given field
    // - by default, column types and sizes will be retrieved from JSON content
    // from first row, or all rows if FieldTypeIntegerDetectionOnAllRows is set
    // - you can define a specific type for a given column, and optionally
    // a maximum column size
    // - FieldTypeInfo can be specified for sets or enumerations, as such:
    // ! aTable.SetFieldType(0,sftEnumerate,TypeInfo(TEnumSample));
    // ! aTable.SetFieldType(1,sftSet,TypeInfo(TSetSamples));
    // or for dynamic arrays
    procedure SetFieldType(Field: integer; FieldType: TSQLFieldType;
      FieldTypeInfo: pointer=nil; FieldSize: integer=-1;
      FieldTableIndex: integer=-1); overload;
    /// set the exact type of a given field
    // - by default, column types and sizes will be retrieved from JSON content
    // from first row, or all rows if FieldTypeIntegerDetectionOnAllRows is set
    // - you can define a specific type for a given column, and optionally
    // a maximum column size
    // - FieldTypeInfo can be specified for sets or enumerations, as such:
    // ! aTable.SetFieldType('Sample',sftEnumerate,TypeInfo(TEnumSample));
    // ! aTable.SetFieldType('Samples',sftSet,TypeInfo(TSetSamples));
    procedure SetFieldType(const FieldName: RawUTF8; FieldType: TSQLFieldType;
      FieldTypeInfo: pointer=nil; FieldSize: integer=-1); overload;
    /// set the exact type of all fields, from the DB-like information
    procedure SetFieldTypes(const DBTypes: TSQLDBFieldTypeDynArray);
    /// increase a particular Field Length Mean value
    // - to be used to customize the field appareance (e.g. for adding of left
    // checkbox for Marked[] fields)
    procedure FieldLengthMeanIncrease(aField, aIncrease: integer);

    /// copy the parameters of a TSQLTable into this instance
    // - the fResults remain in the source TSQLTable: source TSQLTable has not to
    // be destroyed before this TSQLTable
    procedure Assign(source: TSQLTable);

    /// search a text value inside the table data in a specified field
    // - the text value must already be uppercased 7-bits ANSI encoded
    // - return the Row on success, 0 on error
    // - search only in the content of FieldIndex data
    // - you can specify a Soundex pronunciation to use, or leave as sndxNone for
    // standard case insensitive character match; aUpperValue can optional
    // indicate a Soundex search, by predeceding the searched text with % for
    // English, %% for French or %%% for Spanish (only works with WinAnsi
    // char set - i.e. code page 1252)
    // - if UnicodeComparison is set to TRUE, search will use low-level Windows
    // API for Unicode-level conversion - it will be much slower, but accurate
    // for the whole range of UTF-8 encoding
    // - if UnicodeComparison is left to FALSE, UTF-8 decoding will be done only
    // if necessary: it will work only with standard western-occidental alphabet
    // (i.e. WinAnsi - code page 1252), but it will be very fast
    function SearchValue(const UpperValue: RawUTF8; StartRow, FieldIndex: integer;
      Client: TObject; Lang: TSynSoundExPronunciation=sndxNone;
      UnicodeComparison: boolean=false): integer; overload;
    /// search a text value inside the table data in all fields
    // - the text value must already be uppercased 7-bits ANSI encoded
    // - return the Row on success, 0 on error
    // - search on all fields, returning field found in FieldIndex (if not nil)
    // - you can specify a Soundex pronunciation to use, or leave as sndxNone for
    // standard case insensitive character match; aUpperValue can optional
    // indicate a Soundex search, by predeceding the searched text with % for
    // English, %% for French or %%% for Spanish (only works with WinAnsi
    // char set - i.e. code page 1252)
    // - if UnicodeComparison is set to TRUE, search will use low-level Windows
    // API for Unicode-level conversion - it will be much slower, but accurate
    // for the whole range of UTF-8 encoding
    // - if UnicodeComparison is left to FALSE, UTF-8 decoding will be done only
    // if necessary: it will work only with standard western-occidental alphabet
    // (i.e. WinAnsi - code page 1252), but it will be very fast
    function SearchValue(const UpperValue: RawUTF8; StartRow: integer;
      FieldIndex: PInteger; Client: TObject; Lang: TSynSoundExPronunciation=sndxNone;
      UnicodeComparison: boolean=false): integer; overload;
    /// search for a value inside the raw table data, using UTF8IComp/StrComp()
    // - returns 0 if not found, or the matching Row number otherwise
    function SearchFieldEquals(const Value: RawUTF8; FieldIndex: integer;
      StartRow: integer=1; CaseSensitive: boolean=false): integer; overload;
    /// search for a value inside the raw table data, using UTF8IComp/StrComp()
    // - returns 0 if not found, or the matching Row number otherwise
    function SearchFieldEquals(Value: PUTF8Char; FieldIndex: integer;
      StartRow: integer=1; CaseSensitive: boolean=false): integer; overload;
    /// search for a value inside the raw table data, using IdemPChar()
    // - returns 0 if not found, or the matching Row number otherwise
    function SearchFieldIdemPChar(const Value: RawUTF8; FieldIndex: integer;
      StartRow: integer=1): integer;
    /// search for a value using O(log(n)) binary search of a sorted field
    // - here the content should have been previously sorted via Sort(),
    // or CustomCompare should be defined, otherwise the SearchFieldEquals()
    // slower O(n) method is called
    // - returns 0 if not found, or the matching Row number otherwise
    function SearchFieldSorted(const Value: RawUTF8; FieldIndex: integer;
      CustomCompare: TUTF8Compare=nil): integer; overload;
    /// search for a value using O(log(n)) binary search of a sorted field
    // - here the content should have been previously sorted via Sort(),
    // or CustomCompare should be defined, otherwise the SearchFieldEquals()
    // slower O(n) method is called
    // - returns 0 if not found, or the matching Row number otherwise
    function SearchFieldSorted(Value: PUTF8Char; FieldIndex: integer;
      CustomCompare: TUTF8Compare=nil): integer; overload;

    /// if the ID column is available, hides it from fResults[]
    // - useful for simplier UI, with a hidden ID field
    // - use IDColumnHiddenValue() to get the ID of a specific row
    // - return true is ID was succesfully hidden, false if not possible
    function IDColumnHide: boolean;
    /// return the (previously hidden) ID value, 0 on error
    function IDColumnHiddenValue(Row: integer): TID;
    /// return all (previously hidden) ID values
    procedure IDColumnHiddenValues(var IDs: TIDDynArray);
    /// get all IDs where individual bit in Bits are set
    procedure IDArrayFromBits(const Bits; var IDs: TIDDynArray);
    /// get all individual bit in Bits corresponding to the supplied IDs
    // - warning: IDs integer array will be sorted within this method call
    procedure IDArrayToBits(var Bits; var IDs: TIDDynArray);
    /// get the Row index corresponding to a specified ID
    // - return the Row number, from 1 to RowCount
    // - return RowCount (last row index) if this ID was not found or no
    // ID field is available, unless aNotFoundMinusOne is set, and then -1 is
    // returned
    function RowFromID(aID: TID; aNotFoundMinusOne: boolean=false): integer;

    /// delete the specified data Row from the Table
    // - only overwrite the internal fResults[] pointers, don't free any memory,
    // nor modify the internal DataSet
    function DeleteRow(Row: integer): boolean;
    /// delete the specified Column text from the Table
    // - don't delete the Column: only delete UTF-8 text in all rows for this field
    function DeleteColumnValues(Field: integer): boolean;

    /// retrieve QueryTables[0], if existing
    function QueryRecordType: TSQLRecordClass;

    /// create a new TSQLRecord instance for a specific Table
    // - a void TSQLRecord instance is created, ready to be filled
    // - use the specified TSQLRecord class or create one instance
    // of the first associated record class (from internal QueryTables[])
    // - the returned records will be managed by this TSQLTable: they will be
    // freed when the TSQLTable is destroyed: you don't need to make a
    // try..finally..Free..end block with them
    function NewRecord(RecordType: TSQLRecordClass=nil): TSQLRecord;
    /// create a TObjectList with TSQLRecord instances corresponding to this
    // TSQLTable result set
    // - use the specified TSQLRecord class or create instances
    // of the first associated record class (from internal QueryTables[])
    // - always returns an instance, even if the TSQLTable is nil or void
    function ToObjectList(RecordType: TSQLRecordClass=nil): TObjectList; overload;
    /// fill an existing TObjectList with TSQLRecord instances corresponding
    // to this TSQLTable result set
    // - use the specified TSQLRecord class or create instances
    // of the first associated record class (from internal QueryTables[])
    procedure ToObjectList(DestList: TObjectList; RecordType: TSQLRecordClass=nil); overload;
    {$ifdef ISDELPHI2010} // Delphi 2009/2010 generics are buggy
    /// create a TObjectList<TSQLRecord> with TSQLRecord instances corresponding
    // to this TSQLTable result set
    // - use the specified TSQLRecord class or create instances
    // of the first associated record class (from internal QueryTables[])
    // - always returns an instance, even if the TSQLTable is nil or void
    function ToObjectList<T: TSQLRecord>: TObjectList<T>; overload;
    {$endif}
    /// fill an existing T*ObjArray variable with TSQLRecord instances
    // corresponding to this TSQLTable result set
    // - use the specified TSQLRecord class or create instances
    // of the first associated record class (from internal QueryTables[])
    // - returns TRUE on success (even if ObjArray=[]), FALSE on error
    function ToObjArray(var ObjArray; RecordType: TSQLRecordClass=nil): boolean;

    /// after a TSQLTable has been initialized, this method can be called
    // one or more times to iterate through all data rows
    // - you shall call this method before calling FieldBuffer()/Field() methods
    // - return TRUE on success, with data ready to be retrieved by Field*()
    // - return FALSE if no more row is available (i.e. exceeded RowCount)
    // - if SeekFirst is TRUE, will put the cursor on the first row of results,
    // otherwise, it will fetch one row of data, to be called within a loop
    // - you can specify a variant instance (e.g. allocated on the stack) in
    // optional RowVariant parameter, to access field values using late binding
    // - typical use may be:
    // ! while TableCustomers.Step do
    // !   writeln(Field('name'));
    // - or, when using a variant and late-binding:
    // ! var customer: variant;
    // ! ...
    // !   while TableCustomers.Step(false,@customer) do
    // !     writeln(customer.Name);
    function Step(SeekFirst: boolean=false; RowVariant: PVariant=nil): boolean;
    /// read-only access to a particular field value, as UTF-8 encoded buffer
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to Get() method, but for the current Step
    function FieldBuffer(FieldIndex: Integer): PUTF8Char; overload;
    /// read-only access to a particular field value, as UTF-8 encoded buffer
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to Get() method, but for the current Step
    function FieldBuffer(const FieldName: RawUTF8): PUTF8Char; overload;
    /// read-only access to a particular field value, as Integer
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to GetAsInteger() method, but for the current Step
    function FieldAsInteger(FieldIndex: Integer): Int64; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as Integer
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to GetAsInteger() method, but for the current Step
    function FieldAsInteger(const FieldName: RawUTF8): Int64; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as floating-point value
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to GetAsFloat() method, but for the current Step
    function FieldAsFloat(FieldIndex: Integer): TSynExtended; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as floating-point value
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to GetAsFloat() method, but for the current Step
    function FieldAsFloat(const FieldName: RawUTF8): TSynExtended; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as RawUTF8
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to GetU() method, but for the current Step
    function FieldAsRawUTF8(FieldIndex: Integer): RawUTF8; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as RawUTF8
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to GetU() method, but for the current Step
    function FieldAsRawUTF8(const FieldName: RawUTF8): RawUTF8; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as VCL String
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to GetString() method, but for the current Step
    function FieldAsString(FieldIndex: Integer): String; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// read-only access to a particular field value, as VCL String
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - similar to GetString() method, but for the current Step
    function FieldAsString(const FieldName: RawUTF8): String; overload;
      {$ifdef HASINLINE}inline;{$endif}
    {$ifndef NOVARIANTS}
    /// read-only access to a particular field value, as a variant
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - will call GetVariant() method for appropriate data conversion
    function Field(FieldIndex: integer): variant; overload;
    /// read-only access to a particular field value, as a variant
    // - raise an ESQLTableException if called outside valid Step() sequence
    // - will call GetVariant() method for appropriate data conversion
    function Field(const FieldName: RawUTF8): variant; overload;
    {$endif}

    /// contains the associated record class on Query
    property QueryTables: TSQLRecordClassDynArray read fQueryTables;
    /// contains the associated SQL statement on Query
    property QuerySQL: RawUTF8 read fQuerySQL;
    /// returns the SQL Table name, guessed from the associated QuerySQL statement
    property QueryTableNameFromSQL: RawUTF8 read GetQueryTableNameFromSQL;
    /// read-only access to the number of data Rows in this table
    // - first row contains field name
    // - then 1..RowCount rows contain the data itself
    // - safely returns 0 if the TSQLTable instance is nil
    property RowCount: integer read GetRowCount;
    /// read-only access to the number of fields for each Row in this table
    property FieldCount: integer read fFieldCount;
    /// read-only access to the ID/RowID field index
    // - do not use this property if the ID column has been hidden, but
    // use IDColumnHiddenValue() method instead
    property FieldIndexID: integer read fFieldIndexID;
    /// read-only acccess to the current Row number, after a Step() call
    // - contains 0 if accessed outside valid Step() sequence call
    // - contains 1..RowCount after a valid Step() iteration
    property StepRow: integer read fStepRow;
    /// this property contains the internal state counter of the server database
    // when the data was retrieved from it
    // - can be used to check if retrieved data may be out of date
    property InternalState: cardinal read fInternalState write fInternalState;
    /// if the TSQLRecord is the owner of this table, i.e. if it must free it
    property OwnerMustFree: Boolean read fOwnerMustFree write fOwnerMustFree;
    /// by default, if field types are not set, only the content of the first
    // row will be checked, to make a difference between a sftInteger and sftFloat
    // - you can set this property to TRUE so that all non string rows will
    // be checked for the exact number precision
    // - note that the safest is to provide the column type, either by supplying
    // the TSQLRecord class, or by calling SetFieldType() overloaded methods
    property FieldTypeIntegerDetectionOnAllRows: boolean
      read fFieldTypeAllRows write fFieldTypeAllRows;
    /// used by GetJsonValues, GetHtmlTable and GetCSVValues methods
    // to export custom JSON content
    property OnExportValue: TOnSQLTableGetValue read fOnExportValue write fOnExportValue;
  end;

{$ifndef NOVARIANTS}
  /// memory structure used for our TSQLTableRowVariant custom variant type
  // used to have direct access to TSQLTable content
  // - the associated TSQLTable must stay allocated as long as this variant
  // is used, otherwise random GPF issues may occur
  TSQLTableRowVariantData = packed record
    /// the custom variant type registered number
    VType: TVarType;
    VFiller: array[1..SizeOf(TVarData)-SizeOf(TVarType)-SizeOf(TSQLTable)
      -SizeOf(integer)] of byte;
    /// reference to the associated TSQLTable
    VTable: TSQLTable;
    /// the row number corresponding to this value
    // - equals -1 if should follow StepRow property value
    VRow: integer;
  end;

  /// pointer to the memory structure used for TSQLTableRowVariant storage
  PSQLTableRowVariantData = ^TSQLTableRowVariantData;

  /// a custom variant type used to have direct access to TSQLTable content
  // - use TSQLTable.Step(..,@Data) method to initialize such a Variant
  // - the variant members/fields are read-only by design
  // - the associated TSQLTable must stay allocated as long as this variant
  // is used, otherwise random GPF issues may occur
  TSQLTableRowVariant = class(TSynInvokeableVariantType)
  protected
    function IntGet(var Dest: TVarData; const Instance: TVarData;
      Name: PAnsiChar; NameLen: PtrInt): boolean; override;
  public
    /// customization of variant into JSON serialization
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); override;
    /// handle type conversion to string
    procedure Cast(var Dest: TVarData; const Source: TVarData); override;
    /// handle type conversion to string
    procedure CastTo(var Dest: TVarData; const Source: TVarData;
      const AVarType: TVarType); override;
  end;

  EObjectVariant = ESynException;

  /// a custom variant type used to have direct access to object published properties
  // - TObjectVariant provides lazy-loading to object properties from a Variant
  // variable - which may be used with SynMustache or with late-binding
  // - warning: this custom variant is just a wrapper around an existing TObject
  // instance, which should remain available as long as the variant is used
  // - if you want a per-representation stateless variant, use ObjectToVariant()
  // which convert all properties into a TDocVariant, so may use more resource
  TObjectVariant = class(TSynInvokeableVariantType)
  protected
    function IntGet(var Dest: TVarData; const Instance: TVarData;
      Name: PAnsiChar; NameLen: PtrInt): boolean; override;
    function IntSet(const Instance, Value: TVarData;
      Name: PAnsiChar; NameLen: PtrInt): boolean; override;
  public
    /// initialize a new custom variant instance, wrapping the specified object
    // - warning: this custom variant is just a wrapper around an existing TObject
    // instance, which should remain available as long as the variant is used
    class procedure New(var V: Variant; Obj: TObject);
    /// will perform proper JSON serialization calling W.WriteObject()
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); override;
  end;

{$endif NOVARIANTS}


  /// store a read-only ORM result table from a JSON message
  // - the JSON data is parsed and unescaped in-place, to enhanced performance
  // and reduce resource consumption (mainly memory/heap fragmentation)
  // - is used by the ORM for TSQLRecord.FillPrepare/FillOne methods for
  // fast access to individual object values
  TSQLTableJSON = class(TSQLTable)
  protected
    /// used if a private copy of the JSON buffer is needed
    fPrivateCopy: RawUTF8;
    /// contains the pointers of start of every field value in JSONData
    fJSONResults: TPUTF8CharDynArray;
    /// contain the hash value of the last JSON data sent to ContentChanged()
    // - used to don't repeat parsing if data has not been changed
    fPrivateCopyHash: cardinal;
    /// fill the result table content from a JSON-formated Data message
    // - returns TRUE on parsing success
    // - returns FALSE if no valid JSON data was found
    // - update all content fields (fResults[], fRowCount, fFieldCount, etc...)
    // - expect the UTF-8 Buffer in either TSQLRequest.EngineExecute(DB,SQL,JSON)
    // format (i.e. expanded) or either in a not expanded format (as an
    // AJAX-ready array of objects)
    // - the conversion into PPUTF8CharArray is made inplace and is very fast
    // (no additional memory buffer is allocated)
    function ParseAndConvert(Buffer: PUTF8Char; BufferLen: integer): boolean;
    /// will check then set (if needed) internal fPrivateCopy[Hash] values
    // - returns TRUE if content changed (then fPrivateCopy+fPrivateCopyHash
    // will be updated using crc32c hash)
    function PrivateCopyChanged(aJSON: PUTF8Char; aLen: integer): boolean;
  public
    /// create the result table from a JSON-formated Data message
    // - the JSON data is parsed and formatted in-place
    // - please note that the supplied JSON buffer content will be changed:
    // if you want to reuse this JSON content, you shall make a private copy
    // before calling this constructor and you shall NOT release the corresponding
    // variable (fResults/JSONResults[] will point inside this memory buffer):
    // use instead the overloaded Create constructor expecting a const
    // aJSON: RawUTF8 parameter to allocate and hold a private copy of the data
    constructor Create(const aSQL: RawUTF8;
      JSONBuffer: PUTF8Char; JSONBufferLen: integer); reintroduce; overload;
    /// create the result table from a JSON-formated Data message
    // - the JSON data is parsed and formatted in-place, after having been
    // copied in the protected fPrivateCopy variable
    constructor Create(const aSQL, aJSON: RawUTF8); reintroduce; overload;
    /// create the result table from a JSON-formated Data message
    // - the JSON data is parsed and formatted in-place
    // - you can specify a set of TSQLRecord classes which will be used to
    // retrieve the column exact type information
    // - please note that the supplied JSON buffer content will be changed
    constructor CreateFromTables(const Tables: array of TSQLRecordClass;
      const aSQL: RawUTF8; JSONBuffer: PUTF8Char; JSONBufferLen: integer); reintroduce; overload;
    /// create the result table from a JSON-formated Data message
    // - you can specify a set of TSQLRecord classes which will be used to
    // retrieve the column exact type information
    // - the JSON data is parsed and formatted in-place, after having been
    // copied in the protected fPrivateCopy variable
    constructor CreateFromTables(const Tables: array of TSQLRecordClass;
      const aSQL, aJSON: RawUTF8); reintroduce; overload;
    /// initialize the result table from a JSON-formated Data message
    // - you can set the expected column types matching the results column layout
    // - the JSON data is parsed and formatted in-place
    constructor CreateWithColumnTypes(const ColumnTypes: array of TSQLFieldType;
      const aSQL: RawUTF8; JSONBuffer: PUTF8Char; JSONBufferLen: integer); reintroduce; overload;
    /// initialize the result table from a JSON-formated Data message
    // - you can set the expected column types matching the results column layout
    // - the JSON data is parsed and formatted in-place, after having been
    // copied in the protected fPrivateCopy variable
    constructor CreateWithColumnTypes(const ColumnTypes: array of TSQLFieldType;
      const aSQL, aJSON: RawUTF8); reintroduce; overload;

    /// update the result table content from a JSON-formated Data message
    // - return true on parsing success, false if no valid JSON data was found
    // - set Refreshed to true if the content changed
    // - update all content fields (fResults[], fRowCount, fFieldCount, etc...)
    // - call SortFields() or IDColumnHide if was already done for this TSQLTable
    // - the conversion into PPUTF8CharArray is made inplace and is very fast
    // (only one memory buffer is allocated for the whole data)
    function UpdateFrom(const aJSON: RawUTF8; var Refreshed: boolean;
      PCurrentRow: PInteger): boolean;

    /// the private copy of the processed data buffer
    // - available e.g. for Create constructor using aJSON parameter,
    // or after the UpdateFrom() process
    // - 16 more bytes will be allocated, to allow e.g. proper SSE4.2 process
    // - this buffer is not to be access directly: this won't be a valid JSON
    // content, but a processed buffer, on which fResults[] elements point to -
    // it will contain unescaped text and numerical values, ending with #0
    property PrivateInternalCopy: RawUTF8 read fPrivateCopy;
  end;

  /// store a writable ORM result table, optionally read from a JSON message
  // - in respect to TSQLTableJSON, this class allows to modify field values,
  // and add some new fields on the fly, even joined from another TSQLTable
  TSQLTableWritable = class(TSQLTableJSON)
  protected
    fNewValues: TRawUTF8DynArray;
    fNewValuesCount: integer;
    fNewValuesInterning: TRawUTF8Interning;
  public
    /// modify a field value in-place, using a RawUTF8 text value
    procedure Update(Row,Field: integer; const Value: RawUTF8); overload;
    /// modify a field value in-place, using a RawUTF8 text value
    procedure Update(Row: integer; const FieldName, Value: RawUTF8); overload;
    {$ifndef NOVARIANTS}
    /// modify a field value in-place, using a variant value
    procedure Update(Row,Field: integer; const Value: variant); overload;
    /// modify a field value in-place, using a variant value
    procedure Update(Row: integer; const FieldName: RawUTF8; const Value: variant); overload;
    {$endif NOVARIANTS}
    /// define a new field to be stored in this table
    // - returns the internal index of the newly created field
    function AddField(const FieldName: RawUTF8): integer; overload;
    /// define a new field to be stored in this table
    // - returns the internal index of the newly created field
    function AddField(const FieldName: RawUTF8; FieldType: TSQLFieldType;
      FieldTypeInfo: pointer=nil; FieldSize: integer=-1): integer; overload;
    /// define a new field to be stored in this table
    // - returns the internal index of the newly created field
    function AddField(const FieldName: RawUTF8; FieldTable: TSQLRecordClass;
      const FieldTableName: RawUTF8=''): integer; overload;
    /// append/merge data from a secondary TSQLTable
    // - you should specify the primary keys on which the data rows are merged
    // - merged data will point to From.fResults[] content: so the From instance
    // should remain available as long as you use this TSQLTableWritable
    // - warning: will call From.SortFields(FromKeyField) for faster process
    procedure Join(From: TSQLTable; const FromKeyField, KeyField: RawUTF8);
    /// optionaly de-duplicate Update() values
    property NewValuesInterning: TRawUTF8Interning
      read fNewValuesInterning write fNewValuesInterning;
    /// how many values have been written via Update() overloaded methods
    // - is not used if NewValuesInterning was defined
    property NewValuesCount: integer read fNewValuesCount;
  end;

  PSQLLocks = ^TSQLLocks;
  /// used to store the locked record list, in a specified table
  // - the maximum count of the locked list if fixed to 512 by default,
  // which seems correct for common usage
  {$ifdef USERECORDWITHMETHODS}TSQLLocks = record
    {$else}TSQLLocks = object{$endif}
  public
    /// the number of locked records stored in this object
    Count: integer;
    /// contains the locked record ID
    // - an empty position is marked with 0 after UnLock()
    IDs: TIDDynArray;
    /// contains the time and date of the lock
    // - filled internally by the fast GetTickCount64() function (faster than
    // TDateTime or TSystemTime/GetLocalTime)
    // - used to purge to old entries - see PurgeOlderThan() method below
    Ticks64s: TInt64DynArray;
    /// lock a record, specified by its ID
    // - returns true on success, false if was already locked
    function Lock(aID: TID): boolean;
    /// unlock a record, specified by its ID
    // - returns true on success, false if was not already locked
    function UnLock(aID: TID): boolean;
    /// return true if a record, specified by its ID, is locked
    function isLocked(aID: TID): boolean;
    /// delete all the locked IDs entries, after a specified time
    // - to be used to release locked records if the client crashed
    // - default value is 30 minutes, which seems correct for common database usage
    procedure PurgeOlderThan(MinutesFromNow: cardinal=30);
  end;

  TSQLLocksDynArray = array of TSQLLocks;

  /// UI Query comparison operators
  // - these operators are e.g. used to mark or unmark some lines in a UI Grid
  // or for TInterfaceStub.ExpectsCount() methods
  TSQLQueryOperator =
    (qoNone,
     qoEqualTo,
     qoNotEqualTo,
     qoLessThan,
     qoLessThanOrEqualTo,
     qoGreaterThan,
     qoGreaterThanOrEqualTo,
     qoEqualToWithCase,
     qoNotEqualToWithCase,
     qoContains,
     qoBeginWith,
     qoSoundsLikeEnglish,
     qoSoundsLikeFrench,
     qoSoundsLikeSpanish);

  /// set of UI Query comparison operators
  TSQLQueryOperators = set of TSQLQueryOperator;

  /// User Interface Query action evaluation function prototype
  // - Operator is ord(TSQLQueryOperator) by default (i.e. for class function
  // TSQLRest.QueryIsTrue), or is a custom enumeration index for custom queries
  // (see TSQLQueryCustom.EnumIndex below, and TSQLRest.QueryAddCustom() method)
  // - for default Operator as ord(TSQLQueryOperator), qoContains and qoBeginWith
  // expect the Reference to be already uppercase
  // - qoEqualTo to qoGreaterThanOrEqualTo apply to all field kind (work with
  // either numeric either UTF-8 values)
  // - qoEqualToWithCase to qoSoundsLikeSpanish handle the field as UTF-8 text,
  // and make the comparison using the phonetic algorithm corresponding to
  // a language family
  // - for default Operator as ord(TSQLQueryOperator), qoSoundsLike* operators
  // expect the Reference not to be a PUTF8Char, but a typecast of a prepared
  // TSynSoundEx object instance (i.e. pointer(@SoundEx)) by the caller
  // - for custom query (from TSQLQueryCustom below), the event must
  // handle a special first call with Value=nil to select if this custom
  // Operator/Query is available for the specified aTable: in this case,
  // returning true indicates that this custom query is available for this table
  // - for custom query (from TSQLQueryCustom below), the event is called with
  // FieldType := TSQLFieldType(TSQLQueryCustom.EnumIndex)+64
  TSQLQueryEvent = function(aTable: TSQLRecordClass; aID: TID;
    FieldType: TSQLFieldType; Value: PUTF8Char; Operator: integer;
    Reference: PUTF8Char): boolean of object;

  /// store one custom query parameters
  // - add custom query by using the TSQLRest.QueryAddCustom() method
  // - use EnumType^.GetCaption(EnumIndex) to retrieve the caption associated
  // to this custom query
  TSQLQueryCustom = record
    /// the associated enumeration type
    EnumType: PEnumType;
    /// the associated enumeration index in EnumType
    // - will be used to fill the Operator parameter for the Event call
    EnumIndex: integer;
    /// the associated evaluation Event handler
    // - the Operator parameter will be filled with the EnumIndex value
    Event: TSQLQueryEvent;
    /// User Interface Query action operators
    Operators: TSQLQueryOperators;
  end;

  /// standard actions for User Interface generation
  // - actNoAction for not defined action
  // - actMark (standard action) to Mark rows, i.e. display sub-menu with
  // actmarkAllEntries..actmarkOlderThanOneYear items
  // - actUnmarkAll (standard action) to UnMark all rows
  // - actmarkAllEntries to Mark all rows
  // - actmarkToday to Mark rows for today
  // - actmarkThisWeek to Mark rows for this Week
  // - actmarkThisMonth to Mark rows for this month
  // - actmarkYesterday to Mark rows for today
  // - actmarkLastWeek to Mark rows for Last Week
  // - actmarkLastMonth to Mark rows for Last month
  // - actmarkOlderThanOneDay to Mark rows After one day
  // - actmarkOlderThanOneWeek to Mark rows older than one week
  // - actmarkOlderThanOneMonth to Mark rows older than one month
  // - actmarkOlderThanSixMonths to Mark rows older than one half year
  // - actmarkOlderThanOneYear to Mark rows older than one year
  // - actmarkInverse to Inverse Mark values (ON->OFF, OFF->ON)
  TSQLAction = (
    actNoAction,
    actMark,
    actUnmarkAll,
    actmarkAllEntries,
    actmarkToday,
    actmarkThisWeek,
    actmarkThisMonth,
    actmarkYesterday,
    actmarkLastWeek,
    actmarkLastMonth,
    actmarkOlderThanOneDay,
    actmarkOlderThanOneWeek,
    actmarkOlderThanOneMonth,
    actmarkOlderThanSixMonths,
    actmarkOlderThanOneYear,
    actmarkInverse);

  /// set of standard actions for User Interface generation
  TSQLActions = set of TSQLAction;

  /// how TSQLModel.URIMatch() will compare an URI
  // - will allow to make a difference about case-sensitivity
  TSQLRestModelMatch = (rmNoMatch, rmMatchExact, rmMatchWithCaseChange);

  /// defines the way the TDrawGrid is displayed by User Interface generation
  TSQLListLayout = (llLeft, llUp, llClient, llLeftUp);

  PSQLRibbonTabParameters = ^TSQLRibbonTabParameters;

  /// defines the settings for a Tab for User Interface generation
  // - used in mORMotToolBar.pas unit and TSQLModel.Create() overloaded method
  // - is defined as an object and not a record to allow easy inheritance for
  // proper per-application customization - see e.g. FileTables.pas in main demo
  TSQLRibbonTabParameters = object
  public
    /// the Table associated to this Tab
    Table: TSQLRecordClass;
    /// the caption of the Tab, to be translated on the screen
    // - by default, Tab name is taken from TSQLRecord.Caption(nil) method
    // - but you can override this value by setting a pointer to a resourcestring
    CustomCaption: PResStringRec;
    /// the hint type of the Tab, to be translated on the screen
    // - by default, hint will replace all %s instance by the Tab name, as taken
    // from TSQLRecord.Caption(nil) method
    // - but you can override this value by setting a pointer to a resourcestring
    CustomHint: PResStringRec;
    /// SQL fields to be displayed on the data lists
    // 'ID,' is always added at the beginning
    Select: RawUTF8;
     /// Tab Group number (index starting at 0)
    Group: integer;
    /// displayed field length mean, one char per field (A=1,Z=26)
    // - put lowercase character in order to center the field data
    FieldWidth: RawUTF8;
    /// if set, the ID column is shown
    ShowID: boolean;
    /// index of field used for displaying order
    OrderFieldIndex: integer;
    /// if set, the list is displayed in reverse order (i.e. decreasing)
    ReverseOrder: boolean;
    /// layout of the List, below the ribbon
    Layout: TSQLListLayout;
    /// width of the List, in percent of the client area
    // - default value (as stated in TSQLRibbonTab.Create) is 30%
    ListWidth: integer;
    /// by default, the detail are displayed as a report (TGDIPages component)
    // - set this property to true to customize the details display
    // - this property is ignored if Layout is llClient (i.e. details hidden)
    NoReport: boolean;
    /// by default, the screens are not refreshed automaticaly
    // - but you can enable the auto-refresh feature by setting this
    // property to TRUE, and creating a WM_TIMER message handler for the form,
    // which will handle both WM_TIMER_REFRESH_SCREEN and WM_TIMER_REFRESH_REPORT
    // timers:
    // !procedure TMainForm.WMRefreshTimer(var Msg: TWMTimer);
    // !begin
    // !  Ribbon.WMRefreshTimer(Msg);
    // !end;
    AutoRefresh: boolean;
    /// the associated hints to be displayed during the edition of this table
    // - every field hint must be separated by a '|' character
    // (e.g. 'The First Name|Its Company Name')
    // - all fields need to be listed in this text resource, even if it won't
    // be displayed on screen (enter a void item like ||)
    // - you can define some value by setting a pointer to a resourcestring
    EditFieldHints: PResStringRec;
    /// write hints above field during the edition of this table
    // - if EditExpandFieldHints is TRUE, the hints are written as text on the
    // dialog, just above the field content; by default, hints are displayed as
    // standard delayed popup when the mouse hover the field editor
    EditExpandFieldHints: boolean;
    /// the associated field name width (in pixels) to be used for creating
    // the edition dialog for this table
    EditFieldNameWidth: integer;
    /// a CSV list of field names to be hidden in both editor and default report
    // - handy to hide fields containing JSON data or the name of another
    // sftRecord/sftID/sftTID (i.e. TRecordReference/TSQLRecord props) fields
    // - list is to be separated by commas (e.g. "RunLogJSON,OrdersJSON" or
    // "ConnectionName")
    EditFieldNameToHideCSV: RawUTF8;
    /// if the default report must contain the edit field hints
    // - i.e. if the resourcestring pointed by EditFieldHints must be used
    // to display some text above every property value on the reports
    EditFieldHintsToReport: boolean;
  end;

  /// parent of all virtual classes
  // - you can define a plain TSQLRecord class as virtual if needed  - e.g.
  // inheriting from TSQLRecordMany then calling VirtualTableExternalRegister() -
  // but using this class will seal its state to be virtual
  TSQLRecordVirtual = class(TSQLRecord);

  TSQLVirtualTable = class;

  /// class-reference type (metaclass) of a virtual table implementation
  TSQLVirtualTableClass = class of TSQLVirtualTable;

  /// pre-computed SQL statements for ORM operations for a given
  // TSQLModelRecordProperties instance
  TSQLModelRecordPropertiesSQL = record
    /// the simple field names in a SQL SELECT compatible format: 'COL1,COL2' e.g.
    // - format is
    // ! SQL.TableSimpleFields[withID: boolean; withTableName: boolean]
    // - returns '*' if no field is of TSQLRawBlob/TSQLRecordMany kind
    // - returns 'COL1,COL2' with all COL* set to simple field names if withID is false
    // - returns 'ID,COL1,COL2' with all COL* set to simple field names if withID is true
    // - returns 'Table.ID,Table.COL1,Table.COL2' if withTableName and withID are true
    TableSimpleFields: array[boolean,boolean] of RawUTF8;
    /// the SQL statement for reading all simple fields and RowID
    // - to be checked if we may safely call EngineList()
    SelectAllWithRowID: RawUTF8;
    /// the SQL statement for reading all simple fields with ID
    // - to be checked if we may safely call EngineList()
    SelectAllWithID: RawUTF8;
    /// the JOINed SQL statement for reading all fields with ID, including
    // nested TSQLRecord pre-allocated instances
    // - is '' if there is no nested TSQLRecord
    SelectAllJoined: RawUTF8;
    /// the updated simple fields exposed as 'COL1=?,COL2=?'
    // - excluding ID (but including TCreateTime fields - as used in
    // TSQLVirtualTableExternal.Update method)
    // - to be used e.g. for UPDATE statements
    UpdateSetSimple: RawUTF8;
    /// all updated fields exposed as 'COL1=?,COL2=?'
    // - excluding ID (but including TCreateTime fields - as used in
    // TSQLVirtualTableExternal.Update method)
    // - to be used e.g. for UPDATE statements
    UpdateSetAll: RawUTF8;
    /// all fields, excluding the ID field, exposed as 'COL1,COL2'
    // - to be used e.g. in TSQLVirtualTableExternal.Insert()
    InsertSet: RawUTF8;
  end;

  /// used by TSQLRecordPropertiesMapping.Options for custom field mapping
  // of a TSQLRecord on an external database process
  // - rpmAutoMapKeywordFields is set if MapAutoKeywordFields has been defined,
  // i.e. if field names which may conflict with a keyword should be
  // automatically mapped to a harmless symbol name
  // - rpmNoCreateMissingTable will bypass the existing table check, e.g.
  // to circumvent some specific DB provider or case sensitivity issue on tables
  // - rpmNoCreateMissingField will bypass the existing field check, e.g.
  // to circumvent some specific DB provider or case sensitivity issue on fields
  // - by default, check of missing field name will be case insensitive, unless
  // the rpmMissingFieldNameCaseSensitive option is set
  // - rpmQuoteFieldName will quote the field names - to be used e.g. with
  // FireBird in its Dialect 3
  // - rpmClearPoolOnConnectionIssue will enable detecting connection loss
  TSQLRecordPropertiesMappingOptions = set of (
    rpmAutoMapKeywordFields,
    rpmNoCreateMissingTable, rpmNoCreateMissingField,
    rpmMissingFieldNameCaseSensitive, rpmQuoteFieldName,
    rpmClearPoolOnConnectionIssue);

  /// pointer to external database properties for ORM
  // - is used e.g. to allow a "fluent" interface for MapField() method
  PSQLRecordPropertiesMapping = ^TSQLRecordPropertiesMapping;

  /// allow custom field mapping of a TSQLRecord
  // - used e.g. for external database process, including SQL generation,
  // as implemented in the mORMotDB.pas unit
  // - in end user code, mostly MapField/MapFields/Options methods
  // should be used, if needed as a fluent chained interface - other lower
  // level methods will be used by the framework internals
  {$ifdef USERECORDWITHMETHODS}TSQLRecordPropertiesMapping = record
    {$else}TSQLRecordPropertiesMapping = object{$endif}
  private
    /// storage of main read-only properties
    fProps: TSQLRecordProperties;
    fConnectionProperties: TObject;
    fTableName: RawUTF8;
    fRowIDFieldName: RawUTF8;
    fExtFieldNames: TRawUTF8DynArray;
    fExtFieldNamesUnQuotedSQL: TRawUTF8DynArray;
    fSQL: TSQLModelRecordPropertiesSQL;
    fFieldNamesMatchInternal: TSQLFieldBits;
    fOptions: TSQLRecordPropertiesMappingOptions;
    fAutoComputeSQL: boolean;
    fMappingVersion: cardinal;
    /// fill fRowIDFieldName/fSQL with the current information
    procedure ComputeSQL;
  public
    /// add a custom field mapping
    // - will re-compute all needed SQL statements as needed, and initialize
    // fSortedFieldsName[] and fSortedFieldsIndex[] internal sorted arrays
    // - can be used e.g. as
    // ! aModel.Props[TSQLMyExternal].ExternalDB.MapField('IntField','ExtField');
    // - since it returns a PSQLRecordPropertiesMapping instance, you can
    // chain MapField().MapField().MapField(); calls to map several fields
    function MapField(const InternalName, ExternalName: RawUTF8): PSQLRecordPropertiesMapping;
    /// call this method to ensure that all fields won't conflict with a SQL
    // keyword for the given database
    // - by default, no check is performed: you can use this method to ensure
    // that all field names won't conflict with a SQL reserved keyword: such
    // fields will be identified and automatically mapped as fieldname_
    // - can be used e.g. as
    // ! aModel.Props[TSQLMyExternal].ExternalDB.
    // !   MapField('IntField','ExtField').
    // !   MapAutoKeywordFields;
    // - will in fact include the rpmAutoMapKeywordFields flag in Options
    // - since it returns a PSQLRecordPropertiesMapping instance, you can
    // chain MapField().MapAutoKeywordFields.MapField(); calls to map several fields
    function MapAutoKeywordFields: PSQLRecordPropertiesMapping;
    /// specify some advanced options for the field mapping
    // - see TSQLRecordPropertiesMappingOptions for all possibilities
    // - can be used e.g. as
    // ! aModel.Props[TSQLMyExternal].ExternalDB.
    // !   MapField('IntField','ExtField').
    // !   SetOptions([rpmNoCreateMissingTable,rpmNoCreateMissingField]);
    // - since it returns a PSQLRecordPropertiesMapping instance, you can
    // chain MapField().SetOptions().MapField(); calls to map several fields
    function SetOptions(aOptions: TSQLRecordPropertiesMappingOptions): PSQLRecordPropertiesMapping;
    /// add several custom field mappings
    // - can be used e.g. as
    // ! aModel.Props[TSQLMyExternal].ExternalDB.
    // !   MapFields(['IntField1','ExtField1', 'IntField2','ExtField2']);
    // - will re-compute all needed SQL statements as needed, and initialize
    // fSortedFieldsName[] and fSortedFieldsIndex[] internal sorted arrays
    // - is slightly faster than several chained MapField() calls, since SQL
    // will be computed only once
    function MapFields(const InternalExternalPairs: array of RawUTF8): PSQLRecordPropertiesMapping;
  public
    /// initialize the field mapping for a given TSQLRecord
    // - if AutoComputeSQL is true, will pre-compute all needed SQL from the
    // supplied information
    // - will left void fSortedFieldsName[] and fSortedFieldsIndex[], to disable
    // custom field mapping
    procedure Init(Table: TSQLRecordClass; const MappedTableName: RawUTF8;
      MappedConnection: TObject; AutoComputeSQL: boolean;
      MappingOptions: TSQLRecordPropertiesMappingOptions);
    /// map a field name from its internal name to its external name
    // - raise an EORMException if the supplied field name is not defined in
    // the TSQLRecord as ID or a published property
    function InternalToExternal(const FieldName: RawUTF8): RawUTF8;
    /// map a CSV list of field names from its internals to its externals values
    // - raise an EORMException if any of the supplied field name is not defined
    // in the TSQLRecord as ID or as property (RowIDFieldName or FieldNames[])
    // - to be used for a simple CSV (e.g. for INSERT/SELECT statements):
    // ! ExtCSV := InternalCSVToExternalCSV('ID,Name');
    // - or for a more complex CSV (e.g. for UPDATE statements);
    // ! ExtCSV := InternalCSVToExternalCSV('ID=?,Name=?','=?,'=?');
    function InternalCSVToExternalCSV(const CSVFieldNames: RawUTF8;
      const Sep: RawUTF8=','; const SepEnd: RawUTF8=''): RawUTF8;
    /// create a list of external field names, from the internal field names
    // - raise an EORMException if any of the supplied field name is not defined
    // in the TSQLRecord as ID or a published property
    // - if IntFieldIndex is set, it will store an array of internal field
    // indexes, i.e. -1 for ID or index in in FieldNames[] for other fields
    procedure InternalToExternalDynArray(const IntFieldNames: array of RawUTF8;
      out result: TRawUTF8DynArray; IntFieldIndex: PIntegerDynArray=nil);
    /// map an external field name into its internal field name
    // - return '' if the external field name is not RowIDFieldName nor in
    // FieldNames[]
    function ExternalToInternalOrNull(const ExtFieldName: RawUTF8): RawUTF8;
    /// map an external field name into its internal field index
    // - returns the index >=0 in FieldNames[] for a matching external field
    // - returns -1 if the field name is RowIDFieldName
    // - returns -2 if the field name is not mapped
    function ExternalToInternalIndex(const ExtFieldName: RawUTF8): integer;
    /// append a field name to a RawUTF8 Text buffer
    // - if FieldIndex=VIRTUAL_TABLE_ROWID_COLUMN (-1), appends RowIDFieldName
    // - on error (i.e. if FieldIndex is out of range) will return TRUE
    // - otherwise, will return FALSE and append the external field name to Text
    function AppendFieldName(FieldIndex: Integer; var Text: RawUTF8): boolean;
    /// return the field name as RawUTF8 value
    // - if FieldIndex=VIRTUAL_TABLE_ROWID_COLUMN (-1), appends RowIDFieldName
    // - otherwise, will return the external field name
    function FieldNameByIndex(FieldIndex: Integer): RawUTF8;

    /// opaque object used on the Server side to specify e.g. the DB connection
    // - will define such a generic TObject, to avoid any unecessary type
    // dependency to other units, e.g. the SynDB unit in mORMot.pas
    // - in practice, will be assigned by VirtualTableExternalRegister() to
    // a TSQLDBConnectionProperties instance in mORMotDB.pas, or by
    // StaticMongoDBRegister() to a TMongoCollection instance, or by
    // TDDDRepositoryRestObjectMapping.Create to its associated TSQLRest
    // - in ORM context, equals nil if the table is internal to SQLite3:
    // ! if Server.Model.Props[TSQLArticle].ExternalDB.ConnectionProperties=nil then
    // !   // this is not an external table, since Init() was not called
    property ConnectionProperties: TObject read fConnectionProperties;
    /// the associated TSQLRecordProperties
    property Properties: TSQLRecordProperties read fProps;
    /// used on the Server side to specify the external DB table name
    // - e.g. for including a schema name or an existing table name, with an
    // OleDB/MSSQL/Oracle/MySQL/PostgreSQL/Jet/SQLite3 backend
    // - equals SQLTableName by default (may be overridden e.g. by mORMotDB's
    // VirtualTableExternalRegister procedure)
    property TableName: RawUTF8 read fTableName;
    /// pre-computed SQL statements for this external TSQLRecord in this model
    // - you can use those SQL statements directly with the external engine
    // - filled if AutoComputeSQL was set to true in Init() method
    property SQL: TSQLModelRecordPropertiesSQL read fSQL;
    /// the ID/RowID customized external field name, if any
    // - is 'ID' by default, since 'RowID' is a reserved column name for some
    // database engines (e.g. Oracle)
    // - can be customized e.g. via
    // ! aModel.Props[TSQLMyExternal].ExternalDB.MapField('ID','ExternalID');
    property RowIDFieldName: RawUTF8 read fRowIDFieldName;
    /// the external field names, following fProps.Props.Field[] order
    // - excluding ID/RowID field, which is stored in RowIDFieldName
    property ExtFieldNames: TRawUTF8DynArray read fExtFieldNames;
    /// the unquoted external field names, following fProps.Props.Field[] order
    // - excluding ID/RowID field, which is stored in RowIDFieldName
    // - in respect to ExtFieldNames[], this array will never quote the field name
    property ExtFieldNamesUnQuotedSQL: TRawUTF8DynArray read fExtFieldNamesUnQuotedSQL;
    /// each bit set, following fProps.Props.Field[]+1 order (i.e. 0=ID,
    // 1=Field[0], ...), indicates that this external field name
    // has not been mapped
    property FieldNamesMatchInternal: TSQLFieldBits read fFieldNamesMatchInternal;
    /// how the mapping process will take place
    property Options: TSQLRecordPropertiesMappingOptions read fOptions;
    /// each time MapField/MapFields is called, this number will increase
    // - can be used to track mapping changes in real time
    property MappingVersion: cardinal read fMappingVersion;
  end;

  /// dynamic array of TSQLModelRecordProperties
  // - used by TSQLModel to store the non-shared information of all its tables
  TSQLModelRecordPropertiesObjArray = array of TSQLModelRecordProperties;

  /// ORM properties associated to a TSQLRecord within a given model
  // - "stable" / common properties derivated from RTTI are shared in the
  // TSQLRecordProperties instance
  // - since the same TSQLRecord can be defined in several models, with diverse
  // implementation patterns (e.g. internal in one, external in another),
  // this class is used to regroup all model-specific settings, like SQL
  // pre-generated patterns or external DB properties
  TSQLModelRecordProperties = class
  protected
    fProps: TSQLRecordProperties;
    fKind: TSQLRecordVirtualKind;
    fModel: TSQLModel;
    fTableIndex: integer;
    fFTSWithoutContentTableIndex: integer;
    fFTSWithoutContentFields: RawUTF8;
    procedure SetKind(Value: TSQLRecordVirtualKind);
    function GetProp(const PropName: RawUTF8): TSQLPropInfo;
  public
    /// pre-computed SQL statements for this TSQLRecord in this model
    // - those statements will work for internal tables, not for external
    // tables with mapped table or fields names
    SQL: TSQLModelRecordPropertiesSQL;
    /// allow SQL process for one external TSQLRecord in this model
    ExternalDB: TSQLRecordPropertiesMapping;
    /// will by-pass automated table and field creation for this TSQLRecord
    // - may be used e.g. when the TSQLRecord is in fact mapped into a View,
    // or is attached as external table and not a real local table
    NoCreateMissingTable: boolean;

    /// initialize the ORM properties from the TSQLRecord RTTI and the supplied
    // TSQLModel
    constructor Create(aModel: TSQLModel; aTable: TSQLRecordClass; aKind: TSQLRecordVirtualKind);
    /// clone ORM properties from an existing TSQLModelRecordProperties to
    // another model
    constructor CreateFrom(aModel: TSQLModel; aSource: TSQLModelRecordProperties);

    /// compute the SQL statement to be executed for a specific SELECT
    // - non simple fields (e.g. BLOBs) will be excluded if SelectFields='*'
    // - by default, will return the SELECT statement to be used for internal
    // virtual SQLite3 table - but if ExternalTable is TRUE, then it will
    // compute a SELECT matching ExternalDB settings
    function SQLFromSelectWhere(const SelectFields, Where: RawUTF8): RawUTF8;
    /// define if a FTS4 virtual table will not store its content, but will
    // be defined as an "external content" FTS4 table
    // - see https://www.sqlite.org/fts3.html#section_6_2_2
    // - the virtual table will be created with content="ContentTableName",
    // and all fields of the FTS4 table
    // - by design, all fields of the FTS4 table should exist in the source
    // ContentTable - otherwise an exception is raised
    // - the indexed text will be assigned to the FTS4 table, using triggers
    // generated by TSQLRecordFTS4.InitializeTable at table creation
    // - note that FTS3 does not support this feature
    procedure FTS4WithoutContent(ContentTable: TSQLRecordClass);

    /// the table index of this TSQLRecord in the associated Model
    property TableIndex: Integer read fTableIndex;
    /// direct access to a property RTTI information, by name
    property Prop[const PropName: RawUTF8]: TSQLPropInfo read GetProp; default;
  published
    /// the shared TSQLRecordProperties information of this TSQLRecord
    // - as retrieved from RTTI
    property Props: TSQLRecordProperties read fProps;
    /// define if is a normal table (rSQLite3), an FTS/R-Tree virtual
    // table or a custom TSQLVirtualTable*ID (rCustomForcedID/rCustomAutoID)
    // - when set, all internal SQL statements will be (re)created, depending of
    // the expected ID/RowID column name expected (i.e. SQLTableSimpleFields[]
    // and SQLSelectAll[] - SQLUpdateSet and SQLInsertSet do not include ID)
    property Kind: TSQLRecordVirtualKind read fKind write SetKind default rSQLite3;
  end;

  /// how a TSQLModel stores a foreign link to be cascaded
  TSQLModelRecordReference = record
    /// refers to the source TSQLRecordClass as model Tables[] index
    TableIndex: integer;
    /// the property
    FieldType: TSQLPropInfo;
    /// the target TSQLRecordClass of the field
    FieldTable: TSQLRecordClass;
    /// the target TSQLRecordClass of the field, from its Tables[] index
    FieldTableIndex: integer;
    /// TRUE if this field is a TRecordReferenceToBeDeleted
    CascadeDelete: boolean;
  end;
  PSQLModelRecordReference = ^TSQLModelRecordReference;

  TSQLModelRecordReferenceDynArray = array of TSQLModelRecordReference;

  /// a Database Model (in a MVC-driven way), for storing some tables types
  // as TSQLRecord classes
  // - share this Model between TSQLRest Client and Server
  // - use this class to access the table properties: do not rely on the
  // low-level database methods (e.g. TSQLDataBase.GetTableNames), since the
  // tables may not exist in the main SQLite3 database, but in-memory or external
  // - don't modify the order of Tables inside this Model, if you publish
  // some TRecordReference property in any of your tables
  TSQLModel = class
  private
    fTables: TSQLRecordClassDynArray;
    fRoot: RawUTF8;
    fRootUpper: RawUTF8;
    fTablesMax: integer;
    fActions: PEnumType;
    fEvents: PEnumType;
    fTableProps: TSQLModelRecordPropertiesObjArray;
    fCustomCollationForAll: array[TSQLFieldType] of RawUTF8;
    {$ifndef LVCL}
    fOnClientIdle: TOnIdleSynBackgroundThread;
    {$endif}
    /// contains the caller of CreateOwnedStream()
    fRestOwner: TSQLRest;
    /// for every table, contains a locked record list
    // - very fast, thanks to the use of a dynamic array with one entry by table
    fLocks: TSQLLocksDynArray;
    /// for fastest SQL Table name lookup via O(log(n)) binary search
    fSortedTablesNameUpper: TRawUTF8DynArray;
    fSortedTablesNameIndex: TIntegerDynArray;
    /// will contain the registered virtual table modules
    fVirtualTableModule: array of TSQLVirtualTableClass;
    /// all TRecordReference and TSQLRecord properties of the model
    fRecordReferences: TSQLModelRecordReferenceDynArray;
    fIDGenerator: array of TSynUniqueIdentifierGenerator;
    procedure SetRoot(const aRoot: RawUTF8);
    procedure SetTableProps(aIndex: integer);
    function GetTableIndexSafe(aTable: TSQLRecordClass;
      RaiseExceptionIfNotExisting: boolean): integer;
    function GetTableProps(aClass: TSQLRecordClass): TSQLModelRecordProperties;
    /// get the enumerate type information about the possible actions to be
    function GetLocks(aTable: TSQLRecordClass): PSQLLocks;
    function GetTable(const SQLTableName: RawUTF8): TSQLRecordClass;
    function GetTableExactIndex(const TableName: RawUTF8): integer;
    function GetTableExactClass(const TableName: RawUTF8): TSQLRecordClass;
    function getURI(aTable: TSQLRecordClass): RawUTF8;
    function getURIID(aTable: TSQLRecordClass; aID: TID): RawUTF8;
    function getURICallBack(const aMethodName: RawUTF8; aTable: TSQLRecordClass; aID: TID): RawUTF8;
  public
    /// initialize the Database Model
    // - set the Tables to be associated with this Model, as TSQLRecord classes
    // - set the optional Root URI path of this Model
    // - initialize the fIsUnique[] array from "stored AS_UNIQUE" (i.e. "stored
    // false") published properties of every TSQLRecordClass
    constructor Create(const Tables: array of TSQLRecordClass; const aRoot: RawUTF8='root'); reintroduce; overload;
    /// you should not use this constructor, but one of the overloaded versions,
    // specifying the associated TSQLRecordClass
    constructor Create; reintroduce; overload;
    /// clone an existing Database Model
    // - all supplied classes won't be redefined as non-virtual:
    // VirtualTableExternalRegister explicit calls are not mandatory here
    constructor Create(CloneFrom: TSQLModel); reintroduce; overload;
    /// initialize the Database Model from an User Interface parameter structure
    // - this constructor will reset all supplied classes to be defined as
    // non-virtual (i.e. Kind=rSQLite3): VirtualTableExternalRegister explicit
    // calls are to be made if tables should be managed as external
    constructor Create(Owner: TSQLRest; TabParameters: PSQLRibbonTabParameters;
      TabParametersCount, TabParametersSize: integer;
      const NonVisibleTables: array of TSQLRecordClass;
      Actions: PTypeInfo=nil; Events: PTypeInfo=nil;
      const aRoot: RawUTF8='root'); reintroduce; overload;
    /// release associated memory
    destructor Destroy; override;
    /// add the class if it doesn't exist yet
    // - return index in Tables[] if not existing yet and successfully added (in this case,
    // aTableIndexCreated^ is set to the newly created index in Tables[])
    // - supplied class will be redefined as non-virtual: VirtualTableExternalRegister
    // explicit call is to be made if table should be managed as external
    // - return FALSE if already present, or TRUE if was added to the internal list
    function AddTable(aTable: TSQLRecordClass; aTableIndexCreated: PInteger=nil): boolean;
    /// add the class if it doesn't exist yet as itself or as inherited class
    // - similar to AddTable(), but any class inheriting from the supplied type
    // will be considered as sufficient
    // - return the class which has been added, or was already there as
    // inherited, so that could be used for further instance creation:
    // ! fSQLAuthUserClass := Model.AddTableInherited(TSQLAuthUser);
    function AddTableInherited(aTable: TSQLRecordClass): pointer;
    /// return any class inheriting from the given table in the model
    // - if the model does not contain such table, supplied aTable is returned
    function GetTableInherited(aTable: TSQLRecordClass): TSQLRecordClass;
    /// get the index of aTable in Tables[]
    // - returns -1 if the table is not in the model
    function GetTableIndex(aTable: TSQLRecordClass): integer; overload;
    /// get the index of any class inherithing from aTable in Tables[]
    // - returns -1 if no table is matching in the model
    function GetTableIndexInheritsFrom(aTable: TSQLRecordClass): integer;
    /// get the index of aTable in Tables[]
    // - raise an EModelException if the table is not in the model
    function GetTableIndexExisting(aTable: TSQLRecordClass): integer;
    /// get the index of a table in Tables[]
    // - expects SQLTableName to be SQL-like formatted (i.e. without TSQL[Record])
    function GetTableIndex(const SQLTableName: RawUTF8): integer; overload;
    /// get the index of a table in Tables[]
    // - expects SQLTableName to be SQL-like formatted (i.e. without TSQL[Record])
    function GetTableIndexPtr(SQLTableName: PUTF8Char): integer;
    /// return the UTF-8 encoded SQL source to create the table
    function GetSQLCreate(aTableIndex: integer): RawUTF8;
    /// return the UTF-8 encoded SQL source to add the corresponding field
    // via a "ALTER TABLE" statement
    function GetSQLAddField(aTableIndex, aFieldIndex: integer): RawUTF8;
    /// return the TRecordReference pointing to the specified record
    function RecordReference(Table: TSQLRecordClass; ID: TID): TRecordReference;
    /// return the table class correspondig to a TRecordReference
    function RecordReferenceTable(const Ref: TRecordReference): TSQLRecordClass;
    /// return TRUE if the specified field of this class was marked as unique
    // - an unique field is defined as "stored AS_UNIQUE" (i.e. "stored false")
    // in its property definition
    // - reflects the internal private fIsUnique propery
    function GetIsUnique(aTable: TSQLRecordClass; aFieldIndex: integer): boolean;
    /// try to retrieve a table index from a SQL statement
    // - naive search of '... FROM TableName' pattern in the supplied SQL,
    // using GetTableNameFromSQLSelect() function
    // - if EnsureUniqueTableInFrom is TRUE, it will check that only one Table
    // is in the FROM clause, otherwise it will return the first Table specified
    function GetTableIndexFromSQLSelect(const SQL: RawUTF8; EnsureUniqueTableInFrom: boolean): integer;
    /// try to retrieve one or several table index from a SQL statement
    // - naive search of '... FROM Table1,Table2' pattern in the supplied SQL,
    // using GetTableNamesFromSQLSelect() function
    function GetTableIndexesFromSQLSelect(const SQL: RawUTF8): TIntegerDynArray;
    /// try to retrieve one or several TSQLRecordClass from a SQL statement
    // - naive search of '... FROM Table1,Table2' pattern in the supplied SQL,
    // using GetTableNamesFromSQLSelect() function
    function GetTablesFromSQLSelect(const SQL: RawUTF8): TSQLRecordClassDynArray;
    /// check if the supplied URI matches the model's Root property
    // - allows sub-domains, e.g. if Root='root/sub1', then '/root/sub1/toto' and
    // '/root/sub1?n=1' will match, whereas '/root/sub1nope/toto' won't
    // - the returned enumerates allow to check if the match was exact (e.g.
    // 'root/sub' matches exactly Root='root'), or with character case
    // approximation (e.g. 'Root/sub' approximates Root='root')
    function URIMatch(const URI: RawUTF8): TSQLRestModelMatch;
    /// compute the SQL statement to be executed for a specific SELECT on Tables
    // - you can set multiple Table class in Tables: the statement will contain the
    // table name ('SELECT T1.F1,T1.F2,T1.F3,T2.F1,T2.F2 FROM T1,T2 WHERE ..' e.g.)
    function SQLFromSelectWhere(const Tables: array of TSQLRecordClass;
      const SQLSelect, SQLWhere: RawUTF8): RawUTF8;
    /// set a custom SQlite3 text column collation for all fields of a given
    // type for all TSQLRecord of this model
    // - can be used e.g. to override ALL default COLLATE SYSTEMNOCASE of RawUTF8,
    // or COLLATE ISO8601 for TDateTime, and let the generated SQLite3 file be
    // available outside the scope of mORMot's SQLite3 engine
    // - collations defined within our SynSQLite3 unit are named BINARY, NOCASE,
    // RTRIM and our custom SYSTEMNOCASE, ISO8601, WIN32CASE, WIN32NOCASE: if
    // you want to use the slow but Unicode ready Windows API, set for each model:
    // ! SetCustomCollationForAll(sftUTF8Text,'WIN32CASE');
    // - shall be set on both Client and Server sides, otherwise some issues
    // may occur
    procedure SetCustomCollationForAll(aFieldType: TSQLFieldType;
      const aCollationName: RawUTF8);
    /// allow to validate length of all text published properties of all tables
    // of this model
    // - the "index" attribute of the RawUTF8/string published properties could
    // be used to specify a maximum length for external VARCHAR() columns
    // - SQLite3 will just ignore this "index" information, but it could be
    // handy to be able to validate the value length before sending to the DB
    // - this method will create TSynValidateText corresponding to the maximum
    // field size specified by the "index" attribute, to validate before write
    // - will expect the "index" value to be in UTF-16 codepoints, unless
    // IndexIsUTF8Length is set to TRUE, indicating UTF-8 length
    procedure SetMaxLengthValidatorForAllTextFields(IndexIsUTF8Length: boolean=false);
    /// allow to filter the length of all text published properties of all tables
    // of this model
    // - the "index" attribute of the RawUTF8/string published properties could
    // be used to specify a maximum length for external VARCHAR() columns
    // - SQLite3 will just ignore this "index" information, but it could be
    // handy to be able to filter the value length before sending to the DB
    // - this method will create TSynFilterTruncate corresponding to the maximum
    // field size specified by the "index" attribute, to validate before write
    // - will expect the "index" value to be in UTF-16 codepoints, unless
    // IndexIsUTF8Length is set to TRUE, indicating UTF-8 length
    procedure SetMaxLengthFilterForAllTextFields(IndexIsUTF8Length: boolean=false);
    {$ifndef NOVARIANTS}
    /// customize the TDocVariant options for all variant published properties
    // - will change the TSQLPropInfoRTTIVariant.DocVariantOptions value
    // - use e.g. as SetVariantFieldDocVariantOptions(JSON_OPTIONS_FAST_EXTENDED)
    // - see also TSQLRecordNoCaseExtended root class
    procedure SetVariantFieldsDocVariantOptions(const Options: TDocVariantOptions);
    {$endif}
    /// force a given table to use a TSynUniqueIdentifierGenerator for its IDs
    /// - will initialize a generator for the supplied table, using the
    // given 16-bit process identifier
    // - you can supply an obfuscation key, which should be shared for the
    // whole system, so that you may use FromObfuscated/ToObfuscated methods
    function SetIDGenerator(aTable: TSQLRecordClass;
      aIdentifier: TSynUniqueIdentifierProcess; const aSharedObfuscationKey: RawUTF8=''): TSynUniqueIdentifierGenerator;
    /// returns the TSynUniqueIdentifierGenerator associated to a table, if any
    function GetIDGenerator(aTable: TSQLRecordClass): TSynUniqueIdentifierGenerator;

    /// assign an enumeration type to the possible actions to be performed
    // with this model
    // - call with the TypeInfo() pointer result of an enumeration type
    // - actions are handled by TSQLRecordForList in the mORMotToolBar.pas unit
    procedure SetActions(aActions: PTypeInfo);
    /// assign an enumeration type to the possible events to be triggered
    // with this class model
    // - call with the TypeInfo() pointer result of an enumeration type
    procedure SetEvents(aEvents: PTypeInfo);
    /// get the text conversion of a given Action, ready to be displayed
    function ActionName(const Action): string;
    /// get the text conversion of a given Event, ready to be displayed
    function EventName(const Event): string;

    /// register a Virtual Table module for a specified class
    // - to be called server-side only (Client don't need to know the virtual
    // table implementation details, and it will increase the code size)
    // - aClass parameter could be either a TSQLRecordVirtual class, either
    // a TSQLRecord class which has its kind set to rCustomForcedID or
    // rCustomAutoID (e.g. TSQLRecordMany calling VirtualTableExternalRegister)
    // - optional aExternalTableName, aExternalDataBase and aMappingOptions can
    // be used to specify e.g. connection parameters as expected by mORMotDB
    // - call it before TSQLRestServer.Create()
    function VirtualTableRegister(aClass: TSQLRecordClass;
      aModule: TSQLVirtualTableClass; const aExternalTableName: RawUTF8='';
      aExternalDataBase: TObject=nil;
      aMappingOptions: TSQLRecordPropertiesMappingOptions=[]): boolean;
    /// retrieve a Virtual Table module associated to a class
    function VirtualTableModule(aClass: TSQLRecordClass): TSQLVirtualTableClass;

    /// create a New TSQLRecord instance for a specific Table
    // - expects SQLTableName to be SQL-like formated (i.e. without TSQL[Record])
    // - use this to create a working copy of a table's record, e.g.
    // - don't forget to Free it when not used any more (use a try...finally
    // block)
    // - it's prefered in practice to directly call TSQLRecord*.Create()
    // in your code
    function NewRecord(const SQLTableName: RawUTF8): TSQLRecord;

    /// lock a record
    // - returns true on success, false if was already locked
    function Lock(aTable: TSQLRecordClass; aID: TID): boolean; overload;
    /// lock a record
    // - returns true on success, false if was already locked
    function Lock(aTableIndex: integer; aID: TID): boolean; overload;
    /// lock a record
    // - returns true on success, false if was already locked
    function Lock(aRec: TSQLRecord): boolean; overload;
    /// unlock a specified record
    // - returns true on success, false if was not already locked
    function UnLock(aTable: TSQLRecordClass; aID: TID): boolean; overload;
    /// unlock a specified record
    // - returns true on success, false if was not already locked
    function UnLock(aTableIndex: integer; aID: TID): boolean; overload;
    /// unlock a specified record
    // - returns true on success, false if was not already locked
    function UnLock(aRec: TSQLRecord): boolean; overload;
    /// unlock all previously locked records
    procedure UnLockAll;
    /// return true if a specified record is locked
    function isLocked(aTable: TSQLRecordClass; aID: TID): boolean; overload;
    /// return true if a specified record is locked
    function isLocked(aRec: TSQLRecord): boolean; overload;
    /// delete all the locked IDs entries, after a specified time
    // - to be used to release locked records if the client crashed
    // - default value is 30 minutes, which seems correct for common usage
    procedure PurgeOlderThan(MinutesFromNow: cardinal=30);
    /// returns the Root property, or '' if the instance is nil
    function SafeRoot: RawUTF8;
    /// get the classes list (TSQLRecord descendent) of all available tables
    property Tables: TSQLRecordClassDynArray read fTables;
    /// get a class from a table name
    // - expects SQLTableName to be SQL-like formated (i.e. without TSQL[Record])
    property Table[const SQLTableName: RawUTF8]: TSQLRecordClass read GetTable; default;
    /// get a class from a table TableName (don't truncate TSQLRecord* if necessary)
    property TableExact[const TableName: RawUTF8]: TSQLRecordClass read GetTableExactClass;
    /// get the URI for a class in this Model, as 'ModelRoot/SQLTableName'
    property URI[aClass: TSQLRecordClass]: RawUTF8 read getURI;
    /// the associated ORM information for a given TSQLRecord class
    // - raise an EModelException if aClass is not declared within this model
    // - returns the corresponding TableProps[] item if the class is known
    property Props[aClass: TSQLRecordClass]: TSQLModelRecordProperties read GetTableProps;
    /// the maximum index of TableProps[] class properties array
    property TablesMax: integer read fTablesMax;
    // performed with this model
    // - Actions are e.g. linked to some buttons in the User Interface
    property Actions: PEnumType read fActions;
    /// get the enumerate type information about the possible Events to be
    // performed with this model
    // - Events can be linked to actions and custom status, to provide a
    // centralized handling of logging (e.g. in an Audit Trail table)
    property Events: PEnumType read fEvents;
    /// this property value is used to auto free the database Model class
    // - set this property after Owner.Create() in order to have
    // Owner.Destroy autofreeing it
    property Owner: TSQLRest read fRestOwner write fRestOwner;
    /// for every table, contains a locked record list
    // - very fast, thanks to the use one TSQLLocks entry by table
    property Locks: TSQLLocksDynArray read fLocks;
    /// this array contain all TRecordReference and TSQLRecord properties
    // existing in the database model
    // - used in TSQLRestServer.Delete() to enforce relational database coherency
    // after deletion of a record: all other records pointing to it will be
    // reset to 0 or deleted (if CascadeDelete is true)
    property RecordReferences: TSQLModelRecordReferenceDynArray read fRecordReferences;
    {$ifndef LVCL}
    /// set a callback event to be executed in loop during client remote
    // blocking process, e.g. to refresh the UI during a somewhat long request
    // - will be passed to TSQLRestClientURI.OnIdle property by
    // TSQLRestClientURI.RegisteredClassCreateFrom() method, if applying
    property OnClientIdle: TOnIdleSynBackgroundThread
      read fOnClientIdle write fOnClientIdle;
    {$endif}
  published
    /// the Root URI path of this Database Model
    // - this textual value will be used directly to compute the URI for REST
    // routing, so it should contain only URI-friendly characters,
    // i.e. only alphanumerical characters, excluding e.g. space or '+',
    // otherwise an EModelException is raised
    property Root: RawUTF8 read fRoot write SetRoot;
    /// the associated ORM information about all handled TSQLRecord class properties
    // - this TableProps[] array will map the Tables[] array, and will allow
    // fast direct access to the Tables[].RecordProps values
    property TableProps: TSQLModelRecordPropertiesObjArray read fTableProps;
  end;

  PRecordRef = ^RecordRef;

  /// useful object to type cast TRecordReference type value into explicit
  // TSQLRecordClass and ID
  // - use RecordRef(Reference).TableIndex/Table/ID/Text methods to retrieve
  // the details of a TRecordReference encoded value
  // - use TSQLRest.Retrieve(Reference) to get a record content from DB
  // - instead of From(Reference).From(), you could use the more explicit
  // TSQLRecord.RecordReference(Model) or TSQLModel.RecordReference()
  // methods or RecordReference() function to encode the value
  // - don't change associated TSQLModel tables order, since TRecordReference
  // depends on it to store the Table type
  // - since 6 bits are used for the table index, the corresponding table
  // MUST appear in the first 64 items of the associated TSQLModel.Tables[]
  {$ifdef FPC_OR_UNICODE}RecordRef = record
    {$else}RecordRef = object{$endif}
  public
    /// the value itself
    // - (value and 63) is the TableIndex in the current database Model
    // - (value shr 6) is the ID of the record in this table
    // - value=0 means no reference stored
    // - we use this coding and not the opposite (Table in MSB) to minimize
    // integer values; but special UTF8CompareRecord() function has to be used
    // for sorting
    // - type definition matches TRecordReference (i.e. Int64/TID) to allow
    // typecast as such:
    // ! aClass := PRecordRef(@Reference)^.Table(Model);
    Value: TID;
    /// return the index of the content Table in the TSQLModel
    function TableIndex: integer;  {$ifdef HASINLINE}inline;{$endif}
    /// return the class of the content in a specified TSQLModel
    function Table(Model: TSQLModel): TSQLRecordClass;
    /// return the ID of the content
    function ID: TID;              {$ifdef HASINLINE}inline;{$endif}
    /// fill Value with the corresponding parameters
    // - since 6 bits are used for the table index, aTable MUST appear in the
    // first 64 items of the associated TSQLModel.Tables[] array
    procedure From(Model: TSQLModel; aTable: TSQLRecordClass; aID: TID);
    /// get a ready to be displayed text from the stored Table and ID
    // - display 'Record 2301' e.g.
    function Text(Model: TSQLModel): RawUTF8; overload;
    /// get a ready to be displayed text from the stored Table and ID
    // - display 'Record "RecordName"' e.g.
    function Text(Rest: TSQLRest): RawUTF8; overload;
  end;


  /// an abstract base class, corresponding to an R-Tree table of values
  // - do not use this class, but either TSQLRecordRTree or TSQLRecordRTreeInteger
  // - an R-Tree is a special index that is designed for doing range queries.
  // R-Trees are most commonly used in geospatial systems where each entry is a
  // rectangle with minimum and maximum X and Y coordinates. Given a query
  // rectangle, an R-Tree is able to quickly find all entries that are contained
  // within the query rectangle or which overlap the query rectangle. This idea
  // is easily extended to three dimensions for use in CAD systems. R-Trees also
  // find use in time-domain range look-ups. For example, suppose a database
  // records the starting and ending times for a large number of events. A R-Tree
  // is able to quickly find all events, for example, that were active at any
  // time during a given time interval, or all events that started during a
  // particular time interval, or all events that both started and ended within
  // a given time interval. And so forth. See http:// www.sqlite.org/rtree.html
  // - any record which inherits from this class as TSQLRecordRTree must have
  // only sftFloat (double) fields (or integer fields for TSQLRecordRTreeInteger)
  // grouped by pairs, each as minimum- and maximum-value, up to 5 dimensions
  // (i.e. 11 columns, including the ID property)
  // - since SQLite version 3.24.0 (2018-06-04), R-Tree tables can have
  // auxiliary columns that store arbitrary data: such fields should appear after
  // the boundary columns, and have their property name starting with '_' in the
  // class definition; in both SQL and Where clause, the '_' will be trimmed - note
  // that you should better use the SynSQLite3Static unit, since an external
  // SQLite3 .dll/.so library as supplied by the system may be outdated
  // - internally, the SQlite3 R-Tree extension will be implemented as a virtual
  // table, storing coordinates/values as 32-bit floating point (single - as
  // TSQLRecordRTree kind of ORM classes) or 32-bit integers (as TSQLRecordRTreeInteger),
  // but will make all R-Tree computation using 64-bit floating point (double)
  // - as with any virtual table, the ID: TID property must be set before adding
  // a TSQLRecordRTree to the database, e.g. to link a R-Tree representation to
  // a regular TSQLRecord table
  // - queries against the ID or the coordinate ranges are almost immediate: so
  // you can e.g. extract some coordinates box from the regular TSQLRecord
  // table, then use a TSQLRecordRTree joined query to make the process faster;
  // this is exactly what the TSQLRestClient.RTreeMatch method offers - of
  // course Auxiliary Columns could avoid to make the JOIN and call RTreeMatch
  TSQLRecordRTreeAbstract = class(TSQLRecordVirtual)
  public
    /// override this class function to implement a custom SQL *_in() function
    // - in practice, an R-Tree index does not normally provide the exact answer
    // but merely reduces the set of potential answers from millions to dozens:
    // this method will be called from the *_in() SQL function to actually
    // return exact matches
    // - by default, the BLOB array will be decoded via the BlobToCoord class
    // procedure, and will create a SQL function from the class name
    //  - used e.g. by the TSQLRestClient.RTreeMatch method
    class function ContainedIn(const BlobA,BlobB): boolean; virtual; abstract;
    /// will return 'MapBox_in' e.g. for TSQLRecordMapBox
    class function RTreeSQLFunctionName: RawUTF8; virtual;
  end;

  /// this kind of record array can be used for direct floating-point
  // coordinates storage as in TSQLRecordRTree.BlobToCoord
  TSQLRecordTreeCoords = array[0..RTREE_MAX_DIMENSION-1] of packed record
    min, max: double; end;

  /// a base record, corresponding to an R-Tree table of floating-point values
  // - for instance, the following class will define a 2 dimensional RTree
  // of floating point coordinates, and an associated MapBox_in() function:
  // ! TSQLRecordMapBox = class(TSQLRecordRTree)
  // ! protected
  // !   fMinX, fMaxX, fMinY, fMaxY: double;
  // ! published
  // !   property MinX: double read fMinX write fMinX;
  // !   property MaxX: double read fMaxX write fMaxX;
  // !   property MinY: double read fMinY write fMinY;
  // !   property MaxY: double read fMaxY write fMaxY;
  // ! end;
  // - since SQLite version 3.24.0, TSQLRecordRTree can have auxiliary columns
  // that store arbitrary data, having their property name starting with '_'
  // (only in this class definition: SQL and Where clauses will trim it)
  TSQLRecordRTree = class(TSQLRecordRTreeAbstract)
  public
    /// override this class function to implement a custom SQL *_in() function
    // - by default, the BLOB array will be decoded via the BlobToCoord() class
    // procedure, and will create a SQL function from the class name
    //  - used e.g. by the TSQLRestClient.RTreeMatch method
    class function ContainedIn(const BlobA,BlobB): boolean; override;
    /// override this class function to implement a custom box coordinates
    // from a given BLOB content
    // - by default, the BLOB array will contain a simple array of double
    // - but you can override this method to handle a custom BLOB field content,
    // intended to hold some kind of binary representation of the precise
    // boundaries of the object, and convert it into box coordinates as
    // understood by the ContainedIn() class function
    // - the number of pairs in OutCoord will be taken from the current number
    // of published double properties
    // - used e.g. by the TSQLRest.RTreeMatch method
    class procedure BlobToCoord(const InBlob; var OutCoord: TSQLRecordTreeCoords); virtual;
  end;

  /// this kind of record array can be used for direct 32-bit integer
  // coordinates storage as in TSQLRecordRTreeInteger.BlobToCoord
  TSQLRecordTreeCoordsInteger = array[0..RTREE_MAX_DIMENSION-1] of packed record
    min, max: integer; end;

  /// a base record, corresponding to an R-Tree table of 32-bit integer values
  // - for instance, the following class will define a 2 dimensional RTree
  // of 32-bit integer coordinates, and an associated MapBox_in() function:
  // ! TSQLRecordMapBox = class(TSQLRecordRTree)
  // ! protected
  // !   fMinX, fMaxX, fMinY, fMaxY: integer;
  // ! published
  // !   property MinX: integer read fMinX write fMinX;
  // !   property MaxX: integer read fMaxX write fMaxX;
  // !   property MinY: integer read fMinY write fMinY;
  // !   property MaxY: integer read fMaxY write fMaxY;
  // ! end;
  // - since SQLite version 3.24.0, TSQLRecordRTreeInteger can have auxiliary
  // columns that store arbitrary data, having their property name starting with '_'
  // (only in this class definition: SQL and Where clauses will trim it)
  TSQLRecordRTreeInteger = class(TSQLRecordRTreeAbstract)
  public
    /// override this class function to implement a custom SQL *_in() function
    // - by default, the BLOB array will be decoded via the BlobToCoord() class
    // procedure, and will create a SQL function from the class name
    //  - used e.g. by the TSQLRest.RTreeMatch method
    class function ContainedIn(const BlobA,BlobB): boolean; override;
    /// override this class function to implement a custom box coordinates
    // from a given BLOB content
    // - by default, the BLOB array will contain a simple array of integer
    // - but you can override this method to handle a custom BLOB field content,
    // intended to hold some kind of binary representation of the precise
    // boundaries of the object, and convert it into box coordinates as
    // understood by the ContainedIn() class function
    // - the number of pairs in OutCoord will be taken from the current number
    // of published integer properties
    // - used e.g. by the TSQLRest.RTreeMatch method
    class procedure BlobToCoord(const InBlob; var OutCoord: TSQLRecordTreeCoordsInteger); virtual;
  end;

  /// a base record, corresponding to a FTS3 table, i.e. implementing full-text
  // - FTS3/FTS4/FTS5 tables are SQLite virtual tables allowing users to perform
  // full-text searches on a set of documents. The most common (and effective)
  // way to describe full-text searches is "what Google, Yahoo and Altavista do
  // with documents placed on the World Wide Web". Users input a term, or
  // series of terms, perhaps connected by a binary operator or grouped together
  // into a phrase, and the full-text query system finds the set of documents
  // that best matches those terms considering the operators and groupings the
  // user has specified. See http:// sqlite.org/fts3.html
  // - any record which inherits from this class must have only sftUTF8Text
  // (RawUTF8) fields - with Delphi 2009+, you can have string fields
  // - this record has its fID: TID property which may be published
  // as DocID, to be consistent with SQLite3 praxis, and reflect that it
  // points to an ID of another associated TSQLRecord
  // - a good approach is to store your data in a regular TSQLRecord table, then
  // store your text content in a separated FTS3 table, associated to this
  // TSQLRecordFTS3 table via its ID/DocID
  // - the ID/DocID property can be set when the record is added, to retrieve any
  // associated TSQLRecord (note that for a TSQLRecord record,
  // the ID property can't be set at adding, but is calculated by the engine)
  // - static tables don't handle TSQLRecordFTS3 classes
  // - by default, the FTS3 engine ignore all characters >= #80, but handle
  // low-level case insentivity (i.e. 'A'..'Z') so you must keep your
  // request with the same range for upper case
  // - by default, the "simple" tokenizer is used, but you can inherits from
  // TSQLRecordFTS3Porter class if you want a better English matching, using
  // the Porter Stemming algorithm, or TSQLRecordFTS3Unicode61 for Unicode
  // support - see http:// sqlite.org/fts3.html#tokenizer
  // - you can select either the FTS3 engine, or the more efficient (and new)
  // FTS4 engine (available since version 3.7.4), by using the TSQLRecordFTS4
  // type, or TSQLRecordFTS5 for the latest (and preferred) FTS5 engine
  // - in order to make FTS queries, use the dedicated TSQLRest.FTSMatch
  // method, with the MATCH operator (you can use regular queries, but you must
  // specify 'RowID' instead of 'DocID' or 'ID' because of FTS3 Virtual
  // table specificity):
  // ! var IDs: TIDDynArray;
  // ! if FTSMatch(TSQLMyFTS3Table,'text MATCH "linu*"',IDs) then
  // !  //  you have all matching IDs in IDs[]
  // - by convention, inherited class name could specify a custom stemming
  // algorithm by starting with "TSQLRecordFTS3", and adding the algorithm name as
  // suffix, e.g. TSQLRecordFTS3Porter will create a "tokenize=porter" virtual table
  TSQLRecordFTS3 = class(TSQLRecordVirtual)
  public
     /// optimize the FTS3 virtual table
     // - this causes FTS3 to merge all existing index b-trees into a single large
     // b-tree containing the entire index. This can be an expensive operation,
     // but may speed up future queries. See http://sqlite.org/fts3.html#section_1_2
     // - this method must be called server-side
     // - returns TRUE on success
     class function OptimizeFTS3Index(Server: TSQLRestServer): boolean;
     /// this DocID property map the internal Row_ID property
     // - but you can set a value to this property before calling the Add()
     // method, to associate this TSQLRecordFTS3 to another TSQLRecord
     // - ID property is read-only, but this DocID property can be written/set
     // - internaly, we use RowID in the SQL statements, which is compatible
     // with both TSQLRecord and TSQLRecordFTS3 kind of table
     property DocID: TID read GetID write fID;
  end;

  /// this base class will create a FTS3 table using the Porter Stemming algorithm
  // - see http://sqlite.org/fts3.html#tokenizer
  // - will generate tokenize=porter by convention from the class name
  TSQLRecordFTS3Porter = class(TSQLRecordFTS3);

  /// this base class will create a FTS3 table using the Unicode61 Stemming algorithm
  // - see http://sqlite.org/fts3.html#tokenizer
  // - will generate tokenize=unicode64 by convention from the class name
  TSQLRecordFTS3Unicode61 = class(TSQLRecordFTS3);

  /// a base record, corresponding to a FTS4 table, which is an enhancement to FTS3
  // - FTS3 and FTS4 are nearly identical. They share most of their code in common,
  // and their interfaces are the same. The only difference is that FTS4 stores
  // some additional information about the document collection in two of new FTS
  // shadow tables. This additional information allows FTS4 to use certain
  // query performance optimizations that FTS3 cannot use. And the added information
  // permits some additional useful output options in the matchinfo() function.
  // - for newer applications, TSQLRecordFTS5 is recommended; though if minimal
  // disk usage or compatibility with older versions of SQLite are important,
  // then TSQLRecordFTS3 will usually serve just as well
  // - see http:// sqlite.org/fts3.html#section_1_1
  // - by convention, inherited class name could specify a custom stemming
  // algorithm by starting with "TSQLRecordFTS4", and adding the algorithm name as
  // suffix, e.g. TSQLRecordFTS'Porter will create a "tokenize=porter" virtual table
  TSQLRecordFTS4 = class(TSQLRecordFTS3)
  public
    /// this overriden method will create TRIGGERs for FTSWithoutContent()
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
  end;

  /// this base class will create a FTS4 table using the Porter Stemming algorithm
  // - see http://sqlite.org/fts3.html#tokenizer
  // - will generate tokenize=porter by convention from the class name
  TSQLRecordFTS4Porter = class(TSQLRecordFTS4);

  /// this base class will create a FTS4 table using the Unicode61 Stemming algorithm
  // - see http://sqlite.org/fts3.html#tokenizer
  // - will generate tokenize=unicode64 by convention from the class name
  TSQLRecordFTS4Unicode61 = class(TSQLRecordFTS4);

  /// a base record, corresponding to a FTS5 table, which is an enhancement to FTS4
  // - FTS5 is a new version of FTS4 that includes various fixes and solutions for
  // problems that could not be fixed in FTS4 without sacrificing backwards compatibility
  // - for newer applications, TSQLRecordFTS5 is recommended; though if minimal
  // disk usage or compatibility with older versions of SQLite are important,
  // then TSQLRecordFTS3/TSQLRecordFTS4 will usually serve just as well
  // - see https://sqlite.org/fts5.html#appendix_a
  // - by convention, inherited class name could specify a custom stemming
  // algorithm by starting with "TSQLRecordFTS5", and adding the algorithm name as
  // suffix, e.g. TSQLRecordFTS5Porter will create a "tokenize=porter" virtual table
  TSQLRecordFTS5 = class(TSQLRecordFTS4);

  /// this base class will create a FTS5 table using the Porter Stemming algorithm
  // - see https://sqlite.org/fts5.html#tokenizers
  // - will generate tokenize=porter by convention from the class name
  TSQLRecordFTS5Porter = class(TSQLRecordFTS5);

  /// this base class will create a FTS5 table using the Unicode61 Stemming algorithm
  // - see https://sqlite.org/fts5.html#tokenizers
  // - will generate tokenize=unicode64 by convention from the class name
  TSQLRecordFTS5Unicode61 = class(TSQLRecordFTS5);

  /// class-reference type (metaclass) of a FTS3/FTS4/FTS5 virtual table
  TSQLRecordFTS3Class = class of TSQLRecordFTS3;

  /// class-reference type (metaclass) of a RTREE virtual table
  // - either a TSQLRecordRTree or a TSQLRecordRTreeInteger
  TSQLRecordRTreeClass = class of TSQLRecordRTreeAbstract;

  /// the kind of fields to be available in a Table resulting of
  // a TSQLRecordMany.DestGetJoinedTable() method call
  // - Source fields are not available, because they will be always the same for
  // a same SourceID, and they should be available from the TSQLRecord which
  // hold the TSQLRecordMany instance
  // - jkDestID and jkPivotID will retrieve only DestTable.ID and PivotTable.ID
  // - jkDestFields will retrieve DestTable.* simple fields, or the fields
  // specified by aCustomFieldsCSV (the Dest table name will be added: e.g.
  // for aCustomFieldsCSV='One,Two', will retrieve DestTable.One, DestTable.Two)
  // - jkPivotFields will retrieve PivotTable.* simple fields, or the fields
  // specified by aCustomFieldsCSV (the Pivot table name will be added: e.g.
  // for aCustomFieldsCSV='One,Two', will retrieve PivotTable.One, PivotTable.Two)
  // - jkPivotAndDestAllFields for PivotTable.* and DestTable.* simple fields,
  // or will retrieve the specified aCustomFieldsCSV fields (with
  // the table name associated: e.g. 'PivotTable.One, DestTable.Two')
  TSQLRecordManyJoinKind = (
    jkDestID, jkPivotID, jkDestFields, jkPivotFields, jkPivotAndDestFields);

  /// handle "has many" and "has many through" relationships
  // - many-to-many relationship is tracked using a table specifically for that
  // relationship, turning the relationship into two one-to-many relationships
  // pointing in opposite directions
  // - by default, only two TSQLRecord (i.e. INTEGER) fields must be created,
  // named "Source" and "Dest", the first pointing to the source record (the one
  // with a TSQLRecordMany published property) and the second to the destination record
  // - you should first create a type inheriting from TSQLRecordMany, which
  // will define the pivot table, providing optional "through" parameters if needed
  // ! TSQLDest = class(TSQLRecord);
  // ! TSQLSource = class;
  // ! TSQLDestPivot = class(TSQLRecordMany)
  // ! private
  // !  fSource: TSQLSource;
  // !  fDest: TSQLDest;
  // !  fTime: TDateTime;
  // ! published
  // !   property Source: TSQLSource read fSource; // map Source column
  // !   property Dest: TSQLDest read fDest; // map Dest column
  // !   property AssociationTime: TDateTime read fTime write fTime;
  // ! end;
  // ! TSQLSource = class(TSQLRecord)
  // ! private
  // !   fDestList: TSQLDestPivot;
  // ! published
  // !   DestList: TSQLDestPivot read fDestList;
  // ! end;
  // - in all cases, at leat two 'Source' and 'Dest' published properties must
  // be declared as TSQLRecord children in any TSQLRecordMany descendant
  // because they will always be needed for the 'many to many' relationship
  // - when a TSQLRecordMany published property exists in a TSQLRecord, it is
  // initialized automaticaly by TSQLRecord.Create
  // - to add some associations to the pivot table, use the ManyAdd() method
  // - to retrieve an association, use the ManySelect() method
  // - to delete an association, use the ManyDelete() method
  // - to read all Dest records IDs, use the DestGet() method
  // - to read the Dest records and the associated "through" fields content, use
  // FillMany then FillRow, FillOne and FillRewind methods to loop through records
  // - to read all Source records and the associaed "through" fields content,
  // FillManyFromDest then FillRow, FillOne and FillRewind methods
  // - to read all Dest IDs after a join to the pivot table, use DestGetJoined
  TSQLRecordMany = class(TSQLRecord)
  protected
    // internal fields initialized during TSQLRecord.Create
    // - map to the Source and Dest properties field values in TSQLRecord values
    fSourceID: PPtrInt;
    fDestID: PPtrInt;
    /// retrieve the TSQLRecordMany ID from a given source+dest IDs pair
    function InternalIDFromSourceDest(aClient: TSQLRest; aSourceID, aDestID: TID): TID;
    function InternalFillMany(aClient: TSQLRest; aID: TID;
      const aAndWhereSQL: RawUTF8; isDest: boolean): integer;
  public
    /// initialize this instance, and needed internal fields
    // - will set protected fSourceID/fDestID fields
    constructor Create; override;
    /// retrieve all records associated to a particular source record, which
    // has a TSQLRecordMany property
    // - returns the Count of records corresponding to this aSource record
    // - the records are stored in an internal TSQLTable, refered in the private
    // fTable field, and initialized via a FillPrepare call: all Dest items
    // are therefore accessible with standard FillRow, FillOne and FillRewind methods
    // - use a "for .." loop or a "while FillOne do ..." loop to iterate
    // through all Dest items, getting also any additional 'through' columns
    // - if source ID parameter is 0, the ID is taken from the fSourceID field
    // (set by TSQLRecord.Create)
    // - note that if the Source record has just been added, fSourceID is not
    // set, so this method will fail: please specify aSourceID parameter with
    // the one just added/created
    // - the optional aAndWhereSQL parameter can be used to add any additional
    // condition to the WHERE statement (e.g. 'Salary>:(1000): AND Salary<:(2000):')
    // according to TSQLRecordMany properties - note that you should better use
    // inlined parameters for faster processing on server, so you may call e.g.
    // ! aRec.FillMany(Client,0,FormatUTF8('Salary>? AND Salary<?',[],[1000,2000]));
    function FillMany(aClient: TSQLRest; aSourceID: TID=0;
      const aAndWhereSQL: RawUTF8=''): integer;
    /// retrieve all records associated to a particular Dest record, which
    // has a TSQLRecordMany property
    // - returns the Count of records corresponding to this aSource record
    // - use a "for .." loop or a "while FillOne do ..." loop to iterate
    // through all Dest items, getting also any additional 'through' columns
    // - the optional aAndWhereSQL parameter can be used to add any additional
    // condition to the WHERE statement (e.g. 'Salary>:(1000): AND Salary<:(2000):')
    // according to TSQLRecordMany properties - note that you should better use
    // inlined parameters for faster processing on server, so you may call e.g.
    // ! aRec.FillManyFromDest(Client,DestID,FormatUTF8('Salary>? AND Salary<?',[],[1000,2000]));
    function FillManyFromDest(aClient: TSQLRest; aDestID: TID;
      const aAndWhereSQL: RawUTF8=''): integer;
    /// retrieve all Dest items IDs associated to the specified Source
    function DestGet(aClient: TSQLRest; aSourceID: TID; out DestIDs: TIDDynArray): boolean; overload;
    /// retrieve all Dest items IDs associated to the current Source ID
    // - source ID is taken from the fSourceID field (set by TSQLRecord.Create)
    // - note that if the Source record has just been added, fSourceID is not
    // set, so this method will fail: please call the other overloaded method
    function DestGet(aClient: TSQLRest; out DestIDs: TIDDynArray): boolean; overload;
    /// retrieve all Source items IDs associated to the specified Dest ID
    function SourceGet(aClient: TSQLRest; aDestID: TID; out SourceIDs: TIDDynArray): boolean;
    /// retrieve all Dest items IDs associated to the current or
    // specified Source ID, adding a WHERE condition against the Dest rows
    // - if aSourceID is 0, the value is taken from current fSourceID field
    // (set by TSQLRecord.Create)
    // - aDestWhereSQL can specify the Dest table name in the statement, e.g.
    //  'Salary>:(1000): AND Salary<:(2000):' - note that you should better use
    // inlined parameters for faster processing on server, so you may use the
    // more convenient function
    // ! FormatUTF8('Salary>? AND Salary<?',[],[1000,2000])
    // - this is faster than a manual FillMany() then loading each Dest,
    // because the condition is executed in the SQL statement by the server
    function DestGetJoined(aClient: TSQLRest; const aDestWhereSQL: RawUTF8;
      aSourceID: TID; out DestIDs: TIDDynArray): boolean; overload;
    /// create a Dest record, then FillPrepare() it to retrieve all Dest items
    // associated to the current or specified Source ID, adding a WHERE condition
    // against the Dest rows
    // - if aSourceID is 0, the value is taken from current fSourceID field
    // (set by TSQLRecord.Create)
    // - aDestWhereSQL can specify the Dest table name in the statement, e.g.
    // 'Salary>:(1000): AND Salary<:(2000):') according to TSQLRecordMany
    // properties - note that you should better use such inlined parameters as
    // ! FormatUTF8('Salary>? AND Salary<?',[],[1000,2000])
    function DestGetJoined(aClient: TSQLRest; const aDestWhereSQL: RawUTF8;
      aSourceID: TID): TSQLRecord; overload;
    /// create a TSQLTable, containing all specified Fields, after a JOIN
    // associated to the current or specified Source ID
    // - the Table will have the fields specified by the JoinKind parameter
    // - aCustomFieldsCSV can be used to specify which fields must be retrieved
    // (for jkDestFields, jkPivotFields, jkPivotAndDestFields) - default is all
    // - if aSourceID is 0, the value is taken from current fSourceID field
    // (set by TSQLRecord.Create)
    // - aDestWhereSQL can specify the Dest table name in the statement, e.g.
    // 'Salary>:(1000): AND Salary<:(2000):') according to TSQLRecordMany
    // properties - note that you should better use such inlined parameters as
    // ! FormatUTF8('Salary>? AND Salary<?',[],[1000,2000])
    function DestGetJoinedTable(aClient: TSQLRest; const aDestWhereSQL: RawUTF8;
      aSourceID: TID; JoinKind: TSQLRecordManyJoinKind;
      const aCustomFieldsCSV: RawUTF8=''): TSQLTable;
    /// add a Dest record to the Source record list
    // - returns TRUE on success, FALSE on error
    // - if NoDuplicates is TRUE, the existence of this Source/Dest ID pair
    // is first checked
    // - current Source and Dest properties are filled with the corresponding
    // TRecordReference values corresponding to the supplied IDs
    // - any current value of the additional fields are used to populate the
    // newly created content (i.e. all published properties of this record)
    // - if aUseBatch is set, it will use this TSQLRestBach.Add() instead
    // of the slower aClient.Add() method
    function ManyAdd(aClient: TSQLRest; aSourceID, aDestID: TID;
      NoDuplicates: boolean=false; aUseBatch: TSQLRestBatch=nil): boolean; overload;
    /// add a Dest record to the current Source record list
    // - source ID is taken from the fSourceID field (set by TSQLRecord.Create)
    // - note that if the Source record has just been added, fSourceID is not
    // set, so this method will fail: please call the other overloaded method
    function ManyAdd(aClient: TSQLRest; aDestID: TID;
      NoDuplicates: boolean=false): boolean; overload;
    /// will delete the record associated with a particular Source/Dest pair
    // - will return TRUE if the pair was found and successfully deleted
    // - if aUseBatch is set, it will use this TSQLRestBach.Delete() instead
    // of the slower aClient.Delete() method
    function ManyDelete(aClient: TSQLRest; aSourceID, aDestID: TID;
      aUseBatch: TSQLRestBatch=nil): boolean; overload;
    /// will delete the record associated with the current source and a specified Dest
    // - source ID is taken from the fSourceID field (set by TSQLRecord.Create)
    // - note that if the Source record has just been added, fSourceID is not
    // set, so this method will fail: please call the other overloaded method
    function ManyDelete(aClient: TSQLRest; aDestID: TID): boolean; overload;
    /// will retrieve the record associated with a particular Source/Dest pair
    // - will return TRUE if the pair was found
    // - in this case, all "through" columns are available in the TSQLRecordMany
    // field instance
    function ManySelect(aClient: TSQLRest; aSourceID, aDestID: TID): boolean; overload;
    /// will retrieve the record associated with the current source and a specified Dest
    // - source ID is taken from the fSourceID field (set by TSQLRecord.Create)
    // - note that if the Source record has just been added, fSourceID is not
    // set, so this method will fail: please call the other overloaded method
    function ManySelect(aClient: TSQLRest; aDestID: TID): boolean; overload;

    // get the SQL WHERE statement to be used to retrieve the associated
    // records according to a specified ID
    // - search for aID as Source ID if isDest is FALSE
    // - search for aID as Dest ID if isDest is TRUE
    // - the optional aAndWhereSQL parameter can be used to add any additional
    // condition to the WHERE statement (e.g. 'Salary>:(1000): AND Salary<:(2000):')
    // according to TSQLRecordMany properties - note that you should better use
    // such inlined parameters e.g. calling
    // ! FormatUTF8('Salary>? AND Salary<?',[],[1000,2000])
    function IDWhereSQL(aClient: TSQLRest; aID: TID; isDest: boolean;
      const aAndWhereSQL: RawUTF8=''): RawUTF8;
  end;

  /// a base record, with a JSON-logging capability
  // - used to store a log of events into a JSON text, easy to be displayed
  // with a TSQLTableToGrid
  // - this log can then be stored as a RawUTF8 field property into a result
  // record, for instance
  TSQLRecordLog = class(TSQLRecord)
  protected
    /// store the Log Table JSON content
    fLogTableStorage: TMemoryStream;
    /// used by Log() to add the value of OneLog to fLogTableStorage
    fLogTableWriter: TJSONSerializer;
    /// current internal row count
    fLogTableRowCount: integer;
    /// maximum rows count
    fMaxLogTableRowCount: integer;
  public
    /// initialize the internal storage with a supplied JSON content
    // - this JSON content must follow the format retrieved by
    // LogTableJSON and LogTableJSONFrom methods
    constructor CreateFrom(OneLog: TSQLRecord; const aJSON: RawUTF8);
    /// release the private fLogTableWriter and fLogTableStorage objects
    destructor Destroy; override;
    /// add the value of OneLog to the Log Table JSON content
    // - the ID property of the supplied OneLog record is incremented before adding
    procedure Log(OneLog: TSQLRecord);
    /// returns the JSON data as added by previous call to Log()
    // - JSON data is in not-expanded format
    // - this function can be called multiple times
    function LogTableJSON: RawUTF8;
    /// returns the internal position of the Log content
    // - use this value to later retrieve a log range with LogTableJSONFrom()
    function LogCurrentPosition: integer;
    /// returns the log JSON data from a given start position
    // - StartPosition was retrieved previously with LogCurrentPosition
    // - if StartPosition=0, the whole Log content is returned
    // - multiple instances of LogCurrentPosition/LogTableJSONFrom() can be
    // used at once
    function LogTableJSONFrom(StartPosition: integer): RawUTF8;
    /// the current associated Log Table rows count value
    // - is incremented every time Log() method is called
    // - will be never higher than MaxLogTableRowCount below (if set)
    property LogTableRowCount: integer read fLogTableRowCount;
    /// if the associated Log Table rows count reachs this value, the
    // first data row will be trimed
    // - do nothing is value is left to 0 (which is the default)
    // - total rows count won't never be higher than this value
    // - used to spare memory usage
    property MaxLogTableRowCount: integer read fMaxLogTableRowCount;
  end;

  /// common ancestor for tables with digitally signed RawUTF8 content
  // - content is signed according to a specific User Name and the digital
  // signature date and time
  // - internaly uses the very secure SHA-256 hashing algorithm for performing
  // the digital signature
  TSQLRecordSigned = class(TSQLRecord)
  protected
    /// time and date of signature
    fSignatureTime: TTimeLog;
    /// hashed signature
    fSignature: RawUTF8;
    function ComputeSignature(const UserName,Content: RawByteString): RawUTF8;
  public
    /// time and date of signature
    // - if the signature is invalid, this field will contain numerical 1 value
    // - this property is defined here to allow inherited to just declared the name
    // in its published section:
    // ! property SignatureTime;
    property SignatureTime: TTimeLog read fSignatureTime write fSignatureTime;
    /// as the Content of this record is added to the database,
    // its value is hashed and stored as 'UserName/03A35C92....' into this property
    // - secured SHA-256 hashing is used internaly
    // - digital signature is allowed only once: this property is written only once
    // - this property is defined here to allow inherited to just declared the name
    // in its published section:
    // ! property Signature;
    property Signature: RawUTF8 read fSignature write fSignature;
  public
    /// use this procedure to sign the supplied Content of this record for a
    // specified UserName, with the current Date and Time
    // - SHA-256 hashing is used internaly
    // - returns true if signed successfully (not already signed)
    function SetAndSignContent(const UserName: RawUTF8;
      const Content: RawByteString; ForcedSignatureTime: Int64=0): boolean;
    /// returns true if this record content is correct according to the
    // stored digital Signature
    function CheckSignature(const Content: RawByteString): boolean;
    /// retrieve the UserName who digitally signed this record
    // - returns '' if was not digitally signed
    function SignedBy: RawUTF8;
    /// reset the stored digital signature
    // - SetAndSignContent() can be called after this method
    procedure UnSign;
  end;

  /// a base record, which will have creation and modification timestamp fields
  TSQLRecordTimed = class(TSQLRecord)
  protected
    fCreated: TCreateTime;
    fModified: TModTime;
  published
    /// will be filled by the ORM when this item will be created in the database
    property Created: TCreateTime read fCreated write fCreated;
    /// will be filled by the ORM each time this item will be written in the database
    property Modified: TModTime read fModified write fModified;
  end;

  /// common ancestor for tables which should implement any interface
  // - by default, TSQLRecord does not implement any interface: this does make
  // sense for performance and resource use reasons
  // - inherit from this class if you want your class to implement the needed
  // IInterface methods (QueryInterface/AddRef/Release)
  TSQLRecordInterfaced = class(TSQLRecord, IInterface)
  protected
    fRefCount: Integer;
    {$ifdef FPC}
    function QueryInterface(
      {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID;
      out Obj): longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _AddRef: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _Release: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    {$else}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    {$endif}
  public
    class function NewInstance: TObject; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    property RefCount: Integer read fRefCount;
  end;

  /// the possible Server-side instance implementation patterns for
  // interface-based services
  // - each interface-based service will be implemented by a corresponding
  // class instance on the server: this parameter is used to define how
  // class instances are created and managed
  // - on the Client-side, each instance will be handled depending on the
  // server side implementation (i.e. with sicClientDriven behavior if necessary)
  // - sicSingle: one object instance is created per call - this is the
  // most expensive way of implementing the service, but is safe for simple
  // workflows (like a one-type call); this is the default setting for
  // TSQLRestServer.ServiceRegister method
  // - sicShared: one object instance is used for all incoming calls and is
  // not recycled subsequent to the calls - the implementation should be
  // thread-safe on the server side
  // - sicClientDriven: one object instance will be created in synchronization
  // with the client-side lifetime of the corresponding interface: when the
  // interface will be released on client, it will be released on the server
  // side - a numerical identifier will be transmitted for all JSON requests
  // - sicPerSession, sicPerUser and sicPerGroup modes will maintain one
  // object instance per running session / user / group (only working if
  // RESTful authentication is enabled) - since it may be shared among users or
  // groups, the sicPerUser and sicPerGroup implementation should be thread-safe
  // - sicPerThread will maintain one object instance per calling thread - it
  // may be useful instead of sicShared mode if the service process expects
  // some per-heavy thread initialization, for instance
  TServiceInstanceImplementation = (
    sicSingle, sicShared, sicClientDriven, sicPerSession, sicPerUser, sicPerGroup,
    sicPerThread);
  /// set of Server-side instance implementation patterns for
  // interface-based services
  TServiceInstanceImplementations = set of TServiceInstanceImplementation;

  /// handled kind of parameters for an interface-based service provider method
  // - we do not handle all kind of Delphi variables, but provide some
  // enhanced types handled by JSONToObject/ObjectToJSON functions (smvObject)
  // or TDynArray.LoadFromJSON / TTextWriter.AddDynArrayJSON methods (smvDynArray)
  // - records will be serialized as Base64 string, with our RecordSave/RecordLoad
  // low-level format by default, or as true JSON objects since Delphi 2010 or
  // after registration via a TTextWriter.RegisterCustomJSONSerializer call
  // - smvRawJSON will transmit the raw JSON content, without serialization
  TServiceMethodValueType = (
    smvNone,
    smvSelf,
    smvBoolean,
    smvEnum,
    smvSet,
    smvInteger,
    smvCardinal,
    smvInt64,
    smvDouble,
    smvDateTime,
    smvCurrency,
    smvRawUTF8,
    smvString,
    smvRawByteString,
    smvWideString,
    smvBinary,
    smvRecord,
    {$ifndef NOVARIANTS}
    smvVariant,
    {$endif}
    smvObject,
    smvRawJSON,
    smvDynArray,
    smvInterface);

  /// handled kind of parameters internal variables for an interface-based method
  // - reference-counted variables will have their own storage
  // - all non referenced-counted variables are stored within some 64-bit content
  // - smvVariant kind of parameter will be handled as a special smvvRecord
  TServiceMethodValueVar = (
    smvvNone, smvvSelf, smvv64, smvvRawUTF8, smvvString, smvvWideString,
    smvvRecord, smvvObject, smvvDynArray, smvvInterface);

  /// set of parameters for an interface-based service provider method
  TServiceMethodValueTypes = set of TServiceMethodValueType;

  /// handled kind of parameters direction for an interface-based service method
  // - IN, IN/OUT, OUT directions can be applied to arguments, and will
  // be available through our JSON-serialized remote access: smdVar and smdOut
  // kind of parameters will be returned within the "result": JSON array
  // - smdResult is used for a function method, to handle the returned value
  TServiceMethodValueDirection = (
    smdConst,
    smdVar,
    smdOut,
    smdResult);
  /// set of parameters direction for an interface-based service method
  TServiceMethodValueDirections = set of TServiceMethodValueDirection;

  /// set of low-level processing options at assembly level
  // - vIsString is included for smvRawUTF8, smvString, smvRawByteString and
  // smvWideString kind of parameter (smvRecord has it to false, even if they
  // are Base-64 encoded within the JSON content, and also smvVariant/smvRawJSON)
  // - vPassedByReference is included if the parameter is passed as reference
  // (i.e. defined as var/out, or is a record or a reference-counted type result)
  // - vIsObjArray is set if the dynamic array is a T*ObjArray, so should be
  // cleared with ObjArrClear() and not TDynArray.Clear
  // - vIsSPI indicates that the value contains some Sensitive Personal
  // Information (e.g. a bank card number or a plain password), which type has
  // been previously registered via TInterfaceFactory.RegisterUnsafeSPIType
  // so that low-level logging won't include such values
  // - vIsQword is set for ValueType=smvInt64 over a QWord unsigned 64-bit value
  // - vIsDynArrayString is set for ValueType=smvDynArray of string values
  // - vIsDateTimeMS is set for ValueType=smvDateTime and TDateTimeMS value
  TServiceMethodValueAsm = set of (vIsString, vPassedByReference,
    vIsObjArray, vIsSPI, vIsQword, vIsDynArrayString, vIsDateTimeMS);

  /// describe a service provider method argument
  {$ifdef USERECORDWITHMETHODS}TServiceMethodArgument = record
    {$else}TServiceMethodArgument = object{$endif}
  public
    /// the argument name, as declared in Delphi
    ParamName: PShortString;
    /// the type name, as declared in Delphi
    ArgTypeName: PShortString;
    /// the low-level RTTI information of this argument
    ArgTypeInfo: PTypeInfo;
    /// we do not handle all kind of Delphi variables
    ValueType: TServiceMethodValueType;
    /// the variable direction as defined at code level
    ValueDirection: TServiceMethodValueDirection;
    /// how the variable may be stored
    ValueVar: TServiceMethodValueVar;
    /// how the variable is to be passed at asm level
    ValueKindAsm: TServiceMethodValueAsm;
    /// byte offset in the CPU stack of this argument
    // - may be -1 if pure register parameter with no backup on stack (x86)
    InStackOffset: integer;
    /// used to specify if the argument is passed as register
    // - contains 0 if parameter is not a register
    // - contains 1 for EAX, 2 for EDX and 3 for ECX registers for x86
    // - contains 1 for RCX, 2 for RDX, 3 for R8, and
    // 4 for R9, with a backing store on the stack for x64
    // - contains 1 for R0, 2 R1 ... 4 for R3, with a backing store on the stack for arm
    // - contains 1 for X0, 2 X1 ... 8 for X7, with a backing store on the stack for aarch64
    RegisterIdent: integer;
    /// used to specify if a floating-point argument is passed as register
    // - contains always 0 for x86/x87
    // - contains 1 for XMM0, 2 for XMM1, ..., 4 for XMM3 for x64
    // - contains 1 for D0, 2 for D1, ..., 8 for D7 for armhf
    // - contains 1 for V0, 2 for V1, ..., 8 for V7 for aarch64
    FPRegisterIdent: integer;
    /// size (in bytes) of this argument on the stack
    SizeInStack: integer;
    /// size (in bytes) of this smvv64 ordinal value
    // - e.g. depending of the associated kind of enumeration
    SizeInStorage: integer;
    /// hexadecimal binary size (in bytes) of this smvv64 ordinal value
    // - set only if ValueType=smvBinary
    SizeInBinary: integer;
    /// index of the associated variable in the local array[ArgsUsedCount[]]
    // - for smdConst argument, contains -1 (no need to a local var: the value
    // will be on the stack only)
    IndexVar: integer;
    /// a TDynArray wrapper initialized properly for this smvDynArray
    DynArrayWrapper: TDynArray;
    {$ifndef FPC}
    /// set ArgTypeName and ArgTypeInfo values from RTTI
    procedure SetFromRTTI(var P: PByte);
    {$endif}
    /// serialize the argument into the TServiceContainer.Contract JSON format
    // - non standard types (e.g. clas, enumerate, dynamic array or record)
    // are identified by their type identifier - so contract does not extend
    // up to the content of such high-level structures
    procedure SerializeToContract(WR: TTextWriter);
    /// check if the supplied argument value is the default (e.g. 0, '' or null)
    function IsDefault(V: pointer): boolean;
    /// unserialize a JSON value into this argument
    function FromJSON(const MethodName: RawUTF8; var R: PUTF8Char; V: pointer;
      Error: PShortString{$ifndef NOVARIANTS}; DVO: TDocVariantOptions{$endif}): boolean;
    /// append the JSON value corresponding to this argument
    // - includes a pending ','
    procedure AddJSON(WR: TTextWriter; V: pointer;
      ObjectOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]);
    /// append the value corresponding to this argument as within a JSON string
    // - will escape any JSON string character, and include a pending ','
    procedure AddJSONEscaped(WR: TTextWriter; V: pointer);
    /// append the JSON value corresponding to this argument, from its text value
    // - includes a pending ','
    procedure AddValueJSON(WR: TTextWriter; const Value: RawUTF8);
    /// append the default JSON value corresponding to this argument
    // - includes a pending ','
    procedure AddDefaultJSON(WR: TTextWriter);
    /// convert a value into its JSON representation
    procedure AsJson(var DestValue: RawUTF8; V: pointer);
    {$ifndef NOVARIANTS}
    /// convert a value into its variant representation
    // - complex objects will be converted into a TDocVariant, after JSON
    // serialization: variant conversion options may e.g. be retrieve from
    // TInterfaceFactory.DocVariantOptions
    procedure AsVariant(var DestValue: variant; V: pointer;
      Options: TDocVariantOptions);
    /// add a value into a TDocVariant object or array
    // - Dest should already have set its Kind to either dvObject or dvArray
    procedure AddAsVariant(var Dest: TDocVariantData; V: pointer);
    /// normalize a value containing one input or output argument
    // - sets and enumerates will be translated to strings (also in embedded
    // objects and T*ObjArray)
    procedure FixValue(var Value: variant);
    /// normalize a value containing one input or output argument, and add
    // it to a destination variant Document
    // - sets and enumerates will be translated to strings (also in embedded
    // objects and T*ObjArray)
    procedure FixValueAndAddToObject(const Value: variant; var DestDoc: TDocVariantData);
    {$endif}
  end;

  /// pointer to a service provider method argument
  PServiceMethodArgument = ^TServiceMethodArgument;

  /// describe a service provider method arguments
  TServiceMethodArgumentDynArray = array of TServiceMethodArgument;

  /// callback called by TServiceMethodExecute to process an interface
  // callback parameter
  // - implementation should set the Obj local variable to an instance of
  // a fake class implementing the aParamInfo interface
  TServiceMethodExecuteCallback =
    procedure(var Par: PUTF8Char; ParamInterfaceInfo: PTypeInfo; out Obj) of object;

  /// how TServiceMethod.TServiceMethod method will return the generated document
  // - will return either a dvObject or dvArray TDocVariantData, depending on
  // the expected returned document layout
  // - returned content could be "normalized" (for any set or enumerate) if
  // Kind is pdvObjectFixed
  TServiceMethodParamsDocVariantKind = (pdvArray, pdvObject, pdvObjectFixed);

  /// describe an interface-based service provider method
  {$ifdef USERECORDWITHMETHODS}TServiceMethod = record
    {$else}TServiceMethod = object{$endif}
  public
    /// the method URI, i.e. the method name
    // - as declared in Delphi code, e.g. 'Add' for ICalculator.Add
    // - this property value is hashed internaly for faster access
    URI: RawUTF8;
    /// the method default result, formatted as a JSON array
    // - example of content may be '[]' for a procedure or '[0]' for a function
    // - any var/out and potential function result will be set as a JSON array
    // of values, with 0 for numerical values, "" for textual values,
    // false for booleans, [] for dynamic arrays, a void record serialized
    // as expected (including customized serialization) and null for objects
    DefaultResult: RawUTF8;
    /// the fully qualified dotted method name, including the interface name
    // - as used by TServiceContainerInterfaceMethod.InterfaceDotMethodName
    // - match the URI fullpath name, e.g. 'Calculator.Add'
    InterfaceDotMethodName: RawUTF8;
    /// method index in the original (non emulated) interface
    // - our custom methods start at index 3 (RESERVED_VTABLE_SLOTS), since
    // QueryInterface, _AddRef, and _Release are always defined by default
    // - so it maps TServiceFactory.Interface.Methods[ExecutionMethodIndex-3]
    ExecutionMethodIndex: byte;
    /// TRUE if the method is inherited from another parent interface
    IsInherited: boolean;
    /// the directions of arguments with vIsSPI defined in Args[].ValueKindAsm
    HasSPIParams: TServiceMethodValueDirections;
    /// is 0 for the root interface, 1..n for all inherited interfaces
    HierarchyLevel: byte;
    /// describe expected method arguments
    // - Args[0] always is smvSelf
    // - if method is a function, an additional smdResult argument is appended
    Args: TServiceMethodArgumentDynArray;
    /// the index of the result pseudo-argument in Args[]
    // - is -1 if the method is defined as a (not a function)
    ArgsResultIndex: shortint;
    /// the index of the first const / var argument in Args[]
    ArgsInFirst: shortint;
    /// the index of the last const / var argument in Args[]
    ArgsInLast: shortint;
    /// the index of the first var / out / result argument in Args[]
    ArgsOutFirst: shortint;
    /// the index of the last var / out / result argument in Args[]
    ArgsOutLast: shortint;
    /// the index of the last argument in Args[], excepting result
    ArgsNotResultLast: shortint;
    /// the index of the last var / out argument in Args[]
    ArgsOutNotResultLast: shortint;
    /// the number of const / var parameters in Args[]
    // - i.e. the number of elements in the input JSON array
    ArgsInputValuesCount: byte;
    /// the number of var / out parameters +  in Args[]
    // - i.e. the number of elements in the output JSON array or object
    ArgsOutputValuesCount: byte;
    /// true if the result is a TServiceCustomAnswer record
    // - that is, a custom Header+Content BLOB transfert, not a JSON object
    ArgsResultIsServiceCustomAnswer: boolean;
    /// true if there is a single input parameter as RawByteString/TSQLRawBlob
    // - TSQLRestRoutingREST.ExecuteSOAByInterface will identify binary input
    // with mime-type 'application/octet-stream' as expected
    ArgsInputIsOctetStream: boolean;
    /// the index of the first argument expecting manual stack initialization
    // - set if there is any smvObject,smvDynArray,smvRecord,smvInterface or
    // smvVariant
    ArgsManagedFirst: shortint;
    /// the index of the last argument expecting manual stack initialization
    // - set if there is any smvObject, smvDynArray, smvRecord, smvInterface or
    // smvVariant
    ArgsManagedLast: shortint;
    /// contains all used kind of arguments
    ArgsUsed: TServiceMethodValueTypes;
    /// contains the count of variables for all used kind of arguments
    ArgsUsedCount: array[TServiceMethodValueVar] of byte;
    /// needed CPU stack size (in bytes) for all arguments
    // - under x64, does not include the backup space for the four registers
    ArgsSizeInStack: cardinal;
    /// retrieve an argument index in Args[] from its name
    // - search is case insensitive
    // - if Input is TRUE, will search within const / var arguments
    // - if Input is FALSE, will search within var / out / result arguments
    // - returns -1 if not found
    function ArgIndex(ArgName: PUTF8Char; ArgNameLen: integer; Input: boolean): integer;
    /// find the next argument index in Args[]
    // - if Input is TRUE, will search within const / var arguments
    // - if Input is FALSE, will search within var / out / result arguments
    // - returns true if arg is the new value, false otherwise
    function ArgNext(var arg: integer; Input: boolean): boolean;
    /// convert parameters encoded as a JSON array into a JSON object
    // - if Input is TRUE, will handle const / var arguments
    // - if Input is FALSE, will handle var / out / result arguments
    function ArgsArrayToObject(P: PUTF8Char; Input: boolean): RawUTF8;
    /// convert parameters encoded as name=value or name='"value"' or name='{somejson}'
    // into a JSON object
    // - on Windows, use double-quotes ("") anywhere you expect single-quotes (")
    // - as expected e.g. from a command line tool
    // - if Input is TRUE, will handle const / var arguments
    // - if Input is FALSE, will handle var / out / result arguments
    function ArgsCommandLineToObject(P: PUTF8Char; Input: boolean;
      RaiseExceptionOnUnknownParam: boolean=false): RawUTF8;
    /// returns a dynamic array list of all parameter names
    // - if Input is TRUE, will handle const / var arguments
    // - if Input is FALSE, will handle var / out / result arguments
    function ArgsNames(Input: Boolean): TRawUTF8DynArray;
    {$ifndef NOVARIANTS}
    /// computes a TDocVariant containing the input or output arguments values
    // - Values[] should contain the input/output raw values as variant
    // - Kind will specify the expected returned document layout
    procedure ArgsValuesAsDocVariant(Kind: TServiceMethodParamsDocVariantKind;
      out Dest: TDocVariantData; const Values: TVariantDynArray; Input: boolean;
      Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]);
    /// normalize a TDocVariant containing the input or output arguments values
    // - "normalization" will ensure sets and enums are seralized as text
    // - if Input is TRUE, will handle const / var arguments
    // - if Input is FALSE, will handle var / out / result arguments
    procedure ArgsAsDocVariantFix(var ArgsObject: TDocVariantData; Input: boolean);
    /// convert a TDocVariant array containing the input or output arguments
    // values in order, into an object with named parameters
    // - here sets and enums will keep their current values, mainly numerical
    // - if Input is TRUE, will handle const / var arguments
    // - if Input is FALSE, will handle var / out / result arguments
    procedure ArgsAsDocVariantObject(const ArgsParams: TDocVariantData;
      var ArgsObject: TDocVariantData; Input: boolean);
    /// computes a TDocVariant containing the input or output arguments values
    // - Values[] should point to the input/output raw binary values, as stored
    // in TServiceMethodExecute.Values during execution
    procedure ArgsStackAsDocVariant(const Values: TPPointerDynArray;
      out Dest: TDocVariantData; Input: Boolean);
    {$endif}
  end;

  /// describe all mtehods of an interface-based service provider
  TServiceMethodDynArray = array of TServiceMethod;

  /// a pointer to an interface-based service provider method description
  // - since TInterfaceFactory instances are shared in a global list, we
  // can safely use such pointers in our code to refer to a particular method
  PServiceMethod = ^TServiceMethod;

  /// common ancestor for storing interface-based service execution statistics
  // - each call could be logged and monitored in the database
  // - TServiceMethodExecute could store all its calls in such a table
  // - enabled on server side via either TServiceFactoryServer.SetServiceLog or
  // TServiceContainerServer.SetServiceLog method
  TSQLRecordServiceLog = class(TSQLRecordNoCaseExtended)
  protected
    fMethod: RawUTF8;
    fInput: variant;
    fOutput: variant;
    fUser: integer;
    fSession: integer;
    fTime: TModTime;
    fMicroSec: integer;
    fIP: RawUTF8;
  public
    /// overriden method creating an index on the Method/MicroSec columns
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
  published
    /// the 'interface.method' identifier of this call
    // - this column will be indexed, for fast SQL queries, with the MicroSec
    // column (for performance tuning)
    property Method: RawUTF8 read fMethod write fMethod;
    /// the input parameters, as a JSON document
    // - will be stored in JSON_OPTIONS_FAST_EXTENDED format, i.e. with
    // shortened field names, for smaller TEXT storage
    // - content may be searched using JsonGet/JsonHas SQL functions on a
    // SQlite3 storage, or with direct document query under MongoDB/PostgreSQL
    property Input: variant read fInput write fInput;
    /// the output parameters, as a JSON document, including result: for a function
    // - will be stored in JSON_OPTIONS_FAST_EXTENDED format, i.e. with
    // shortened field names, for smaller TEXT storage
    // - content may be searched using JsonGet/JsonHas SQL functions on a
    // SQlite3 storage, or with direct document query under MongoDB/PostgreSQL
    property Output: variant read fOutput write fOutput;
    /// the Session ID, if there is any
    property Session: integer read fSession write fSession;
    /// the User ID, if there is an identified Session
    property User: integer read fUser write fUser;
    /// will be filled by the ORM when this record is written in the database
    property Time: TModTime read fTime write fTime;
    /// execution time of this method, in micro seconds
    property MicroSec: integer read fMicroSec write fMicroSec;
    /// if not localhost/127.0.0.1, the remote IP address
    property IP: RawUTF8 read fIP write fIP;
  end;

  /// execution statistics used for DB-based asynchronous notifications
  // - as used by TServiceFactoryClient.SendNotifications
  // - here, the Output column may contain the information about an error
  // occurred during process
  TSQLRecordServiceNotifications = class(TSQLRecordServiceLog)
  protected
    fSent: TTimeLog;
  public
    /// this overriden method will create an index on the 'Sent' column
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
    /// search for pending events since a supplied ID
    // - returns FALSE if no notification was found
    // - returns TRUE ad fill a TDocVariant array of JSON Objects, including
    // "ID": field, and Method as "MethodName": field
    class function LastEventsAsObjects(Rest: TSQLRest; LastKnownID: TID; Limit: integer;
      Service: TInterfaceFactory; out Dest: TDocVariantData;
      const MethodName: RawUTF8 = 'Method'; IDAsHexa: boolean = false): boolean;
    /// allows to convert the Input array into a proper single JSON Object
    // - "ID": field will be included, and Method as "MethodName": field
    function SaveInputAsObject(Service: TInterfaceFactory;
      const MethodName: RawUTF8 = 'Method'; IDAsHexa: boolean = false): variant; virtual;
    /// run FillOne and SaveInputAsObject into a TDocVariant array of JSON Objects
    // - "ID": field will be included, and Method as "MethodName": field
    procedure SaveFillInputsAsObjects(Service: TInterfaceFactory; out Dest: TDocVariantData;
      const MethodName: RawUTF8 = 'Method'; IDAsHexa: boolean = false);
  published
    /// when this notification has been sent
    // - equals 0 until it was actually notified
    property Sent: TTimeLog read fSent write fSent;
  end;

  TServiceMethodExecute = class;

  /// the current step of a TServiceMethodExecute.OnExecute call
  TServiceMethodExecuteEventStep = (smsUndefined, smsBefore, smsAfter, smsError);

  /// the TServiceMethodExecute.OnExecute signature
  TServiceMethodExecuteEvent = procedure(Sender: TServiceMethodExecute;
    Step: TServiceMethodExecuteEventStep) of object;

  /// execute a method of a TInterfacedObject instance, from/to JSON
  TServiceMethodExecute = class
  protected
    fMethod: PServiceMethod;
    fRawUTF8s: TRawUTF8DynArray;
    fStrings: TStringDynArray;
    fWideStrings: TWideStringDynArray;
    fRecords: array of TBytes;
    fInt64s: TInt64DynArray;
    fObjects: TObjectDynArray;
    fInterfaces: TPointerDynArray;
    fDynArrays: array of record
      Value: Pointer;
      Wrapper: TDynArray;
    end;
    fValues: TPPointerDynArray;
    fAlreadyExecuted: boolean;
    fTempTextWriter: TJSONSerializer;
    fOnExecute: array of TServiceMethodExecuteEvent;
    fBackgroundExecutionThread: TSynBackgroundThreadMethod;
    fOnCallback: TServiceMethodExecuteCallback;
    fOptions: TServiceMethodOptions;
    fServiceCustomAnswerHead: RawUTF8;
    fServiceCustomAnswerStatus: cardinal;
    fLastException: Exception;
    fInput: TDocVariantData;
    fOutput: TDocVariantData;
    fCurrentStep: TServiceMethodExecuteEventStep;
    fExecutedInstancesFailed: TRawUTF8DynArray;
    procedure BeforeExecute;
    procedure RawExecute(const Instances: PPointerArray; InstancesLast: integer); virtual;
    procedure AfterExecute;
  public
    /// initialize the execution instance
    constructor Create(aMethod: PServiceMethod);
    /// finalize the execution instance
    destructor Destroy; override;
    /// allow to hook method execution
    // - if optInterceptInputOutput is defined in Options, then Sender.Input/Output
    // fields will contain the execution data context when Hook is called
    procedure AddInterceptor(const Hook: TServiceMethodExecuteEvent);
    /// execute the corresponding method of weak IInvokable references
    // - will retrieve a JSON array of parameters from Par (as [1,"par2",3])
    // - will append a JSON array of results in Res, or set an Error message, or
    // a JSON object (with parameter names) in Res if ResultAsJSONObject is set
    // - if one Instances[] is supplied, any exception will be propagated (unless
    // optIgnoreException is set); if more than one Instances[] is supplied,
    // corresponding ExecutedInstancesFailed[] property will be filled with
    // the JSON serialized exception
    function ExecuteJson(const Instances: array of pointer; Par: PUTF8Char;
      Res: TTextWriter; Error: PShortString=nil; ResAsJSONObject: boolean=false): boolean;
    /// execute the corresponding method of one weak IInvokable reference
    // - exepect no output argument, i.e. no returned data, unless output is set
    // - this version will identify TInterfacedObjectFake implementations,
    // and will call directly fInvoke() if possible, to avoid JSON marshalling
    // - expect params value to be without [ ], just like TOnFakeInstanceInvoke
    function ExecuteJsonCallback(Instance: pointer; const params: RawUTF8;
      output: PRawUTF8): boolean;
    /// execute directly TInterfacedObjectFake.fInvoke()
    // - expect params value to be with [ ], just like ExecuteJson
    function ExecuteJsonFake(Instance: pointer; params: PUTF8Char): boolean;
    /// low-level direct access to the associated method information
    property Method: PServiceMethod read fMethod;
    /// low-level direct access to the current input/output parameter values
    // - you should not need to access this, but rather set
    // optInterceptInputOutput in Options, and read Input/Output content
    property Values: TPPointerDynArray read fValues;
    /// associated settings, as copied from TServiceFactoryServer.Options
    property Options: TServiceMethodOptions read fOptions write fOptions;
    /// the current state of the execution
    property CurrentStep: TServiceMethodExecuteEventStep
      read fCurrentStep write fCurrentStep;
    /// set from output TServiceCustomAnswer.Header result parameter
    property ServiceCustomAnswerHead: RawUTF8
      read fServiceCustomAnswerHead write fServiceCustomAnswerHead;
    /// set from output TServiceCustomAnswer.Status result parameter
    property ServiceCustomAnswerStatus: cardinal
      read fServiceCustomAnswerStatus write fServiceCustomAnswerStatus;
    /// set if optInterceptInputOutput is defined in TServiceFactoryServer.Options
    // - contains a dvObject with input parameters as "argname":value pairs
    // - this is a read-only property: you cannot change the input content
    property Input: TDocVariantData read fInput;
    /// set if optInterceptInputOutput is defined in TServiceFactoryServer.Options
    // - contains a dvObject with output parameters as "argname":value pairs
    // - this is a read-only property: you cannot change the output content
    property Output: TDocVariantData read fOutput;
    /// only set during AddInterceptor() callback execution, if Step is smsError
    property LastException: Exception read fLastException;
    /// reference to the background execution thread, if any
    property BackgroundExecutionThread: TSynBackgroundThreadMethod
      read fBackgroundExecutionThread;
    /// points e.g. to TSQLRestServerURIContext.ExecuteCallback
    property OnCallback: TServiceMethodExecuteCallback read fOnCallback;
    /// contains exception serialization after ExecuteJson of multiple instances
    // - follows the Instances[] order as supplied to RawExecute/ExecuteJson
    // - if only a single Instances[] is supplied, the exception will be
    // propagated to the caller, unless optIgnoreException option is defined
    // - if more than one Instances[] is supplied, any raised Exception will
    // be serialized using ObjectToJSONDebug(), or this property will be left
    // to its default nil content if no exception occurred
    property ExecutedInstancesFailed: TRawUTF8DynArray read fExecutedInstancesFailed;
    /// allow to use an instance-specific temporary TJSONSerializer
    function TempTextWriter: TJSONSerializer;
  end;

  /// a record type to be used as result for a function method for custom content
  // for interface-based services
  // - all answers are pure JSON object by default: using this kind of record
  // as result will allow a response of any type (e.g. binary, HTML or text)
  // - this kind of answer will be understood by our TServiceContainerClient
  // implementation, and it may be used with plain AJAX or HTML requests
  // (via POST), to retrieve some custom content
  TServiceCustomAnswer = record
    /// mandatory response type, as encoded in the HTTP header
    // - useful to set the response mime-type - see e.g. JSON_CONTENT_TYPE_HEADER_VAR
    // TEXT_CONTENT_TYPE_HEADER or BINARY_CONTENT_TYPE_HEADER constants or
    // GetMimeContentType() function
    // - in order to be handled as expected, this field SHALL be set to NOT ''
    // (otherwise TServiceCustomAnswer will be transmitted as raw JSON)
    Header: RawUTF8;
    /// the response body
    // - corresponding to the response type, as defined in Header
    Content: RawByteString;
    /// the HTTP response code
    // - if not overriden, will default to HTTP_SUCCESS = 200 on server side
    // - on client side, will always contain HTTP_SUCCESS = 200 on success,
    // or any error should be handled as expected by the caller (e.g. using
    // TServiceFactoryClient.GetErrorMessage for decoding REST/SOA errors)
    Status: cardinal;
  end;

  PServiceCustomAnswer = ^TServiceCustomAnswer;

  {$M+}
  /// abstract factory class allowing to call interface resolution in cascade
  // - you can inherit from this class to chain the TryResolve() calls so
  // that several kind of implementations may be asked by a TInjectableObject,
  // e.g. TInterfaceStub, TServiceContainer or TDDDRepositoryRestObjectMapping
  // - this will implement factory pattern, as a safe and thread-safe DI/IoC
  TInterfaceResolver = class
  protected
    /// override this method to resolve an interface from this instance
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; virtual; abstract;
    /// override this method check if this instance implements aInterface
    function Implements(aInterface: PTypeInfo): boolean; virtual; abstract;
  end;
  {$M-}

  /// abstract factory class targetting a single kind of interface
  TInterfaceResolverForSingleInterface = class(TInterfaceResolver)
  protected
    fInterfaceTypeInfo: PTypeInfo;
    fInterfaceAncestors: PTypeInfoDynArray;
    fInterfaceAncestorsImplementationEntry: TPointerDynArray;
    fImplementationEntry: PInterfaceEntry;
    fImplementation: TClassInstance;
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; override;
    function Implements(aInterface: PTypeInfo): boolean; override;
    function GetImplementationName: string;
    // main IoC/DI virtual method - call fImplementation.CreateNew by default
    function CreateInstance: TInterfacedObject; virtual;
  public
    /// this overriden constructor will check and store the supplied class
    // to implement an interface
    constructor Create(aInterface: PTypeInfo; aImplementation: TInterfacedObjectClass); overload;
    /// this overriden constructor will check and store the supplied class
    // to implement an interface by TGUID
    constructor Create(const aInterface: TGUID; aImplementation: TInterfacedObjectClass); overload;
    /// you can use this method to resolve the interface as a new instance
    function GetOneInstance(out Obj): boolean;
  published
    /// the class name which will implement each repository instance
    property ImplementationClass: string read GetImplementationName;
  end;

  TInterfaceStub = class;

  /// used to store a list of TInterfacedObject instances
  TInterfacedObjectObjArray = array of TInterfacedObject;

  /// used to store a list of TInterfaceResolver instances
  TInterfaceResolverObjArray = array of TInterfaceResolver;

  /// used to store a list of TInterfaceStub instances
  TInterfaceStubObjArray = array of TInterfaceStub;

  /// abstract factory class targetting any kind of interface
  // - you can inherit from this class to customize dependency injection (DI/IoC),
  // defining the resolution via InjectStub/InjectResolver/InjectInstance methods,
  // and doing the instance resolution using the overloaded Resolve*() methods
  // - TServiceContainer will inherit from this class, as the main entry point
  // for interface-based services of the framework (via TSQLRest.Services)
  // - you can use RegisterGlobal() class method to define some process-wide DI
  TInterfaceResolverInjected = class(TInterfaceResolver)
  protected
    fResolvers: TInterfaceResolverObjArray;
    fResolversToBeReleased: TInterfaceResolverObjArray;
    fDependencies: TInterfacedObjectObjArray;
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; override;
    function TryResolveInternal(aInterface: PTypeInfo; out Obj): boolean;
    function Implements(aInterface: PTypeInfo): boolean; override;
    class function RegisterGlobalCheck(aInterface: PTypeInfo;
      aImplementationClass: TClass): PInterfaceEntry;
  public
    /// define a global class type for interface resolution
    // - most of the time, you will need a local DI/IoC resolution list; but
    // you may use this method to register a set of shared and global resolution
    // patterns, common to the whole injection process
    // - by default, TAutoLocker and TLockedDocVariant will be registered by
    // this unit to implement IAutoLocker and ILockedDocVariant interfaces
    class procedure RegisterGlobal(aInterface: PTypeInfo;
      aImplementationClass: TInterfacedObjectClass); overload;
    /// define a global instance for interface resolution
    // - most of the time, you will need a local DI/IoC resolution list; but
    // you may use this method to register a set of shared and global resolution
    // patterns, common to the whole injection process
    // - the supplied instance will be owned by the global list (incrementing
    // its internal reference count), until it will be released via
    // ! RegisterGlobalDelete()
    // - the supplied instance will be freed in the finalization of this unit,
    // if not previously released via RegisterGlobalDelete()
    class procedure RegisterGlobal(aInterface: PTypeInfo;
      aImplementation: TInterfacedObject); overload;
    /// undefine a global instance for interface resolution
    // - you can unregister a given instance previously defined via
    // ! RegisterGlobal(aInterface,aImplementation)
    // - if you do not call RegisterGlobalDelete(), the remaning instances will
    // be freed in the finalization of this unit
    class procedure RegisterGlobalDelete(aInterface: PTypeInfo);
    /// prepare and setup interface DI/IoC resolution with some blank
    // TInterfaceStub specified by their TGUID
    procedure InjectStub(const aStubsByGUID: array of TGUID); overload; virtual;
    /// prepare and setup interface DI/IoC resolution with TInterfaceResolver
    // kind of factory
    // - e.g. a customized TInterfaceStub/TInterfaceMock, a TServiceContainer,
    // a TDDDRepositoryRestObjectMapping or any factory class
    // - by default, only TInterfaceStub/TInterfaceMock will be owned by this
    // instance, and released by Destroy - unless you set OwnOtherResolvers
    procedure InjectResolver(const aOtherResolvers: array of TInterfaceResolver;
      OwnOtherResolvers: boolean=false); overload; virtual;
    /// prepare and setup interface DI/IoC resolution from a TInterfacedObject instance
    // - any TInterfacedObject declared as dependency will have its reference
    // count increased, and decreased in Destroy
    procedure InjectInstance(const aDependencies: array of TInterfacedObject); overload; virtual;
    /// can be used to perform an DI/IoC for a given interface
    // - will search for the supplied interface to its internal list of resolvers
    // - returns TRUE and set the Obj variable with a matching instance
    // - can be used as such to resolve an ICalculator interface:
    // ! var calc: ICalculator;
    // ! begin
    // !   if Catalog.Resolve(TypeInfo(ICalculator),calc) then
    // !   ... use calc methods
    function Resolve(aInterface: PTypeInfo; out Obj): boolean; overload;
    /// can be used to perform an DI/IoC for a given interface
    // - you shall have registered the interface TGUID by a previous call to
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(ICalculator),...])
    // - returns TRUE and set the Obj variable with a matching instance
    // - can be used as such to resolve an ICalculator interface:
    // ! var calc: ICalculator;
    // ! begin
    // !   if ServiceContainer.Resolve(ICalculator,cal) then
    // !   ... use calc methods
    function Resolve(const aGUID: TGUID; out Obj): boolean; overload;
    /// can be used to perform several DI/IoC for a given set of interfaces
    // - here interfaces and instances are provided as TypeInfo,@Instance pairs
    // - raise an EServiceException if any interface can't be resolved, unless
    // aRaiseExceptionIfNotFound is set to FALSE
    procedure ResolveByPair(const aInterfaceObjPairs: array of pointer;
      aRaiseExceptionIfNotFound: boolean=true);
    /// can be used to perform several DI/IoC for a given set of interfaces
    // - here interfaces and instances are provided as TGUID and @Instance
    // - you shall have registered the interface TGUID by a previous call to
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(ICalculator),...])
    // - raise an EServiceException if any interface can't be resolved, unless
    // aRaiseExceptionIfNotFound is set to FALSE
    procedure Resolve(const aInterfaces: array of TGUID; const aObjs: array of pointer;
      aRaiseExceptionIfNotFound: boolean=true); overload;
    /// release all used instances
    // - including all TInterfaceStub instances as specified to Inject(aStubsByGUID)
    // - will call _Release on all TInterfacedObject dependencies
    destructor Destroy; override;
  end;

  /// any service implementation class could inherit from this class to
  // allow dependency injection aka SOLID DI/IoC by the framework
  // - once created, the framework will call AddResolver() member, so that its
  // Resolve*() methods could be used to inject any needed dependency for lazy
  // dependency resolution (e.g. within a public property getter)
  // - any interface published property will also be automatically injected
  // - if you implement a SOA service with this class, TSQLRestServer.Services
  // will be auto-injected via TServiceFactoryServer.CreateInstance()
  TInjectableObject = class(TInterfacedObjectWithCustomCreate)
  protected
    fResolver: TInterfaceResolver;
    fResolverOwned: Boolean;
    // DI/IoC resolution protected methods
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean;
    /// this method will resolve all interface published properties
    procedure AutoResolve(aRaiseEServiceExceptionIfNotFound: boolean);
  public
    /// initialize an instance, defining one or several mean of dependency resolution
    // - simple TInterfaceStub could be created directly from their TGUID,
    // then any kind of DI/IoC resolver instances could be specified, i.e.
    // either customized TInterfaceStub/TInterfaceMock, a TServiceContainer or
    // a TDDDRepositoryRestObjectMapping, and then any TInterfacedObject
    // instance will be used during dependency resolution:
    // ! procedure TMyTestCase.OneTestCaseMethod;
    // ! var Test: IServiceToBeTested;
    // ! begin
    // !   Test := TServiceToBeTested.CreateInjected(
    // !     [ICalculator],
    // !     [TInterfaceMock.Create(IPersistence,self).
    // !       ExpectsCount('SaveItem',qoEqualTo,1),
    // !      RestInstance.Services],
    // !     [AnyInterfacedObject]);
    // !   ...
    // - note that all the injected stubs/mocks instances will be owned by the
    // TInjectableObject, and therefore released with it
    // - any TInterfacedObject declared as dependency will have its reference
    // count increased, and decreased in Destroy
    // - once DI/IoC is defined, will call the AutoResolve() protected method
    constructor CreateInjected(const aStubsByGUID: array of TGUID;
      const aOtherResolvers: array of TInterfaceResolver;
      const aDependencies: array of TInterfacedObject;
      aRaiseEServiceExceptionIfNotFound: boolean=true); virtual;
    /// initialize an instance, defining one dependency resolver
    // - the resolver may be e.g. a TServiceContainer
    // - once the DI/IoC is defined, will call the AutoResolve() protected method
    // - as called by  TServiceFactoryServer.CreateInstance
    constructor CreateWithResolver(aResolver: TInterfaceResolver;
      aRaiseEServiceExceptionIfNotFound: boolean=true); virtual;
    /// can be used to perform an DI/IoC for a given interface type information
    procedure Resolve(aInterface: PTypeInfo; out Obj); overload;
    /// can be used to perform an DI/IoC for a given interface TGUID
    procedure Resolve(const aGUID: TGUID; out Obj); overload;
    /// can be used to perform several DI/IoC for a given set of interfaces
    // - here interfaces and instances are provided as TypeInfo,@Instance pairs
    procedure ResolveByPair(const aInterfaceObjPairs: array of pointer);
    /// can be used to perform several DI/IoC for a given set of interfaces
    // - here interfaces and instances are provided as TGUID and pointers
    procedure Resolve(const aInterfaces: array of TGUID; const aObjs: array of pointer); overload;
    /// release all used instances
    // - including all TInterfaceStub instances as specified to CreateInjected()
    destructor Destroy; override;
    /// access to the associated dependency resolver, if any
    property Resolver: TInterfaceResolver read fResolver;
  end;

  /// class-reference type (metaclass) of a TInjectableObject type
  TInjectableObjectClass = class of TInjectableObject;

  /// service implementation class, with direct access on the associated
  // TServiceFactoryServer/TSQLRestServer instances
  // - allow dependency injection aka SOLID DI/IoC by the framework using
  // inherited TInjectableObject.Resolve() methods
  // - allows direct access to the underlying ORM using its Server method
  // - this class will allow Server instance access outside the scope of
  // remote SOA execution, e.g. when a DI is performed on server side: it
  // is therefore a better alternative to ServiceContext.Factory,
  // ServiceContext.Factory.RestServer or ServiceContext.Request.Server
  TInjectableObjectRest = class(TInjectableObject)
  protected
    fFactory: TServiceFactoryServer;
    fServer: TSQLRestServer;
  public
    /// initialize an instance, defining associated dependencies
    // - the resolver may be e.g. a TServiceContainer
    // - once the DI/IoC is defined, will call the AutoResolve() protected method
    // - as called by  TServiceFactoryServer.CreateInstance
    constructor CreateWithResolverAndRest(aResolver: TInterfaceResolver;
      aFactory: TServiceFactoryServer; aServer: TSQLRestServer;
      aRaiseEServiceExceptionIfNotFound: boolean=true); virtual;
    /// access to the associated interface factory
    // - this property will be injected by TServiceFactoryServer.CreateInstance,
    // so may be nil if the instance was created outside the SOA context
    property Factory: TServiceFactoryServer read fFactory;
    /// access ot the associated REST Server, e.g. to its ORM methods
    // - slightly faster than Factory.RestServer
    // - this value will be injected by TServiceFactoryServer.CreateInstance,
    // so may be nil if the instance was created outside the SOA context
    property Server: TSQLRestServer read fServer;
  end;

  /// class-reference type (metaclass) of a TInjectableObjectRest type
  TInjectableObjectRestClass = class of TInjectableObjectRest;

  /// used to set the published properties of a TInjectableAutoCreateFields
  // - TInjectableAutoCreateFields.Create will check any resolver able to
  // implement this interface, then run its SetProperties() method on it
  IAutoCreateFieldsResolve = interface
    ['{396362E9-B60D-43D4-A0D4-802E4479F24E}']
    /// this method will be called once on any TInjectableAutoCreateFields just
    // created instance
    procedure SetProperties(Instance: TObject);
  end;

  /// abstract class which will auto-inject its dependencies (DI/IoC), and also
  // manage the instances of its TPersistent/TSynPersistent published properties
  // - abstract class able with a virtual constructor, dependency injection
  // (i.e. SOLID DI/IoC), and automatic memory management of all nested class
  // published properties
  // - will also release any T*ObjArray dynamic array storage of persistents,
  // previously registered via TJSONSerializer.RegisterObjArrayForJSON()
  // - this class is a perfect parent for any class storing data by value, and
  // dependency injection, e.g. DDD services or daemons
  // - note that non published (e.g. public) properties won't be instantiated
  // - please take care that you will not create any endless recursion: you
  // should ensure that at one level, nested published properties won't have any
  // class instance matching its parent type
  // - since the destructor will release all nested properties, you should
  // never store a reference of any of those nested instances outside
  // - if any associated resolver implements IAutoCreateFieldsResolve, its
  // SetProperties() method will be called on all created T*Persistent
  // published properties, so that it may initialize its values
  TInjectableAutoCreateFields = class(TInjectableObject)
  public
    /// this overriden constructor will instantiate all its nested
    // TPersistent/TSynPersistent/TSynAutoCreateFields class published properties
    // - then resolve and call IAutoCreateFieldsResolve.SetProperties(self)
    constructor Create; override;
    /// finalize the instance, and release its published properties
    destructor Destroy; override;
  end;

  /// event used by TInterfaceFactory to run a method from a fake instance
  // - aMethod will specify which method is to be executed
  // - aParams will contain the input parameters, encoded as a JSON array,
  // without the [ ] characters (e.g. '1,"arg2",3')
  // - shall return TRUE on success, or FALSE in case of failure, with
  // a corresponding explanation in aErrorMsg
  // - method results shall be serialized as JSON in aResult;  if
  // aServiceCustomAnswer is not nil, the result shall use this record
  // to set HTTP custom content and headers, and ignore aResult content
  // - aClientDrivenID can be set optionally to specify e.g. an URI-level session
  TOnFakeInstanceInvoke = function(const aMethod: TServiceMethod;
    const aParams: RawUTF8; aResult, aErrorMsg: PRawUTF8;
    aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean of object;

  /// event called when destroying a TInterfaceFactory's fake instance
  /// - this method will be run when the fake class instance is destroyed
  // (e.g. if aInstanceCreation is sicClientDriven, to notify the server
  // than the client life time just finished)
  TOnFakeInstanceDestroy = procedure(aClientDrivenID: cardinal) of object;

  /// may be used to store the Methods[] indexes of a TInterfaceFactory
  // - current implementation handles up to 128 methods, a limit above
  // which "Interface Segregation" principles is obviously broken
  TInterfaceFactoryMethodBits = set of 0..MAX_METHOD_COUNT-1;

  /// a dynamic array of TInterfaceFactory instances
  TInterfaceFactoryObjArray = array of TInterfaceFactory;

  /// class handling interface RTTI and fake implementation class
  // - a thread-safe global list of such class instances is implemented to cache
  // information for better speed: use class function TInterfaceFactory.Get()
  // and not manual TInterfaceFactory.Create / Free
  // - if you want to search the interfaces by name or TGUID, call once
  // Get(TypeInfo(IMyInterface)) or RegisterInterfaces() for proper registration
  // - will use TInterfaceFactoryRTTI classes generated from Delphi RTTI
  TInterfaceFactory = class
  protected
    fInterfaceTypeInfo: PTypeInfo;
    fInterfaceIID: TGUID;
    fMethodsCount: cardinal;
    fAddMethodsLevel: integer;
    fMethods: TServiceMethodDynArray;
    fMethod: TDynArrayHashed;
    // contains e.g. [{"method":"Add","arguments":[...]},{"method":"...}]
    fContract: RawUTF8;
    fInterfaceName: RawUTF8;
    fInterfaceURI: RawUTF8;
    {$ifndef NOVARIANTS}
    fDocVariantOptions: TDocVariantOptions;
    {$endif}
    fFakeVTable: array of pointer;
    fFakeStub: PByteArray;
    fMethodIndexCallbackReleased: Integer;
    fMethodIndexCurrentFrameCallback: Integer;
    procedure AddMethodsFromTypeInfo(aInterface: PTypeInfo); virtual; abstract;
    function GetMethodsVirtualTable: pointer;
  public
    /// this is the main entry point to the global interface factory cache
    // - access to this method is thread-safe
    // - this method will also register the class to further retrieval
    class function Get(aInterface: PTypeInfo): TInterfaceFactory; overload;
    /// retrieve an interface factory from cache, from its TGUID
    // - access to this method is thread-safe
    // - you shall have registered the interface by a previous call to the
    // overloaded Get(TypeInfo(IMyInterface)) method or RegisterInterfaces()
    // - if the supplied TGUID has not been previously registered, returns nil
    class function Get(const aGUID: TGUID): TInterfaceFactory; overload;
    /// retrieve an interface factory from cache, from its name (e.g. 'IMyInterface')
    // - access to this method is thread-safe
    // - you shall have registered the interface by a previous call to the
    // overloaded Get(TypeInfo(IMyInterface)) method or RegisterInterfaces()
    // - if the supplied TGUID has not been previously registered, returns nil
    class function Get(const aInterfaceName: RawUTF8): TInterfaceFactory; overload;
    /// register one or several interfaces to the global interface factory cache
    // - so that you can use TInterfaceFactory.Get(aGUID) or Get(aName)
    class procedure RegisterInterfaces(const aInterfaces: array of PTypeInfo);
    /// could be used to retrieve an array of TypeInfo() from their GUID
    class function GUID2TypeInfo(const aGUIDs: array of TGUID): PTypeInfoDynArray; overload;
    /// could be used to retrieve an array of TypeInfo() from their GUID
    class function GUID2TypeInfo(const aGUID: TGUID): PTypeInfo; overload;
    /// returns the list of all declared TInterfaceFactory
    // - as used by SOA and mocking/stubing features of this unit
    class function GetUsedInterfaces: TSynObjectListLocked;
    /// add some TInterfaceFactory instances from their GUID
    class procedure AddToObjArray(var Obj: TInterfaceFactoryObjArray;
       const aGUIDs: array of TGUID);
    /// register some TypeInfo() containing unsafe parameter values
    // - i.e. any RTTI type containing Sensitive Personal Information, e.g.
    // a bank card number or a plain password
    // - such values will force associated values to be ignored during loging,
    // as a more tuned alternative to optNoLogInput or optNoLogOutput
    class procedure RegisterUnsafeSPIType(const Types: array of pointer);

    /// initialize the internal properties from the supplied interface RTTI
    // - it will check and retrieve all methods of the supplied interface,
    // and prepare all internal structures for later use
    // - do not call this constructor directly, but TInterfaceFactory.Get()
    constructor Create(aInterface: PTypeInfo);
    /// find the index of a particular method in internal Methods[] list
    // - will search for a match against Methods[].URI property
    // - won't find the default AddRef/Release/QueryInterface methods
    // - will return -1 if the method is not known
    // - if aMethodName does not have an exact method match, it will try with a
    // trailing underscore, so that e.g. /service/start will match IService._Start()
    function FindMethodIndex(const aMethodName: RawUTF8): integer;
    /// find a particular method in internal Methods[] list
    // - just a wrapper around FindMethodIndex() returing a PServiceMethod
    // - will return nil if the method is not known
    function FindMethod(const aMethodName: RawUTF8): PServiceMethod;
    /// find the index of a particular interface.method in internal Methods[] list
    // - will search for a match against Methods[].InterfaceDotMethodName property
    // - won't find the default AddRef/Release/QueryInterface methods
    // - will return -1 if the method is not known
    function FindFullMethodIndex(const aFullMethodName: RawUTF8;
      alsoSearchExactMethodName: boolean=false): integer;
    /// find the index of a particular method in internal Methods[] list
    // - won't find the default AddRef/Release/QueryInterface methods
    // - will raise an EInterfaceFactoryException if the method is not known
    function CheckMethodIndex(const aMethodName: RawUTF8): integer; overload;
    /// find the index of a particular method in internal Methods[] list
    // - won't find the default AddRef/Release/QueryInterface methods
    // - will raise an EInterfaceFactoryException if the method is not known
    function CheckMethodIndex(aMethodName: PUTF8Char): integer; overload;
    /// returns the method name from its method index
    // - the method index should start at 0 for _free_/_contract_/_signature_
    // pseudo-methods, and start at index 3 for real Methods[]
    function GetMethodName(MethodIndex: integer): RawUTF8;
    /// set the Methods[] indexes bit from some methods names
    // - won't find the default AddRef/Release/QueryInterface methods
    // - will raise an EInterfaceFactoryException if the method is not known
    procedure CheckMethodIndexes(const aMethodName: array of RawUTF8; aSetAllIfNone: boolean;
      out aBits: TInterfaceFactoryMethodBits);
    /// returns the full 'Interface.MethodName' text, from a method index
    // - the method index should start at 0 for _free_/_contract_/_signature_
    // pseudo-methods, and start at index 3 for real Methods[]
    // - will return plain 'Interface' text, if aMethodIndex is incorrect
    function GetFullMethodName(aMethodIndex: integer): RawUTF8;
    /// the declared internal methods
    // - list does not contain default AddRef/Release/QueryInterface methods
    // - nor the _free_/_contract_/_signature_ pseudo-methods
    property Methods: TServiceMethodDynArray read fMethods;
    /// the number of internal methods
    // - does not include the default AddRef/Release/QueryInterface methods
    // - nor the _free_/_contract_/_signature_ pseudo-methods
    property MethodsCount: cardinal read fMethodsCount;
    /// identifies a CallbackReleased() method in this interface
    // - i.e. the index in Methods[] of the following signature:
    // ! procedure CallbackReleased(const callback: IInvokable; const interfaceName: RawUTF8);
    // - this method will be called e.g. by TInterfacedCallback.Destroy, when
    // a callback is released on the client side so that you may be able e.g. to
    // unsubscribe the callback from an interface list (via InterfaceArrayDelete)
    // - contains -1 if no such method do exist in the interface definition
    property MethodIndexCallbackReleased: Integer read fMethodIndexCallbackReleased;
    /// identifies a CurrentFrame() method in this interface
    // - i.e. the index in Methods[] of the following signature:
    // ! procedure CurrentFrame(isLast: boolean);
    // - this method will be called e.g. by TSQLHttpClientWebsockets.CallbackRequest
    // for interface callbacks in case of WebSockets jumbo frames, to allow e.g.
    // faster database access via a batch
    // - contains -1 if no such method do exist in the interface definition
    property MethodIndexCurrentFrameCallback: Integer read fMethodIndexCurrentFrameCallback;
    /// the registered Interface low-level Delphi RTTI type
    property InterfaceTypeInfo: PTypeInfo read fInterfaceTypeInfo;
    /// the registered Interface GUID
    property InterfaceIID: TGUID read fInterfaceIID;
    /// the interface name, without its initial 'I'
    // - e.g. ICalculator -> 'Calculator'
    property InterfaceURI: RawUTF8 read fInterfaceURI write fInterfaceURI;
    {$ifndef NOVARIANTS}
    /// how this interface will work with variants (including TDocVariant)
    // - by default, contains JSON_OPTIONS_FAST for best performance - i.e.
    // [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]
    property DocVariantOptions: TDocVariantOptions
      read fDocVariantOptions write fDocVariantOptions;
    {$endif}
  published
    /// will return the interface name, e.g. 'ICalculator'
    // - published property to be serializable as JSON e.g. for debbuging info
    property InterfaceName: RawUTF8 read fInterfaceName;
  end;

  {$ifdef HASINTERFACERTTI}

  /// class handling interface RTTI and fake implementation class
  // - this class only exists for Delphi 6 and up, since FPC does not generate
  // the expected RTTI - see http://bugs.freepascal.org/view.php?id=26774
  TInterfaceFactoryRTTI = class(TInterfaceFactory)
  protected
    procedure AddMethodsFromTypeInfo(aInterface: PTypeInfo); override;
  end;

  {$endif HASINTERFACERTTI}

  {$M+}
  /// how TInterfacedObjectFromFactory will perform its execution
  // - by default, fInvoke() will receive standard JSON content, unless
  // ifoJsonAsExtended is set, and extended JSON is used
  // - ifoDontStoreVoidJSON will ensure objects and records won't include
  // default void fields in JSON serialization
  TInterfacedObjectFromFactoryOption = (ifoJsonAsExtended, ifoDontStoreVoidJSON);
  /// defines how TInterfacedObjectFromFactory will perform its execution
  TInterfacedObjectFromFactoryOptions = set of TInterfacedObjectFromFactoryOption;

  /// abstract class handling a generic interface implementation class
  TInterfacedObjectFromFactory = class(TInterfacedObject)
  protected
    fFactory: TInterfaceFactory;
    fOptions: TInterfacedObjectFromFactoryOptions;
    fInvoke: TOnFakeInstanceInvoke;
    fNotifyDestroy: TOnFakeInstanceDestroy;
    fClientDrivenID: Cardinal;
  public
    /// create an instance, using the specified interface
    constructor Create(aFactory: TInterfaceFactory;
      aOptions: TInterfacedObjectFromFactoryOptions;
      aInvoke: TOnFakeInstanceInvoke; aNotifyDestroy: TOnFakeInstanceDestroy);
    /// release the remote server instance (in sicClientDriven mode);
    destructor Destroy; override;
  published
    /// the associated interface factory class
    property Factory: TInterfaceFactory read fFactory;
    /// the ID used in sicClientDriven mode
    property ClientDrivenID: Cardinal read fClientDrivenID;
  end;
  {$M-}

  /// class handling interface implementation generated from source
  // - this class targets FPC, which does not generate the expected RTTI - see
  // http://bugs.freepascal.org/view.php?id=26774
  // - mORMotWrapper.pas will generate a new inherited class, overriding abstract
  // AddMethodsFromTypeInfo() to define the interface methods
  TInterfaceFactoryGenerated = class(TInterfaceFactory)
  protected
    fTempStrings: TRawUTF8DynArray;
    /// the overriden AddMethodsFromTypeInfo() method will call e.g. as
    // ! AddMethod('Add',[
    // !   0,'n1',TypeInfo(Integer),
    // !   0,'n2',TypeInfo(Integer),
    // !   3,'Result',TypeInfo(Integer)]);
    // with 0=ord(smdConst) and 3=ord(smdResult)
    procedure AddMethod(const aName: RawUTF8; const aParams: array of const); virtual;
  public
    /// register one interface type definition from the current class
    // - will be called by mORMotWrapper.pas generated code, in initialization
    // section, so that the needed type information will be available
    class procedure RegisterInterface(aInterface: PTypeInfo); virtual;
  end;

  /// abstract parameters used by TInterfaceStub.Executes() events callbacks
  TOnInterfaceStubExecuteParamsAbstract = class
  protected
    fSender: TInterfaceStub;
    fMethod: PServiceMethod;
    fParams: RawUTF8;
    fEventParams: RawUTF8;
    fResult: RawUTF8;
    fFailed: boolean;
    function GetSenderAsMockTestCase: TSynTestCase;
  public
    /// constructor of one parameters marshalling instance
    constructor Create(aSender: TInterfaceStub; aMethod: PServiceMethod;
      const aParams,aEventParams: RawUTF8); virtual;
    /// call this method if the callback implementation failed
    procedure Error(const aErrorMessage: RawUTF8); overload;
    /// call this method if the callback implementation failed
    procedure Error(const Format: RawUTF8; const Args: array of const); overload;
    /// the stubbing / mocking generator
    property Sender: TInterfaceStub read fSender;
    /// the mocking generator associated test case
    // - will raise an exception if the associated Sender generator is not
    // a TInterfaceMock
    property TestCase: TSynTestCase read GetSenderAsMockTestCase;
    /// pointer to the method which is to be executed
    property Method: PServiceMethod read fMethod;
    /// a custom message, defined at TInterfaceStub.Executes() definition
    property EventParams: RawUTF8 read fEventParams;
    /// outgoing values array encoded as JSON
    // - every var, out parameter or the function result shall be encoded as
    // a JSON array into this variable, in the same order than the stubbed
    // method declaration
    // - use Returns() method to create the JSON array directly, from an array
    // of values
    property Result: RawUTF8 read fResult;
    /// low-level flag, set to TRUE if one of the Error() method was called
    property Failed: boolean read fFailed;
  end;

{$ifndef NOVARIANTS}
  /// parameters used by TInterfaceStub.Executes() events callbacks as Variant
  // - this class will expect input and output parameters to specified as
  // variant arrays properties, so is easier (and a bit slower) than the
  // TOnInterfaceStubExecuteParamsJSON class
  TOnInterfaceStubExecuteParamsVariant = class(TOnInterfaceStubExecuteParamsAbstract)
  protected
    fInput: TVariantDynArray;
    fOutput: TVariantDynArray;
    function GetInput(Index: Integer): variant;
    procedure SetOutput(Index: Integer; const Value: variant);
    function GetInNamed(const aParamName: RawUTF8): variant;
    procedure SetOutNamed(const aParamName: RawUTF8; const Value: variant);
    function GetInUTF8(const ParamName: RawUTF8): RawUTF8;
    procedure SetResultFromOutput;
  public
    /// constructor of one parameters marshalling instance
    constructor Create(aSender: TInterfaceStub; aMethod: PServiceMethod;
      const aParams,aEventParams: RawUTF8); override;
    /// returns the input parameters as a TDocVariant object or array
    function InputAsDocVariant(Kind: TServiceMethodParamsDocVariantKind;
      Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]): variant;
    /// returns the output parameters as a TDocVariant object or array
    function OutputAsDocVariant(Kind: TServiceMethodParamsDocVariantKind;
      Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]): variant;
    {$ifdef WITHLOG}
    /// log the input or output parameters to a log instance
    procedure AddLog(aLog: TSynLogClass; aOutput: boolean; aLevel: TSynLogInfo=sllTrace);
    {$endif}
    /// input parameters when calling the method
    // - order shall follow the method const and var parameters
    // ! Stub.Add(10,20) -> Input[0]=10, Input[1]=20
    // - if the supplied Index is out of range, an EInterfaceStub will be raised
    property Input[Index: Integer]: variant read GetInput;
    /// output parameters returned after method process
    // - order shall follow the method var, out parameters and the function
    // result (if method is not a procedure)
    // - if the supplied Index is out of range, an EInterfaceStub will be raised
    // - can be used as such:
    // !  procedure TFooTestCase.ExecuteBar(Ctxt: TOnInterfaceStubExecuteParamsVariant);
    // !  begin // Input[0]=i
    // !    Ctxt.Output[0] := Ctxt.Input[0]+1;  // i := i+1;
    // !    Ctxt.Output[1] := 42;               // result := 42;
    // !  end; // Output|0]=i, Output[1]=result
    // to emulate this native implementation:
    // ! function Bar(var i: Integer): Integer;
    // ! begin
    // !    inc(i);
    // !    result := 42;
    // !  end;
    // - consider using the safest Named[] property, to avoid parameters
    // index matching issue
    // - if an Output[]/Named[] item is not set, a default value will be used
    property Output[Index: Integer]: variant write SetOutput;
    /// access to input/output parameters when calling the method
    // - if the supplied name is incorrect, an EInterfaceStub will be raised
    // - is a bit slower than Input[]/Output[] indexed properties, but easier
    // to work with, and safer in case of method signature change (like parameter
    // add or rename)
    // - marked as default property, so you can use it e.g. as such:
    // !  procedure TFooTestCase.ExecuteBar(Ctxt: TOnInterfaceStubExecuteParamsVariant);
    // !  begin
    // !    Ctxt['i'] := Ctxt['i']+1;  // i := i+1;
    // !    Ctxt['result'] := 42;      // result := 42;
    // !  end;
    // to emulate this native implementation:
    // ! function Bar(var i: Integer): Integer;
    // ! begin
    // !    inc(i);
    // !    result := 42;
    // !  end;
    // - using this default Named[] property is recommended over the index-based
    // Output[] property
    // - if an Output[]/Named[] item is not set, a default value will be used
    property Named[const ParamName: RawUTF8]: variant read GetInNamed write SetOutNamed; default;
    /// access to UTF-8 input parameters when calling the method
    // - if the supplied name is incorrect, an EInterfaceStub will be raised
    // - is a bit slower than Input[]/Output[] indexed properties, but easier
    // to work with, and safer in case of method signature change (like parameter
    // add or rename)
    // - slightly easier to use Ctxt.UTF8['str'] than ToUTF8(Ctxt.Named['str'])
    property UTF8[const ParamName: RawUTF8]: RawUTF8 read GetInUTF8;
  end;
{$endif NOVARIANTS}

  /// parameters used by TInterfaceStub.Executes() events callbacks as JSON
  // - this class will expect input and output parameters to be encoded as
  // JSON arrays, so is faster than TOnInterfaceStubExecuteParamsVariant
  TOnInterfaceStubExecuteParamsJSON = class(TOnInterfaceStubExecuteParamsAbstract)
  public
    /// a method to return an array of values into Result
    // - just a wrapper around JSONEncodeArrayOfConst([...])
    // - can be used as such:
    // !  procedure TFooTestCase.ExecuteBar(var Ctxt: TOnInterfaceStubExecuteParamsJSON);
    // !  begin // Ctxt.Params := '[i]' -> Ctxt.Result := '[i+1,42]'
    // !    Ctxt.Returns([GetInteger(pointer(Ctxt.Params))+1,42]);
    // !  end;
    // to emulate this native implementation:
    // ! function Bar(var i: Integer): Integer;
    // ! begin
    // !    inc(i);
    // !    result := 42;
    // !  end;
    procedure Returns(const Values: array of const); overload;
    /// a method to return a JSON array of values into Result
    // - expected format is e.g. '[43,42]'
    procedure Returns(const ValuesJsonArray: RawUTF8); overload;
    /// incoming parameters array encoded as JSON array without braces
    // - order follows the method const and var parameters
    // ! Stub.Add(10,20) -> Params = '10,20';
    property Params: RawUTF8 read fParams;
  end;

{$ifndef NOVARIANTS}
  /// event called by the TInterfaceStub.Executes() fluent method for variant process
  // - by default Ctxt.Result shall contain the default JSON array result for
  // this method - use Ctxt.Named[] default properties, e.g. as
  // ! Ctxt['result'] := Ctxt['n1']-Ctxt['n2'];
  // or with Input[] / Output[] properties:
  // ! with Ctxt do Output[0] := Input[0]-Input[1];
  // - you can call Ctxt.Error() to notify the caller for an execution error
  TOnInterfaceStubExecuteVariant = procedure(Ctxt: TOnInterfaceStubExecuteParamsVariant) of object;
{$endif NOVARIANTS}

  /// event called by the TInterfaceStub.Executes() fluent method for JSON process
  // - by default Ctxt.Result shall contain the default JSON array result for
  // this method - use Ctxt.Named[] default properties, e.g. as
  // !  P := pointer(Ctxt.Params);
  // !  Ctxt.Returns([GetNextItemDouble(P)-GetNextItemDouble(P)]);
  // - you can call Ctxt.Error() to notify the caller for an execution error
  TOnInterfaceStubExecuteJSON = procedure(Ctxt: TOnInterfaceStubExecuteParamsJSON) of object;

  /// diverse types of stubbing / mocking rules
  // - isUndefined is the first, since it will be a ExpectsCount() weak rule
  // which may be overwritten by the other real run-time rules
  TInterfaceStubRuleKind =
    (isUndefined, isExecutesJSON, {$ifndef NOVARIANTS}isExecutesVariant, {$endif}
     isRaises, isReturns, isFails);

  /// define a mocking / stubing rule used internaly by TInterfaceStub
  TInterfaceStubRule = record
    /// optional expected parameters, serialized as a JSON array
    // - if equals '', the rule is not parametrized - i.e. it will be the
    // default for this method
    Params: RawUTF8;
    /// values associated to the rule
    // - for TInterfaceStub.Executes(), is the aEventParams parameter transmitted
    // to Execute event handler (could be used to e.g. customize the handler)
    // - for TInterfaceStub.Raises(), is the Exception.Message associated
    // to one ExceptionClass
    // - for TInterfaceStub.Returns(), is the returned result, serialized as a
    // JSON array (including var / out parameters then any function result)
    // - for TInterfaceStub.Fails() is the returned error message for
    // TInterfaceStub exception or TInterfaceMock associated test case
    Values: RawUTF8;
    /// the type of this rule
    // - isUndefined is used for a TInterfaceStub.ExpectsCount() weak rule
    Kind: TInterfaceStubRuleKind;
    /// the event handler to be executed
    // - for TInterfaceStub.Executes(), Values is transmitted as aResult parameter
    // - either a TOnInterfaceStubExecuteJSON, or a TOnInterfaceStubExecuteVariant
    Execute: TMethod;
    /// the exception class to be raised
    // - for TInterfaceStub.Raises(), Values contains Exception.Message
    ExceptionClass: ExceptClass;
    /// the number of times this rule has been executed
    RulePassCount: cardinal;
    /// comparison operator set by TInterfaceStub.ExpectsCount()
    // - only qoEqualTo..qoGreaterThanOrEqualTo are relevant here
    ExpectedPassCountOperator: TSQLQueryOperator;
    /// expected pass count value set by TInterfaceStub.ExpectsCount()
    // - value to be compared to the number of times this rule has been executed
    // - TInterfaceStub/TInterfaceMock will check it in their Destroy destructor,
    // using the comparison stated by ExpectedPassCountOperator
    ExpectedPassCount: cardinal;
    /// log trace value set by TInterfaceStub.ExpectsTrace()
    // - value to be compared to the Hash32() value of the execution log trace
    // - TInterfaceStub/TInterfaceMock will check it in their Destroy destructor,
    // using the fLogs[] content
    ExpectedTraceHash: cardinal;
  end;

  /// define the rules for a given method as used internaly by TInterfaceStub
  {$ifdef USERECORDWITHMETHODS}TInterfaceStubRules = record
    {$else}TInterfaceStubRules = object{$endif}
  public
    /// the mocking / stubing rules associated to this method
    Rules: array of TInterfaceStubRule;
    /// index in Rules[] of the default rule, i.e. the one with Params=''
    DefaultRule: integer;
    /// the number of times this method has been executed
    MethodPassCount: cardinal;
    /// find a rule index from its Params content
    function FindRuleIndex(const aParams: RawUTF8): integer;
    /// find a strong rule index from its Params content
    function FindStrongRuleIndex(const aParams: RawUTF8): integer;
    /// register a rule
    procedure AddRule(Sender: TInterfaceStub; aKind: TInterfaceStubRuleKind;
      const aParams, aValues: RawUTF8; const aEvent: TNotifyEvent=nil;
      aExceptionClass: ExceptClass=nil;
      aExpectedPassCountOperator: TSQLQueryOperator=qoNone; aValue: cardinal=0);
  end;

  /// diverse options available to TInterfaceStub
  // - by default, method execution stack is not recorded - include
  // imoLogMethodCallsAndResults in the options to track all method calls
  // and the returned values; note that ExpectsTrace() method will set it
  // - by default, TInterfaceStub will be released when the stubed/mocked
  // interface is released - include imoFakeInstanceWontReleaseTInterfaceStub
  // in the options to force manual memory handling of TInterfaceStubs
  // - by default, all interfaces will return some default values, unless
  // imoRaiseExceptionIfNoRuleDefined or imoReturnErrorIfNoRuleDefined is
  // included in the options
  // - by default, any TInterfaceMock.Fails() rule execution will notify the
  // TSynTestCase, unless imoMockFailsWillPassTestCase which will let test pass
  TInterfaceStubOption = (
    imoLogMethodCallsAndResults,
    imoFakeInstanceWontReleaseTInterfaceStub,
    imoRaiseExceptionIfNoRuleDefined,
    imoReturnErrorIfNoRuleDefined,
    imoMockFailsWillPassTestCase);

  /// set of options available to TInterfaceStub
  TInterfaceStubOptions = set of TInterfaceStubOption;

  /// every potential part of TInterfaceStubLog.AddAsText() log entry
  TInterfaceStubLogLayout = (wName, wParams, wResults);

  /// set the output layout of TInterfaceStubLog.AddAsText() log entry
  TInterfaceStubLogLayouts = set of TInterfaceStubLogLayout;

  /// used to keep track of one stubbed method call
  {$ifdef USERECORDWITHMETHODS}TInterfaceStubLog = record
    {$else}TInterfaceStubLog = object{$endif}
  public
    /// call timestamp, in milliseconds
    // - is filled with GetTickCount64() API returned value
    Timestamp64: Int64;
    /// set to TRUE if this calls failed
    // - i.e. if EInterfaceFactoryException was raised for TInterfaceStub, or
    // if TInterfaceMock did notify its associated TSynTestCase via a Check()
    // - CustomResults/Results will contain the error message
    WasError: boolean;
    /// the method called
    // - a pointer to the existing information in shared TInterfaceFactory
    Method: PServiceMethod;
    /// the parameters at execution call, as JSON CSV (i.e. array without [ ])
    Params: RawUTF8;
    /// any non default result returned after execution
    // - if not set (i.e. if equals ''), Method^.DefaultResult has been returned
    // - if WasError is TRUE, always contain the error message
    CustomResults: RawUTF8;
    /// the result returned after execution
    // - this method will return Method^.DefaultResult if CustomResults=''
    function Results: RawUTF8;
    /// append the log in textual format
    // - typical output is as such:
    // $ Add(10,20)=[30],
    // or, if WasError is TRUE:
    // $ Divide(20,0) error "divide by zero",
    procedure AddAsText(WR: TTextWriter; aScope: TInterfaceStubLogLayouts;
      SepChar: AnsiChar=',');
  end;

  /// used to keep track of all stubbed methods calls
  TInterfaceStubLogDynArray = array of TInterfaceStubLog;

  /// used to stub an interface implementation
  // - define the expected workflow in a fluent interface using Executes /
  // Fails / Returns / Raises
  // - this class will be inherited by TInterfaceMock which will contain some
  // additional methods dedicated to mocking behavior (e.g. including in tests)
  // - each instance of this class will be owned by its generated fake
  // implementation class (retrieved at constructor out parameter): when the
  // stubed/mocked interface is freed, its associated TInterfaceStub will be
  // freed - so you do not need to protect TInterfaceStub.Create with a
  // try..finally clause, since it will be released when no more needed
  // - inherits from TInterfaceResolver so match TInjectableObject expectations
  TInterfaceStub = class(TInterfaceResolver)
  protected
    fInterface: TInterfaceFactory;
    fRules: array of TInterfaceStubRules;
    fOptions: TInterfaceStubOptions;
    fHasExpects: set of (eCount,eTrace);
    fLogs: TInterfaceStubLogDynArray;
    fLog: TDynArray;
    fLogCount: integer;
    fInterfaceExpectedTraceHash: cardinal;
    fLastInterfacedObjectFake: TInterfacedObject;
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; override;
    function Implements(aInterface: PTypeInfo): boolean; override;
    procedure InternalGetInstance(out aStubbedInterface); virtual;
    function InternalCheck(aValid,aExpectationFailed: boolean;
      const aErrorMsgFmt: RawUTF8; const aErrorMsgArgs: array of const): boolean; virtual;
    // match TOnFakeInstanceInvoke callback signature
    function Invoke(const aMethod: TServiceMethod;
      const aParams: RawUTF8; aResult, aErrorMsg: PRawUTF8;
      aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean;
    // will launch InternalCheck() process if some expectations defined by
    // ExpectsCount() are not met, i.e. raise an exception for TInterfaceStub
    // or notify the associated test case for TInterfaceMock
    procedure InstanceDestroyed(aClientDrivenID: cardinal);
    procedure IntSetOptions(Options: TInterfaceStubOptions); virtual;
    procedure IntCheckCount(aMethodIndex, aComputed: cardinal; aOperator: TSQLQueryOperator; aCount: cardinal);
    function IntGetLogAsText(asmndx: integer; const aParams: RawUTF8;
      aScope: TInterfaceStubLogLayouts; SepChar: AnsiChar): RawUTF8;
    function GetLogHash: cardinal;
    procedure OnExecuteToLog(Ctxt: TOnInterfaceStubExecuteParamsVariant);
  public
    /// low-level internal constructor
    // - you should not call this method, but the overloaded alternatives
    constructor Create(aFactory: TInterfaceFactory;
      const aInterfaceName: RawUTF8); reintroduce; overload; virtual;
    /// initialize an interface stub from TypeInfo(IMyInterface)
    // - assign the fake class instance to a stubbed interface variable:
    // !var I: ICalculator;
    // !  TInterfaceStub.Create(TypeInfo(ICalculator),I);
    // !  Check(I.Add(10,20)=0,'Default result');
    constructor Create(aInterface: PTypeInfo; out aStubbedInterface); reintroduce; overload;
    /// initialize an interface stub from an interface GUID
    // - you shall have registered the interface by a previous call to
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...])
    // - once registered, create and use the fake class instance as such:
    // !var I: ICalculator;
    // !  TInterfaceStub.Create(ICalculator,I);
    // !  Check(I.Add(10,20)=0,'Default result');
    // - if the supplied TGUID has not been previously registered, raise an Exception
    constructor Create(const aGUID: TGUID; out aStubbedInterface); reintroduce; overload;
    /// initialize an interface stub from an interface name (e.g. 'IMyInterface')
    // - you shall have registered the interface by a previous call to
    // TInterfaceFactory.Get(TypeInfo(IMyInterface)) or RegisterInterfaces([])
    // - if the supplied name has not been previously registered, raise an Exception
    constructor Create(const aInterfaceName: RawUTF8; out aStubbedInterface); reintroduce; overload;
    /// prepare an interface stub from TypeInfo(IMyInterface) for later injection
    // - create several TInterfaceStub instances for a given TInjectableObject
    // ! procedure TMyTestCase.OneTestCaseMethod;
    // ! var Test: IServiceToBeTested;
    // ! begin
    // !   Test := TServiceToBeTested.CreateInjected([],
    // !     TInterfaceStub.Create(TypeInfo(ICalculator)),
    // !     TInterfaceMock.Create(TypeInfo(IPersistence),self).
    // !       ExpectsCount('SaveItem',qoEqualTo,1)]);
    constructor Create(aInterface: PTypeInfo); reintroduce; overload;
    /// prepare an interface stub from a given TGUID for later injection
    // - you shall have registered the interface by a previous call to
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...])
    // - then create TInterfaceStub instances for a given TInjectableObject:
    // ! procedure TMyTestCase.OneTestCaseMethod;
    // ! var Test: IServiceToBeTested;
    // ! begin
    // !   Test := TServiceToBeTested.CreateInjected(
    // !     [IMyInterface],
    // !     TInterfaceMock.Create(IPersistence,self).
    // !       ExpectsCount('SaveItem',qoEqualTo,1)]);
    constructor Create(const aGUID: TGUID); reintroduce; overload;

    /// add an execution rule for a given method, with JSON marshalling
    // - optional aEventParams parameter will be transmitted to aEvent handler
    // - raise an Exception if the method name does not exist for this interface
    function Executes(const aMethodName: RawUTF8;
      aEvent: TOnInterfaceStubExecuteJSON; const aEventParams: RawUTF8=''): TInterfaceStub; overload;
    /// add an execution rule for a given method and a set of parameters,
    // with JSON marshalling
    // - if execution context matches the supplied aParams value, aEvent is triggered
    // - optional aEventParams parameter will be transmitted to aEvent handler
    // - raise an Exception if the method name does not exist for this interface
    function Executes(const aMethodName, aParams: RawUTF8;
      aEvent: TOnInterfaceStubExecuteJSON; const aEventParams: RawUTF8=''): TInterfaceStub; overload;
    /// add an execution rule for a given method and a set of parameters,
    // with JSON marshalling
    // - if execution context matches the supplied aParams value, aEvent is triggered
    // - optional aEventParams parameter will be transmitted to aEvent handler
    // - raise an Exception if the method name does not exist for this interface
    function Executes(const aMethodName: RawUTF8; const aParams: array of const;
      aEvent: TOnInterfaceStubExecuteJSON; const aEventParams: RawUTF8=''): TInterfaceStub; overload;
{$ifndef NOVARIANTS}
    /// add an execution rule for a given method, with Variant marshalling
    // - optional aEventParams parameter will be transmitted to aEvent handler
    // - raise an Exception if the method name does not exist for this interface
    function Executes(const aMethodName: RawUTF8;
      aEvent: TOnInterfaceStubExecuteVariant; const aEventParams: RawUTF8=''): TInterfaceStub; overload;
    /// add an execution rule for a given method and a set of parameters,
    // with Variant marshalling
    // - if execution context matches the supplied aParams value, aEvent is triggered
    // - optional aEventParams parameter will be transmitted to aEvent handler
    // - raise an Exception if the method name does not exist for this interface
    function Executes(const aMethodName, aParams: RawUTF8;
      aEvent: TOnInterfaceStubExecuteVariant; const aEventParams: RawUTF8=''): TInterfaceStub; overload;
    /// add an execution rule for a given method and a set of parameters,
    // with Variant marshalling
    // - if execution context matches the supplied aParams value, aEvent is triggered
    // - optional aEventParams parameter will be transmitted to aEvent handler
    // - raise an Exception if the method name does not exist for this interface
    function Executes(const aMethodName: RawUTF8; const aParams: array of const;
      aEvent: TOnInterfaceStubExecuteVariant; const aEventParams: RawUTF8=''): TInterfaceStub; overload;
    /// add an execution rule for all methods, with Variant marshalling
    // - optional aEventParams parameter will be transmitted to aEvent handler
    // - callback's Ctxt: TOnInterfaceStubExecuteParamsVariant's Method field
    // will identify the executed method
    function Executes(aEvent: TOnInterfaceStubExecuteVariant; const aEventParams: RawUTF8=''): TInterfaceStub; overload;
    /// will add execution rules for all methods to log the input parameters
    // - aKind will define how the input parameters are serialized in JSON
    function Executes(aLog: TSynLogClass; aLogLevel: TSynLogInfo;
       aKind: TServiceMethodParamsDocVariantKind): TInterfaceStub; overload;
{$endif}

    /// add an exception rule for a given method
    // - will create and raise the specified exception for this method
    // - raise an Exception if the method name does not exist for this interface
    function Raises(const aMethodName: RawUTF8;
      aException: ExceptClass; const aMessage: string): TInterfaceStub; overload;
    /// add an exception rule for a given method and a set of parameters
    // - will create and raise the specified exception for this method, if the
    // execution context matches the supplied aParams value
    // - raise an Exception if the method name does not exist for this interface
    function Raises(const aMethodName, aParams: RawUTF8;
      aException: ExceptClass; const aMessage: string): TInterfaceStub; overload;
    /// add an exception rule for a given method and a set of parameters
    // - will create and raise the specified exception for this method, if the
    // execution context matches the supplied aParams value
    // - raise an Exception if the method name does not exist for this interface
    function Raises(const aMethodName: RawUTF8; const aParams: array of const;
      aException: ExceptClass; const aMessage: string): TInterfaceStub; overload;

    /// add an evaluation rule for a given method
    // - aExpectedResults JSON array will be returned to the caller
    // - raise an Exception if the method name does not exist for this interface
    function Returns(const aMethodName, aExpectedResults: RawUTF8): TInterfaceStub; overload;
    /// add an evaluation rule for a given method
    // - aExpectedResults will be returned to the caller after conversion to
    // a JSON array
    // - raise an Exception if the method name does not exist for this interface
    function Returns(const aMethodName: RawUTF8; const aExpectedResults: array of const): TInterfaceStub; overload;
    /// add an evaluation rule for a given method and a set of parameters
    // - aExpectedResults JSON array will be returned to the caller
    // - raise an Exception if the method name does not exist for this interface
    function Returns(const aMethodName, aParams, aExpectedResults: RawUTF8): TInterfaceStub; overload;
    /// add an evaluation rule for a given method and a set of parameters
    // - aExpectedResults JSON array will be returned to the caller
    // - raise an Exception if the method name does not exist for this interface
    function Returns(const aMethodName: RawUTF8;
      const aParams, aExpectedResults: array of const): TInterfaceStub; overload;

    /// add an error rule for a given method
    // - an error will be returned to the caller, with aErrorMsg as message
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function Fails(const aMethodName, aErrorMsg: RawUTF8): TInterfaceStub; overload;
    /// add an error rule for a given method and a set of parameters
    // - an error will be returned to the caller, with aErrorMsg as message
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function Fails(const aMethodName, aParams, aErrorMsg: RawUTF8): TInterfaceStub; overload;
    /// add an error rule for a given method and a set of parameters
    // - an error will be returned to the caller, with aErrorMsg as message
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function Fails(const aMethodName: RawUTF8; const aParams: array of const;
      const aErrorMsg: RawUTF8): TInterfaceStub; overload;

    /// add a pass count expectation rule for a given method
    // - those rules will be evaluated at Destroy execution
    // - only qoEqualTo..qoGreaterThanOrEqualTo are relevant here
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsCount(const aMethodName: RawUTF8; aOperator: TSQLQueryOperator;
      aValue: cardinal): TInterfaceStub; overload;
    /// add a pass count expectation rule for a given method and a set of parameters
    // - those rules will be evaluated at Destroy execution
    // - only qoEqualTo..qoGreaterThanOrEqualTo are relevant here
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsCount(const aMethodName, aParams: RawUTF8; aOperator: TSQLQueryOperator;
      aValue: cardinal): TInterfaceStub; overload;
    /// add a pass count expectation rule for a given method and a set of parameters
    // - those rules will be evaluated at Destroy execution
    // - only qoEqualTo..qoGreaterThanOrEqualTo are relevant here
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsCount(const aMethodName: RawUTF8; const aParams: array of const;
      aOperator: TSQLQueryOperator; aValue: cardinal): TInterfaceStub; overload;

    /// add a hash-based execution expectation rule for the whole interface
    // - those rules will be evaluated at Destroy execution
    // - supplied aValue is a Hash32() of the trace in LogAsText format
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    function ExpectsTrace(aValue: cardinal): TInterfaceStub; overload;
    /// add a hash-based execution expectation rule for a given method
    // - those rules will be evaluated at Destroy execution
    // - supplied aValue is a Hash32() of the trace in LogAsText format
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsTrace(const aMethodName: RawUTF8; aValue: cardinal): TInterfaceStub; overload;
    /// add a hash-based execution expectation rule for a given method
    // and a set of parameters
    // - those rules will be evaluated at Destroy execution
    // - supplied aValue is a Hash32() of the trace in LogAsText format
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsTrace(const aMethodName, aParams: RawUTF8;
      aValue: cardinal): TInterfaceStub; overload;
    /// add a hash-based execution expectation rule for a given method
    // and a set of parameters
    // - those rules will be evaluated at Destroy execution
    // - supplied aValue is a Hash32() of the trace in LogAsText format
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsTrace(const aMethodName: RawUTF8; const aParams: array of const;
      aValue: cardinal): TInterfaceStub; overload;
    /// add a JSON-based execution expectation rule for the whole interface
    // - those rules will be evaluated at Destroy execution
    // - supplied aValue is the trace in LogAsText format
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    function ExpectsTrace(const aValue: RawUTF8): TInterfaceStub; overload;
    /// add a JSON-based execution expectation rule for a given method
    // - those rules will be evaluated at Destroy execution
    // - supplied aValue is the trace in LogAsText format
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsTrace(const aMethodName, aValue: RawUTF8): TInterfaceStub; overload;
    /// add a JSON-based execution expectation rule for a given method
    // and a set of parameters
    // - those rules will be evaluated at Destroy execution
    // - supplied aValue is the trace in LogAsText format
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsTrace(const aMethodName, aParams, aValue: RawUTF8): TInterfaceStub; overload;
    /// add a JSON-based execution expectation rule for a given method
    // and a set of parameters
    // - those rules will be evaluated at Destroy execution
    // - supplied aValue is the trace in LogAsText format
    // - it will raise EInterfaceFactoryException for TInterfaceStub, but
    // TInterfaceMock will push the failure to the associated test case
    // - raise an Exception if the method name does not exist for this interface
    function ExpectsTrace(const aMethodName: RawUTF8; const aParams: array of const;
      const aValue: RawUTF8): TInterfaceStub; overload;

    /// set the optional stubing/mocking options
    // - same as the Options property, but in a fluent-style interface
    function SetOptions(Options: TInterfaceStubOptions): TInterfaceStub;
    /// reset the internal trace
    // - Log, LogAsText, LogHash and LogCount will be initialized
    procedure ClearLog;

    /// the stubbed method execution trace items
    property Log: TInterfaceStubLogDynArray read fLogs;
    /// the stubbed method execution trace converted as text
    // - typical output is a list of calls separated by commas:
    // $ Add(10,20)=[30],Divide(20,0) error "divide by zero"
    function LogAsText(SepChar: AnsiChar=','): RawUTF8;
    /// returns the last created TInterfacedObject instance
    // - e.g. corresponding to the out aStubbedInterface parameter of Create()
    property LastInterfacedObjectFake: TInterfacedObject read fLastInterfacedObjectFake;
  published
    /// access to the registered Interface RTTI information
    property InterfaceFactory: TInterfaceFactory read fInterface;
    /// optional stubing/mocking options
    // - you can use the SetOptions() method in a fluent-style interface
    property Options: TInterfaceStubOptions read fOptions write IntSetOptions;
    /// the stubbed method execution trace number of items
    property LogCount: Integer read fLogCount;
    /// the stubbed method execution trace converted as one numerical hash
    // - returns Hash32(LogAsText)
    property LogHash: cardinal read GetLogHash;
  end;

  /// used to mock an interface implementation via expect-run-verify pattern
  // - TInterfaceStub will raise an exception on Fails(), ExpectsCount() or
  // ExpectsTrace() rule activation, but TInterfaceMock will call
  // TSynTestCase.Check() with no exception with such rules, as expected by
  // a mocked interface
  // - this class will follow the expect-run-verify pattern, i.e. expectations
  // are defined before running the test, and verification is performed
  // when the instance is released - use TInterfaceMockSpy if you prefer the
  // more explicit run-verify pattern
  TInterfaceMock = class(TInterfaceStub)
  protected
    fTestCase: TSynTestCase;
    function InternalCheck(aValid,aExpectationFailed: boolean;
      const aErrorMsgFmt: RawUTF8; const aErrorMsgArgs: array of const): boolean; override;
  public
    /// initialize an interface mock from TypeInfo(IMyInterface)
    // - aTestCase.Check() will be called in case of mocking failure
    // ! procedure TMyTestCase.OneTestCaseMethod;
    // ! var Persist: IPersistence;
    // ! ...
    // !   TInterfaceMock.Create(TypeInfo(IPersistence),Persist,self).
    // !     ExpectsCount('SaveItem',qoEqualTo,1)]);
    constructor Create(aInterface: PTypeInfo; out aMockedInterface;
      aTestCase: TSynTestCase); reintroduce; overload;
    /// initialize an interface mock from an interface TGUID
    // - aTestCase.Check() will be called during validation of all Expects*()
    // - you shall have registered the interface by a previous call to
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IPersistence),...])
    // - once registered, create and use the fake class instance as such:
    // !procedure TMyTestCase.OneTestCaseMethod;
    // !var Persist: IPersistence;
    // ! ...
    // !   TInterfaceMock.Create(IPersistence,Persist,self).
    // !     ExpectsCount('SaveItem',qoEqualTo,1)]);
    // - if the supplied TGUID has not been previously registered, raise an Exception
    constructor Create(const aGUID: TGUID; out aMockedInterface;
      aTestCase: TSynTestCase); reintroduce; overload;
    /// initialize an interface mock from an interface name (e.g. 'IMyInterface')
    // - aTestCase.Check() will be called in case of mocking failure
    // - you shall have registered the interface by a previous call to
    // TInterfaceFactory.Get(TypeInfo(IMyInterface)) or RegisterInterfaces()
    // - if the supplied name has not been previously registered, raise an Exception
    constructor Create(const aInterfaceName: RawUTF8; out aMockedInterface;
      aTestCase: TSynTestCase); reintroduce; overload;
    /// initialize an interface mock from TypeInfo(IMyInterface) for later injection
    // - aTestCase.Check() will be called in case of mocking failure
    constructor Create(aInterface: PTypeInfo; aTestCase: TSynTestCase); reintroduce; overload;
    /// initialize an interface mock from TypeInfo(IMyInterface) for later injection
    // - aTestCase.Check() will be called in case of mocking failure
    constructor Create(const aGUID: TGUID; aTestCase: TSynTestCase); reintroduce; overload;
    /// the associated test case
    property TestCase: TSynTestCase read fTestCase;
  end;

  /// how TInterfaceMockSpy.Verify() shall generate the calls trace
  TInterfaceMockSpyCheck = (chkName, chkNameParams, chkNameParamsResults);

  /// used to mock an interface implementation via run-verify pattern
  // - this class will implement a so called "test-spy" mocking pattern, i.e.
  // no expectation is to be declared at first, but all calls are internally
  // logged (i.e. it force imoLogMethodCallsAndResults option to be defined),
  // and can afterwards been check via Verify() calls
  TInterfaceMockSpy = class(TInterfaceMock)
  protected
    procedure IntSetOptions(Options: TInterfaceStubOptions); override;
  public
    /// this will set and force imoLogMethodCallsAndResults option as needed
    // - you should not call this method, but the overloaded alternatives
    constructor Create(aFactory: TInterfaceFactory;
      const aInterfaceName: RawUTF8); override;
    /// check that a method has been called a specify number of times
    procedure Verify(const aMethodName: RawUTF8;
      aOperator: TSQLQueryOperator=qoGreaterThan; aCount: cardinal=0); overload;
    /// check a method calls count with a set of parameters
    // - parameters shall be defined as a JSON array of values
    procedure Verify(const aMethodName, aParams: RawUTF8;
      aOperator: TSQLQueryOperator=qoGreaterThan; aCount: cardinal=0); overload;
    /// check a method calls count with a set of parameters
    // - parameters shall be defined as a JSON array of values
    procedure Verify(const aMethodName: RawUTF8; const aParams: array of const;
      aOperator: TSQLQueryOperator=qoGreaterThan; aCount: cardinal=0); overload;
    /// check an execution trace for the global interface
    // - text trace format shall follow method calls, e.g.
    // ! Verify('Multiply,Add',chkName);
    // or may include parameters:
    // ! Verify('Multiply(10,30),Add(2,35)',chkNameParams);
    // or include parameters and function results:
    // ! Verify('Multiply(10,30)=[300],Add(2,35)=[37]',chkNameParamsResults);
    procedure Verify(const aTrace: RawUTF8; aScope: TInterfaceMockSpyCheck); overload;
    /// check an execution trace for a specified method
    // - text trace format will follow specified scope, e.g.
    // ! Verify('Add','(10,30),(2,35)',chkNameParams);
    // or include parameters and function results:
    // ! Verify('Add','(10,30)=[300],(2,35)=[37]',chkNameParamsResults);
    // - if aMethodName does not exists or aScope=chkName, will raise an exception
    procedure Verify(const aMethodName, aTrace: RawUTF8; aScope: TInterfaceMockSpyCheck); overload;
    /// check an execution trace for a specified method and parameters
    // - text trace format shall contain only results, e.g.
    // ! Verify('Add','2,35','[37]');
    procedure Verify(const aMethodName, aParams, aTrace: RawUTF8); overload;
    /// check an execution trace for a specified method and parameters
    // - text trace format shall contain only results, e.g.
    // ! Verify('Add',[2,35],'[37]');
    procedure Verify(const aMethodName: RawUTF8; const aParams: array of const;
      const aTrace: RawUTF8); overload;
  end;

  {$M+}
  /// an abstract service provider, as registered in TServiceContainer
  // - each registered interface has its own TServiceFactory instance, available
  // as one TSQLServiceContainer item from TSQLRest.Services property
  // - this will be either implemented by a registered TInterfacedObject on the
  // server, or by a on-the-fly generated fake TInterfacedObject class
  // communicating via JSON on a client
  // - TSQLRestServer will have to register an interface implementation as:
  // ! Server.ServiceRegister(TServiceCalculator,[TypeInfo(ICalculator)],sicShared);
  // - TSQLRestClientURI will have to register an interface remote access as:
  // ! Client.ServiceRegister([TypeInfo(ICalculator)],sicShared));
  // note that the implementation (TServiceCalculator) remain on the server side
  // only: the client only needs the ICalculator interface
  // - then TSQLRestServer and TSQLRestClientURI will both have access to the
  // service, via their Services property, e.g. as:
  // !var I: ICalculator;
  // !...
  // ! if Services.Info(ICalculator).Get(I) then
  // !   result := I.Add(10,20);
  // which is in practice to be used with the faster wrapper method:
  // ! if Services.Resolve(ICalculator,I) then
  // !   result := I.Add(10,20);
  TServiceFactory = class
  protected
    fInterface: TInterfaceFactory;
    fInterfaceURI: RawUTF8;
    fInterfaceMangledURI: RawUTF8;
    fInstanceCreation: TServiceInstanceImplementation;
    fRest: TSQLRest;
    fSharedInstance: TInterfacedObject;
    fContract: RawUTF8;
    fContractHash: RawUTF8;
    fContractExpected: RawUTF8;
    // per-method execution rights
    fExecution: array of TServiceFactoryExecution;
    /// union of all fExecution[].Options
    fAnyOptions: TServiceMethodOptions;
    procedure ExecutionAction(const aMethod: array of RawUTF8;
      aOptions: TServiceMethodOptions; aAction: TServiceMethodOptionsAction);
    function GetInterfaceTypeInfo: PTypeInfo;
      {$ifdef HASINLINE}inline;{$endif}
    function GetInterfaceIID: TGUID;
      {$ifdef HASINLINE}inline;{$endif}
  public
    /// initialize the service provider parameters
    // - it will check and retrieve all methods of the supplied interface,
    // and prepare all internal structures for its serialized execution
    constructor Create(aRest: TSQLRest; aInterface: PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation;
      const aContractExpected: RawUTF8);
    /// retrieve an instance of this interface
    // - this virtual method will be overridden to reflect the expected
    // behavior of client or server side
    // - can be used as such to resolve an I: ICalculator interface:
    // ! var I: ICalculator;
    // ! begin
    // !   if fClient.Services.Info(TypeInfo(ICalculator)).Get(I) then
    // !   ... use I
    function Get(out Obj): Boolean; virtual; abstract;
    /// retrieve the published signature of this interface
    // - is always available on TServiceFactoryServer, but TServiceFactoryClient
    // will be able to retrieve it only if TServiceContainerServer.PublishSignature
    // is set to TRUE (which is not the default setting, for security reasons)
    function RetrieveSignature: RawUTF8; virtual; abstract;
    /// the associated RESTful instance
    property Rest: TSQLRest read fRest;
    /// access to the registered Interface RTTI information
    property InterfaceFactory: TInterfaceFactory read fInterface;
    /// the registered Interface low-level Delphi RTTI type
    // - just maps InterfaceFactory.InterfaceTypeInfo
    property InterfaceTypeInfo: PTypeInfo read GetInterfaceTypeInfo;
    /// the registered Interface GUID
    // - just maps InterfaceFactory.InterfaceIID
    property InterfaceIID: TGUID read GetInterfaceIID;
    (*/ the service contract, serialized as a JSON object
    - a "contract" is in fact the used interface signature, i.e. its
      implementation mode (InstanceCreation) and all its methods definitions
    - a possible value for a one-method interface defined as such:
    ! function ICalculator.Add(n1,n2: integer): integer;
    may be returned as the following JSON object:
    $ {"contract":"Calculator","implementation":"shared",
    $  "methods":[{"method":"Add",
    $  "arguments":[{"argument":"Self","direction":"in","type":"self"},
    $               {"argument":"n1","direction":"in","type":"integer"},
    $               {"argument":"n2","direction":"in","type":"integer"},
    $               {"argument":"Result","direction":"out","type":"integer"}
    $ ]}]} *)
    property Contract: RawUTF8 read fContract;
    /// the published service contract, as expected by both client and server
    // - by default, will contain ContractHash property value (for security)
    // - but you can override this value using plain Contract or any custom
    // value (e.g. a custom version number) - in this case, both TServiceFactoryClient
    // and TServiceFactoryServer instances must have a matching ContractExpected
    // - this value is returned by a '_contract_' pseudo-method name, with the URI:
    // $ POST /root/Interface._contract_
    // or (if TSQLRestRoutingJSON_RPC is used):
    // $ POST /root/Interface
    // $ (...)
    // $ {"method":"_contract_","params":[]}
    // (e.g. to be checked in TServiceFactoryClient.Create constructor)
    // - if set to SERVICE_CONTRACT_NONE_EXPECTED (i.e. '*'), the client won't
    // check and ask the server contract for consistency: it may be used e.g.
    // for accessing a plain REST HTTP server which is not based on mORMot,
    // so may not implement POST /root/Interface._contract_
    property ContractExpected: RawUTF8 read fContractExpected write fContractExpected;
  published
    /// the registered Interface URI
    // - in fact this is the Interface name without the initial 'I', e.g.
    // 'Calculator' for ICalculator
    property InterfaceURI: RawUTF8 read fInterfaceURI;
    /// the registered Interface mangled URI
    // - in fact this is encoding the GUID using BinToBase64URI(), e.g.
    // ! ['{c9a646d3-9c61-4cb7-bfcd-ee2522c8f633}'] into '00amyWGct0y_ze4lIsj2Mw'
    // - can be substituted to the clear InterfaceURI name
    property InterfaceMangledURI: RawUTF8 read fInterfaceMangledURI;
    /// how each class instance is to be created
    // - only relevant on the server side; on the client side, this class will
    // be accessed only to retrieve a remote access instance, i.e. sicSingle
    property InstanceCreation: TServiceInstanceImplementation read fInstanceCreation;
    /// a hash of the service contract, serialized as a JSON string
    // - this may be used instead of the JSON signature, to enhance security
    // (i.e. if you do not want to publish the available methods, but want
    // to check for the proper synchronization of both client and server)
    // - a possible value may be: "C351335A7406374C"
    property ContractHash: RawUTF8 read fContractHash;
  end;
  {$M-}

  /// server-side service provider uses this to store one internal instance
  // - used by TServiceFactoryServer in sicClientDriven, sicPerSession,
  // sicPerUser or sicPerGroup mode
  {$ifdef USERECORDWITHMETHODS}TServiceFactoryServerInstance = record
    {$else}TServiceFactoryServerInstance = object{$endif}
  public
    /// the internal Instance ID, as remotely sent in "id":1
    // - is set to 0 when an entry in the array is free
    InstanceID: PtrUInt;
    /// GetTickCount64() timestamp corresponding to the last access of
    // this instance
    LastAccess64: Int64;
    /// the associated client session
    Session: cardinal;
    /// the implementation instance itself
    Instance: TInterfacedObject;
    /// used to release the implementation instance
    // - direct FreeAndNil(Instance) may lead to A/V if self has been assigned
    // to an interface to any sub-method on the server side -> dec(RefCount)
    procedure SafeFreeInstance(Factory: TServiceFactoryServer);
  end;

  /// server-side service provider uses this to store its internal instances
  // - used by TServiceFactoryServer in sicClientDriven, sicPerSession,
  // sicPerUser or sicPerGroup mode
  TServiceFactoryServerInstanceDynArray = array of TServiceFactoryServerInstance;

  /// callback called before any interface-method service execution to allow
  // its execution
  // - see Ctxt.Service, Ctxt.ServiceMethodIndex and Ctxt.ServiceParameters
  // to identify the executed method context
  // - Method parameter will help identify easily the corresponding method, and
  // will contain in fact PServiceMethod(Ctxt.ServiceMethod)^
  // - should return TRUE if the method can be executed
  // - should return FALSE if the method should not be executed, and set the
  // corresponding error to the supplied context e.g.
  // ! Ctxt.Error('Unauthorized method',HTTP_NOTALLOWED);
  // - i.e. called by TSQLRestServerURIContext.InternalExecuteSOAByInterface
  TOnServiceCanExecute = function(Ctxt: TSQLRestServerURIContext;
    const Method: TServiceMethod): boolean of object;

  /// callbacked used by TServiceFactoryServer.RunOnAllInstances method
  TOnServiceFactoryServerOne = function(Sender: TServiceFactoryServer;
    var Instance: TServiceFactoryServerInstance; var Opaque): integer of object;

  /// a service provider implemented on the server side
  // - each registered interface has its own TServiceFactoryServer instance,
  // available as one TSQLServiceContainerServer item from TSQLRest.Services property
  // - will handle the implementation class instances of a given interface
  // - by default, all methods are allowed to execution: you can call AllowAll,
  // DenyAll, Allow or Deny in order to specify your exact security policy
  TServiceFactoryServer = class(TServiceFactory)
  protected
    fInstances: TServiceFactoryServerInstanceDynArray;
    fInstance: TDynArray;
    fInstanceCapacity: integer; // some void entries may have P^.InstanceID=0
    fInstanceCount: integer;
    fInstanceCurrentID: TID;
    fInstanceTimeOut: cardinal;
    fInstanceLock: TRTLCriticalSection;
    fStats: TSynMonitorInputOutputObjArray;
    fImplementationClass: TInterfacedClass;
    fImplementationClassKind: (ickBlank,
      ickWithCustomCreate, ickInjectable, ickInjectableRest,
      ickFromInjectedResolver, ickFake);
    fImplementationClassInterfaceEntry: PInterfaceEntry;
    fSharedInterface: IInterface;
    fByPassAuthentication: boolean;
    fResultAsJSONObject: boolean;
    fResultAsJSONObjectWithoutResult: boolean;
    fResultAsXMLObject: boolean;
    fResultAsJSONObjectIfAccept: boolean;
    fResultAsXMLObjectNameSpace: RawUTF8;
    fExcludeServiceLogCustomAnswer: boolean;
    fBackgroundThread: TSynBackgroundThreadMethod;
    fOnMethodExecute: TOnServiceCanExecute;
    fOnExecute: array of TServiceMethodExecuteEvent;
    procedure SetServiceLogByIndex(const aMethods: TInterfaceFactoryMethodBits;
      aLogRest: TSQLRest; aLogClass: TSQLRecordServiceLogClass);
    procedure SetTimeoutSecInt(value: cardinal);
    function GetTimeoutSec: cardinal;
    function GetStat(const aMethod: RawUTF8): TSynMonitorInputOutput;
    // from client CacheFlush/_ping_
    function RenewSession(aSession: cardinal): integer;
    /// get an implementation Inst.Instance for the given Inst.InstanceID
    // - is called by ExecuteMethod() in sicClientDrive mode
    // - returns -1 on error, or aMethodIndex for successfull execution,
    // e.g. 0 after {"method":"_free_".. call
    // - otherwise, fill Inst.Instance with the matching implementation (or nil)
    function InternalInstanceRetrieve(var Inst: TServiceFactoryServerInstance;
      aMethodIndex,aSession: integer): integer;
    /// call a given method of this service provider
    // - here Ctxt.ServiceMethod points to the corresponding fInterface.Methods[]
    // (i.e. excluding _free_/_contract_/_signature_ pseudo-methods)
    // - Ctxt.ServiceMethodIndex=0=ord(imFree) will free/release
    // the corresponding aInstanceID - as called  e.g. from
    // $ {"method":"_free_", "params":[], "id":1234}
    // - Ctxt.ServiceParameters is e.g. '[1,2]' i.e. a true JSON array, which
    // will contain the incoming parameters in the same exact order than the
    // corresponding implemented interface method
    // - Ctxt.ID is an optional number, to be used in case of sicClientDriven
    // kind of Instance creation to identify the corresponding client session
    // - returns 200/HTTP_SUCCESS on success, or an HTTP error status, with an
    // optional error message in aErrorMsg
    // - on success, Ctxt.Call.OutBody shall contain a serialized JSON object
    // with one nested result property, which may be a JSON array, containing
    // all "var" or "out" parameters values, and then the method main result -
    // for instance, ExecuteMethod(..,'[1,2]') over ICalculator.Add will return:
    // $ {"result":[3],"id":0}
    // the returned "id" number is the Instance identifier to be used for any later
    // sicClientDriven remote call - or just 0 in case of sicSingle or sicShared
    procedure ExecuteMethod(Ctxt: TSQLRestServerURIContext);
    /// called by ExecuteMethod to append input/output params to Sender.TempTextWriter
    procedure OnLogRestExecuteMethod(Sender: TServiceMethodExecute;
      Step: TServiceMethodExecuteEventStep);
    /// this method will create an implementation instance
    // - reference count will be set to one, in order to allow safe passing
    // of the instance into an interface, if AndIncreaseRefCount is TRUE
    // - will handle TInterfacedObjectWithCustomCreate and TInjectableObject
    // as expected, if necessary
    function CreateInstance(AndIncreaseRefCount: boolean): TInterfacedObject;
  public
    /// initialize the service provider on the server side
    // - expect an direct server-side implementation class, which may inherit
    // from plain TInterfacedClass, TInterfacedObjectWithCustomCreate if you
    // need an overridden constructor, or TInjectableObject to support DI/IoC
    // - for sicClientDriven, sicPerSession, sicPerUser or sicPerGroup modes,
    // a time out (in seconds) can be defined (default is 30 minutes) - if the
    // specified aTimeOutSec is 0, interface will be forced in sicSingle mode
    // - you should usualy have to call the TSQLRestServer.ServiceRegister()
    // method instead of calling this constructor directly
    constructor Create(aRestServer: TSQLRestServer; aInterface: PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation;
      aImplementationClass: TInterfacedClass; const aContractExpected: RawUTF8;
      aTimeOutSec: cardinal; aSharedInstance: TInterfacedObject); reintroduce;
    /// release all used memory
    // - e.g. any internal TServiceFactoryServerInstance instances (any shared
    // instance, and all still living instances in sicClientDrive mode)
    destructor Destroy; override;

    /// allow all methods execution for all TSQLAuthGroup
    // - all Groups will be affected by this method (on both client and server sides)
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function AllowAll: TServiceFactoryServer;
    /// allow all methods execution for the specified TSQLAuthGroup ID(s)
    // - the specified group ID(s) will be used to authorize remote service
    // calls from the client side
    // - you can retrieve a TSQLAuthGroup ID from its identifier, as such:
    // ! UserGroupID := fServer.MainFieldID(TSQLAuthGroup,'User');
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function AllowAllByID(const aGroupID: array of TID): TServiceFactoryServer;
    /// allow all methods execution for the specified TSQLAuthGroup names
    // - is just a wrapper around the other AllowAllByID() method, retrieving the
    // Group ID from its main field
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function AllowAllByName(const aGroup: array of RawUTF8): TServiceFactoryServer;
    /// deny all methods execution for all TSQLAuthGroup
    // - all Groups will be affected by this method (on both client and server sides)
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function DenyAll: TServiceFactoryServer;
    /// deny all methods execution for the specified TSQLAuthGroup ID(s)
    // - the specified group ID(s) will be used to authorize remote service
    // calls from the client side
    // - you can retrieve a TSQLAuthGroup ID from its identifier, as such:
    // ! UserGroupID := fServer.MainFieldID(TSQLAuthGroup,'User');
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function DenyAllByID(const aGroupID: array of TID): TServiceFactoryServer;
    /// dent all methods execution for the specified TSQLAuthGroup names
    // - is just a wrapper around the other DenyAllByID() method, retrieving the
    // Group ID from its main field
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function DenyAllByName(const aGroup: array of RawUTF8): TServiceFactoryServer;
    /// allow specific methods execution for the all TSQLAuthGroup
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - all Groups will be affected by this method (on both client and server sides)
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function Allow(const aMethod: array of RawUTF8): TServiceFactoryServer;
    /// allow specific methods execution for the specified TSQLAuthGroup ID(s)
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - the specified group ID(s) will be used to authorize remote service
    // calls from the client side
    // - you can retrieve a TSQLAuthGroup ID from its identifier, as such:
    // ! UserGroupID := fServer.MainFieldID(TSQLAuthGroup,'User');
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function AllowByID(const aMethod: array of RawUTF8; const aGroupID: array of TID): TServiceFactoryServer;
    /// allow specific methods execution for the specified TSQLAuthGroup name(s)
    // - is just a wrapper around the other AllowByID() method, retrieving the
    // Group ID from its main field
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function AllowByName(const aMethod: array of RawUTF8; const aGroup: array of RawUTF8): TServiceFactoryServer;
    /// deny specific methods execution for the all TSQLAuthGroup
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - all Groups will be affected by this method (on both client and server sides)
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function Deny(const aMethod: array of RawUTF8): TServiceFactoryServer;
    /// deny specific methods execution for the specified TSQLAuthGroup ID(s)
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - the specified group ID(s) will be used to unauthorize remote service
    // calls from the client side
    // - you can retrieve a TSQLAuthGroup ID from its identifier, as such:
    // ! UserGroupID := fServer.MainFieldID(TSQLAuthGroup,'User');
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function DenyByID(const aMethod: array of RawUTF8; const aGroupID: array of TID): TServiceFactoryServer; overload;
    /// deny specific methods execution for the specified TSQLAuthGroup name(s)
    // - is just a wrapper around the other DenyByID() method, retrieving the
    // Group ID from its main field
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function DenyByName(const aMethod: array of RawUTF8; const aGroup: array of RawUTF8): TServiceFactoryServer;
    /// define execution options for a given set of methods
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - if no method name is given (i.e. []), option will be set for all methods
    // - include optExecInMainThread will force the method(s) to be called within
    // a RunningThread.Synchronize() call - slower, but thread-safe
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function SetOptions(const aMethod: array of RawUTF8; aOptions: TServiceMethodOptions;
      aAction: TServiceMethodOptionsAction=moaReplace): TServiceFactoryServer;
    /// define the the instance life time-out, in seconds
    // - for sicClientDriven, sicPerSession, sicPerUser or sicPerGroup modes
    // - raise an exception for other kind of execution
    // - this method returns self in order to allow direct chaining of setting
    // calls for the service, in a fluent interface
    function SetTimeoutSec(value: cardinal): TServiceFactoryServer;
    /// log method execution information to a TSQLRecordServiceLog table
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - if no method name is given (i.e. []), option will be set for all methods
    // - will write to the specified aLogRest instance, and will disable
    // writing if aLogRest is nil
    // - will write to a (inherited) TSQLRecordServiceLog table, as available in
    // TSQLRest's model, unless a dedicated table is specified as aLogClass
    // - this method returns self in order to allow direct chaining of security
    // calls, in a fluent interface
    function SetServiceLog(const aMethod: array of RawUTF8;
      aLogRest: TSQLRest; aLogClass: TSQLRecordServiceLogClass=nil): TServiceFactoryServer;
    /// you can define here an event to allow/deny execution of any method
    // of this service, at runtime
    property OnMethodExecute: TOnServiceCanExecute read fOnMethodExecute write fOnMethodExecute;
    /// allow to hook the methods execution
    // - several events could be registered, and will be called directly
    // before and after method execution
    // - if optInterceptInputOutput is defined in Options, then Sender.Input/Output
    // fields will contain the execution data context when Hook is called
    // - see OnMethodExecute if you want to implement security features
    procedure AddInterceptor(const Hook: TServiceMethodExecuteEvent);

    /// retrieve an instance of this interface from the server side
    // - sicShared mode will retrieve the shared instance
    // - sicPerThread mode will retrieve the instance corresponding to the
    // current running thread
    // - all other kind of instance creation will behave the same as sicSingle
    // when accessed directly from this method, i.e. from server side: in fact,
    // on the server side, there is no notion of client, session, user nor group
    // - if ServiceContext.Factory is nil (i.e. if there is no other
    // service context currently associated), this method will also update
    // ServiceContext.Factory, so that the implementation method will be able
    // to access the associated TSQLRestServer instance if needed
    function Get(out Obj): Boolean; override;
    /// retrieve the published signature of this interface
    // - is always available on TServiceFactoryServer, but TServiceFactoryClient
    // will be able to retrieve it only if TServiceContainerServer.PublishSignature
    // is set to TRUE (which is not the default setting, for security reasons)
    function RetrieveSignature: RawUTF8; override;
    /// call the supplied aEvent callback for all class instances implementing
    // this service
    function RunOnAllInstances(const aEvent: TOnServiceFactoryServerOne;
      var aOpaque): integer;

    /// just type-cast the associated TSQLRest instance to a true TSQLRestServer
    function RestServer: TSQLRestServer;
      {$ifdef HASINLINE}inline;{$endif}

    /// direct access to per-method detailed process statistics
    // - this Stats[] array follows Interface.Methods[] order
    // - see Stat[] property to retrieve information about a method by name
    property Stats: TSynMonitorInputOutputObjArray read fStats;
    /// retrieve detailed statistics about a method use
    // - will return a reference to the actual item in Stats[]: caller should
    // not free the returned instance
    property Stat[const aMethod: RawUTF8]: TSynMonitorInputOutput read GetStat;
  published
    /// the class type used to implement this interface
    property ImplementationClass: TInterfacedClass read fImplementationClass;
    /// the instance life time-out, in seconds
    // - for sicClientDriven, sicPerSession, sicPerUser or sicPerGroup modes
    // - raise an exception for other kind of execution
    // - you can also use the SetTimeOutSec() fluent function instead
    property TimeoutSec: cardinal read GetTimeoutSec write SetTimeoutSecInt;
    /// set to TRUE disable Authentication method check for the whole interface
    // - by default (FALSE), all interface-based services will require valid
    // RESTful authentication (if enabled on the server side); setting TRUE will
    // disable authentication for all methods of this interface
    // (e.g. for returning some HTML content from a public URI, or to implement
    // a public service catalog)
    property ByPassAuthentication: boolean read fByPassAuthentication write fByPassAuthentication;
    /// set to TRUE to return the interface's methods result as JSON object
    // - by default (FALSE), any method execution will return a JSON array with
    // all VAR/OUT parameters, in order
    // - TRUE will generate a JSON object instead, with the VAR/OUT parameter
    // names as field names (and "Result" for any function result) - may be
    // useful e.g. when working with JavaScript clients
    // - Delphi clients (i.e. TServiceFactoryClient/TInterfacedObjectFake) will
    // transparently handle both formats
    // - this value can be overridden by setting ForceServiceResultAsJSONObject
    // for a given TSQLRestServerURIContext (e.g. for server-side JavaScript work)
    property ResultAsJSONObject: boolean
      read fResultAsJSONObject write fResultAsJSONObject;
    /// set to TRUE to return the interface's methods result as JSON object
    // with no '{"result":{...}}' nesting
    // - could be used e.g. for plain non mORMot REST Client with in sicSingle
    // or sicShared mode kind of services
    // - on client side, consider using TSQLRestClientURI.ServiceDefineSharedAPI
    property ResultAsJSONObjectWithoutResult: boolean
      read fResultAsJSONObjectWithoutResult write fResultAsJSONObjectWithoutResult;
    /// set to TRUE to return the interface's methods result as XML object
    // - by default (FALSE), method execution will return a JSON array with
    // all VAR/OUT parameters, or a JSON object if ResultAsJSONObject is TRUE
    // - TRUE will generate a XML object instead, with the VAR/OUT parameter
    // names as field names (and "Result" for any function result) - may be
    // useful e.g. when working with some XML-only clients
    // - Delphi clients (i.e. TServiceFactoryClient/TInterfacedObjectFake) does
    // NOT handle this XML format yet
    // - this value can be overridden by setting ForceServiceResultAsXMLObject
    // for a given TSQLRestServerURIContext instance
    property ResultAsXMLObject: boolean
      read fResultAsXMLObject write fResultAsXMLObject;
    /// set to TRUE to return XML objects for the interface's methods result
    // if the Accept: HTTP header is exactly 'application/xml' or 'text/xml'
    // - the header should be exactly 'Accept: application/xml' or
    // 'Accept: text/xml' (and no other value)
    // - in this case, ForceServiceResultAsXMLObject will be set for this
    // particular TSQLRestServerURIContext instance, and result returned as XML
    // - using this method allows to mix standard JSON requests (from JSON
    // or AJAX clients) and XML requests (from XML-only clients)
    property ResultAsXMLObjectIfAcceptOnlyXML: boolean
      read fResultAsJSONObjectIfAccept write fResultAsJSONObjectIfAccept;
    /// specify a custom name space content when returning a XML object
    // - by default, no name space will be appended - but such rough XML will
    // have potential validation problems
    // - you may use e.g. XMLUTF8_NAMESPACE, which will append <content ...> ...
    // </content> around the generated XML data
    property ResultAsXMLObjectNameSpace: RawUTF8
      read fResultAsXMLObjectNameSpace write fResultAsXMLObjectNameSpace;
    /// disable base64-encoded TSQLRecordServiceLog.Output for methods
    // returning TServiceCustomAnswer record (to reduce storage size)
    property ExcludeServiceLogCustomAnswer: boolean read fExcludeServiceLogCustomAnswer
      write fExcludeServiceLogCustomAnswer;
  end;

  /// a service provider implemented on the client side
  // - each registered interface has its own TServiceFactoryClient instance,
  // available as one TSQLServiceContainerClient item from TSQLRest.Services property
  // - will emulate "fake" implementation class instance of a given interface
  // and call remotely the server to process the actual implementation
  TServiceFactoryClient = class(TServiceFactory)
  protected
    fForcedURI: RawUTF8;
    fClient: TSQLRestClientURI;
    fParamsAsJSONObject: boolean;
    fResultAsJSONObject: boolean;
    fDelayedInstance: boolean;
    fNonBlockWithoutAnswer: boolean;
    fSendNotificationsThread: TThread;
    fSendNotificationsRest: TSQLRest;
    fSendNotificationsLogClass: TSQLRecordServiceNotificationsClass;
    function CreateFakeInstance: TInterfacedObject;
    function InternalInvoke(const aMethod: RawUTF8; const aParams: RawUTF8='';
      aResult: PRawUTF8=nil; aErrorMsg: PRawUTF8=nil; aClientDrivenID: PCardinal=nil;
      aServiceCustomAnswer: PServiceCustomAnswer=nil; aClient: TSQLRestClientURI=nil): boolean; virtual;
    // match TOnFakeInstanceInvoke callback signature
    function Invoke(const aMethod: TServiceMethod; const aParams: RawUTF8;
      aResult: PRawUTF8; aErrorMsg: PRawUTF8; aClientDrivenID: PCardinal;
      aServiceCustomAnswer: PServiceCustomAnswer): boolean;
    procedure NotifyInstanceDestroyed(aClientDrivenID: cardinal); virtual;
  public
    /// initialize the service provider parameters
    // - it will check and retrieve all methods of the supplied interface,
    // and prepare all internal structures for its serialized execution
    // - also set the inherited TServiceInstanceImplementation property
    // - initialize fSharedInstance if aInstanceCreation is sicShared
    // - it will also ensure that the corresponding TServiceFactory.Contract
    // matches on both client and server sides, either by comparing the default
    // signature (based on methods and arguments), either by using the supplied
    // expected contract (which may be a custom version number)
    constructor Create(aRest: TSQLRest; aInterface: PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation;
      const aContractExpected: RawUTF8='');
    /// finalize the service provider used instance
    // - e.g. the shared fake implementation instance
    destructor Destroy; override;
    /// retrieve an instance of this interface from the client side
    function Get(out Obj): Boolean; override;
    /// retrieve the published signature of this interface
    // - TServiceFactoryClient will be able to retrieve it only if
    // TServiceContainerServer.PublishSignature is set to TRUE (which is not the
    // default setting, for security reasons) - this function is always available
    // on TServiceFactoryServer side
    function RetrieveSignature: RawUTF8; override;
    /// convert a HTTP error from mORMot's REST/SOA into an English text message
    // - will recognize the HTTP_UNAVAILABLE, HTTP_NOTIMPLEMENTED, HTTP_NOTFOUND,
    // HTTP_NOTALLOWED, HTTP_UNAUTHORIZED or HTTP_NOTACCEPTABLE errors, as
    // generated by the TSQLRestServer side
    // - is used by TServiceFactoryClient.InternalInvoke, but may be called
    // on client side for TServiceCustomAnswer.Status <> HTTP_SUCCESS
    class function GetErrorMessage(status: integer): RawUTF8;
    /// define execution options for a given set of methods
    // - methods names should be specified as an array (e.g. ['Add','Multiply'])
    // - if no method name is given (i.e. []), option will be set for all methods
    // - only supports optNoLogInput and optNoLogOutput on the client side,
    // by design of "fake" interface remote execution
    procedure SetOptions(const aMethod: array of RawUTF8; aOptions: TServiceMethodOptions;
      aAction: TServiceMethodOptionsAction=moaReplace);
    /// persist all service calls into a database instead of calling the client
    // - expect a REST instance, which will store all methods without any
    // results (i.e. procedure without any var/out parameters) on the
    // associated TSQLRecordServiceNotifications class
    // - once set, regular fClient.URI() won't be called but a new aLogClass
    // entry will be stored in aRest
    // - to disable this redirection, set aRest and aLogClass to nil
    procedure StoreNotifications(aRest: TSQLRest;
      aLogClass: TSQLRecordServiceNotificationsClass);
    /// allow background process of method with no results, via a temporary
    // database, to be used e.g. for safe notifications transmission
    // - will call StoreNotifications() and start background notification
    // - expect a REST instance, which will store all methods without any
    // results (i.e. procedure without any var/out parameters) on the
    // associated TSQLRecordServiceNotifications class
    // - a background thread will be used to check for pending notifications,
    // and send them to the supplied aRemote TSQLRestClient instance, or
    // to the main TServiceFactoryClient.fClient instance
    // - if the remote client is not reachable, will retry after the specified
    // period of time, in seconds
    // - this method is not blocking, and will write the pending calls to
    // the aRest/aLogClass table, which will be retrieved asynchronously
    // by the background thread
    procedure SendNotifications(aRest: TSQLRest;
      aLogClass: TSQLRecordServiceNotificationsClass; aRetryPeriodSeconds: Integer=30;
      aRemote: TSQLRestClientURI=nil);
    /// compute how many pending notifications are waiting for background process
    // initiated by SendNotifications() method
    function SendNotificationsPending: integer;
    /// wait for all pending notifications to be sent
    // - you can supply a time out period after which no wait will take place
    procedure SendNotificationsWait(aTimeOutSeconds: integer);
  published
    /// could be used to force the remote URI to access the service
    // - by default, the URI will be Root/Calculator or Root/InterfaceMangledURI
    // but you may use this property to use another value, e.g. if you are
    // accessign a non mORMot REST server (probably with aContractExpected set
    // to SERVICE_CONTRACT_NONE_EXPECTED, and running
    // Client.ServerTimestamp := TimeLogNowUTC to avoid an unsupported
    // ServerTimestampSynchronize call)
    property ForcedURI: RawUTF8 read fForcedURI write fForcedURI;
    /// set to TRUE to send the interface's methods parameters as JSON object
    // - by default (FALSE), any method execution will send a JSON array with
    // all CONST/VAR parameters, in order
    // - TRUE will generate a JSON object instead, with the CONST/VAR parameter
    // names as field names - may be useful e.g. when working with a non
    // mORMot server, or when the mORMot server exposes a public API
    // - defined e.g. by TSQLRestClientURI.ServiceDefineSharedAPI() method
    property ParamsAsJSONObject: boolean read fParamsAsJSONObject write fParamsAsJSONObject;
    /// set to TRUE if the interface's methods result is expected to be a JSON object
    // without the {"result":... } nesting
    // - by default (FALSE), any method execution will return a JSON array with
    // all VAR/OUT parameters, within a {"result":...,"id":...} layout
    // - TRUE will expect a simple JSON object instead, with the VAR/OUT parameter
    // names as field names (and "Result" for any function result) - may be
    // useful e.g. when working with JavaScript clients or any public API
    // - this value can be overridden by setting ForceServiceResultAsJSONObject
    // for a given TSQLRestServerURIContext (e.g. for server-side JavaScript work)
    // - defined e.g. by TSQLRestClientURI.ServiceDefineSharedAPI() method
    property ResultAsJSONObjectWithoutResult: boolean read fResultAsJSONObject
      write fResultAsJSONObject;
    /// delay the sicClientDriven server-side instance to the first method call
    // - by default, CreateFakeInstance will call _instance_ server pseudo-method
    // to ensure a fClientDrivenID is safely and properly initialized
    // - if you are sure that your client's interface variables will be thread-safe,
    // you may define this property to TRUE so that the "id" field as returned
    // at first method call will be used - makes sense only if a lot of short-live
    // interface instances are expected to be generated by the client
    property DelayedInstance: boolean read fDelayedInstance write fDelayedInstance;
    /// if methods expecting no result (i.e. plain procedure without var/out
    // parameters) should not block the client waiting for answer
    // - may be handy e.g. when consuming an event-driven asynchronous service
    // - will call CallbackNonBlockingSetHeader, currently implemented only in
    // TSQLHttpClientWebsockets, with frame gathering
    property NonBlockWithoutAnswer: boolean read fNonBlockWithoutAnswer write fNonBlockWithoutAnswer;
  end;

  /// class-reference type (metaclass) of a TServiceFactoryClient kind
  TServiceFactoryClientClass = class of TServiceFactoryClient;

  /// used to lookup one service in a global list of interface-based services
  TServiceContainerInterface = record
    /// one 'service' item, as set at URI, e.g. 'Calculator'
    InterfaceName: RawUTF8;
    /// the associated service provider
    Service: TServiceFactory;
  end;
  /// pointer to one  lookup in a global list of interface-based services
  PServiceContainerInterface = ^TServiceContainerInterface;
  /// used to store all s in a global list of interface-based services
  TServiceContainerInterfaces = array of TServiceContainerInterface;

  /// used to lookup one method in a global list of interface-based services
  TServiceContainerInterfaceMethod = record
    /// one 'service.method' item, as set at URI
    // - e.g.'Calculator.Add','Calculator.Multiply'...
    InterfaceDotMethodName: RawUTF8;
    /// the associated service provider
    InterfaceService: TServiceFactory;
    /// the index of the method for the given service
    // - 0..2 indicates _free_/_contract_/_signature_ pseudo-methods
    // - then points to InterfaceService.Interface.Methods[InterfaceMethodIndex-3]
    InterfaceMethodIndex: integer;
  end;
  /// pointer to one method lookup in a global list of interface-based services
  PServiceContainerInterfaceMethod = ^TServiceContainerInterfaceMethod;
  /// used to store all methods in a global list of interface-based services
  TServiceContainerInterfaceMethods = array of TServiceContainerInterfaceMethod;

  /// used in TServiceContainer to identify fListInterfaceMethod[] entries
  TServiceContainerInterfaceMethodBits = set of 0..255;

  /// a global services provider class
  // - used to maintain a list of interfaces implementation
  // - inherits from TInterfaceResolverInjected and its Resolve() methods,
  // compatible with TInjectableObject
  TServiceContainer = class(TInterfaceResolverInjected)
  protected
    fRest: TSQLRest;
    // list of services ['Calculator',...]
    fInterface: TServiceContainerInterfaces;
    fInterfaces: TDynArrayHashed;
    // list of service.method ['Calculator.Add','Calculator.Multiply',...]
    fInterfaceMethod: TServiceContainerInterfaceMethods;
    fInterfaceMethods: TDynArrayHashed;
    fExpectMangledURI: boolean;
    fServicesFactoryClients: TServiceFactoryClientClass;
    procedure SetExpectMangledURI(aValue: Boolean);
    procedure SetInterfaceMethodBits(MethodNamesCSV: PUTF8Char;
      IncludePseudoMethods: boolean; out bits: TServiceContainerInterfaceMethodBits);
    function GetMethodName(ListInterfaceMethodIndex: integer): RawUTF8;
    procedure CheckInterface(const aInterfaces: array of PTypeInfo);
    function AddServiceInternal(aService: TServiceFactory): integer;
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; override;
    /// retrieve a service provider from its URI
    function GetService(const aURI: RawUTF8): TServiceFactory;
  public
    /// initialize the list
    constructor Create(aRest: TSQLRest); virtual;
    /// release all registered services
    destructor Destroy; override;
    /// release all services of a TSQLRest instance before shutdown
    // - will allow to properly release any pending callbacks
    // - TSQLRest.Services.Release will call FreeAndNil(fServices)
    procedure Release;
    /// return the number of registered service interfaces
    function Count: integer; {$ifdef HASINLINE}inline;{$endif}
    /// method called on the client side to register a service via its interface(s)
    // - will add a TServiceFactoryClient instance to the internal list
    // - is called e.g. by TSQLRestClientURI.ServiceRegister or even by
    // TSQLRestServer.ServiceRegister(aClient: TSQLRest...) for a remote access -
    // use TServiceContainerServer.AddImplementation() instead for normal
    // server side implementation
    // - will raise an exception on error
    // - will return true if some interfaces have been added
    // - will check for the availability of the interfaces on the server side,
    // with an optional custom contract to be used instead of methods signature
    // (only for the first interface)
    function AddInterface(const aInterfaces: array of PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation; aContractExpected: RawUTF8=''): boolean; overload;
    /// method called on the client side to register a service via one interface
    // - overloaded method returning the corresponding service factory client,
    // or nil on error
    function AddInterface(aInterface: PTypeInfo; aInstanceCreation: TServiceInstanceImplementation;
      const aContractExpected: RawUTF8=''): TServiceFactoryClient; overload;
    /// retrieve a service provider from its index in the list
    // - returns nil if out of range index
    function Index(aIndex: integer): TServiceFactory; overload; {$ifdef HASINLINE}inline;{$endif}
    /// retrieve a service provider from its GUID / Interface type
    // - you shall have registered the interface by a previous call to
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...])
    // - on match, it will return the service the corresponding interface factory
    // - returns nil if the GUID does not match any registered interface
    // - can be used as such to resolve an I: ICalculator interface
    // ! if fClient.Services.Info(ICalculator).Get(I) then
    // !   ... use I
    function Info(const aGUID: TGUID): TServiceFactory; overload;
    /// retrieve a service provider from its type information
    // - on match, it  will return the service the corresponding interface factory
    // - returns nil if the type information does not match any registered interface
    // - can be used as such to resolve an I: ICalculator interface
    // ! if fClient.Services.Info(TypeInfo(ICalculator)).Get(I) then
    // !   ... use I
    // - is defined as virtual so that e.g. TServiceContainerClient will
    // automatically register the interface, if it was not already done
    function Info(aTypeInfo: PTypeInfo): TServiceFactory; overload; virtual;
    /// notify the other side that the given Callback event interface is released
    // - this default implementation will do nothing
    function CallBackUnRegister(const Callback: IInvokable): boolean; virtual;
    /// retrieve all registered Services TGUID
    procedure SetGUIDs(out Services: TGUIDDynArray);
    /// retrieve all registered Services names
    // - i.e. all interface names without the initial 'I', e.g. 'Calculator' for
    // ICalculator
    procedure SetInterfaceNames(out Names: TRawUTF8DynArray);
    /// retrieve all registered Services contracts as a JSON array
    // - i.e. a JSON array of TServiceFactory.Contract JSON objects
    function AsJson: RawJSON;
    /// retrieve a service provider from its URI
    // - it expects the supplied URI variable  to be e.g. '00amyWGct0y_ze4lIsj2Mw'
    // or 'Calculator', depending on the ExpectMangledURI property
    // - on match, it  will return the service the corresponding interface factory
    // - returns nil if the URI does not match any registered interface
    property Services[const aURI: RawUTF8]: TServiceFactory read GetService; default;
    /// the associated RESTful instance
    property Rest: TSQLRest read fRest;
    /// set if the URI is expected to be mangled from the GUID
    // - by default (FALSE), the clear service name is expected to be supplied at
    // the URI level (e.g. 'Calculator')
    // - if this property is set to TRUE, the mangled URI value will be expected
    // instead (may enhance security) - e.g. '00amyWGct0y_ze4lIsj2Mw'
    property ExpectMangledURI: boolean read fExpectMangledURI write SetExpectMangledURI;
    /// the services factory client classes
    // - by default, will use TServiceFactoryClient
    property ServicesFactoryClients: TServiceFactoryClientClass read fServicesFactoryClients write fServicesFactoryClients;
  end;

  /// a callback interface used to notify a TSQLRecord modification in real time
  // - will be used e.g. by TSQLRestServer.RecordVersionSynchronizeSubscribeMaster()
  // - all methods of this interface will be called asynchronously when
  // transmitted via our WebSockets implementation, since they are defined as
  // plain procedures
  // - each callback instance should be private to a specific TSQLRecord
  IServiceRecordVersionCallback = interface(IInvokable)
    ['{8598E6BE-3590-4F76-9449-7AF7AF4241B0}']
    /// this event will be raised on any Add on a versioned record
    // - the supplied JSON object will contain the TRecordVersion field
    procedure Added(const NewContent: RawJSON);
    /// this event will be raised on any Update on a versioned record
    // - the supplied JSON object will contain the TRecordVersion field
    procedure Updated(const ModifiedContent: RawJSON);
    /// this event will be raised on any Delete on a versioned record
    procedure Deleted(const ID: TID; const Revision: TRecordVersion);
    /// allow to optimize process for WebSockets "jumbo frame" items
    // - this method may be called with isLast=false before the first method
    // call of this interface, then with isLast=true after the call of the
    // last method of the "jumbo frame"
    // - match TInterfaceFactory.MethodIndexCurrentFrameCallback signature
    // - allow e.g. to create a temporary TSQLRestBatch for jumbo frames
    // - if individual frames are received, this method won't be called
    procedure CurrentFrame(isLast: boolean);
  end;

  /// a list of callback interfaces to notify TSQLRecord modifications
  // - you can use InterfaceArray*() wrapper functions to manage the list
  IServiceRecordVersionCallbackDynArray = array of IServiceRecordVersionCallback;

  /// service definition for master/slave replication notifications subscribe
  // - implemented by TServiceRecordVersion, as used by
  // TSQLRestServer.RecordVersionSynchronizeMasterStart(), and expected by
  // TSQLRestServer.RecordVersionSynchronizeSlaveStart()
  IServiceRecordVersion = interface(IInvokable)
    ['{06A355CA-19EB-4CC6-9D87-7B48967D1D9F}']
    /// will register the supplied callback for the given table
    function Subscribe(const SQLTableName: RawUTF8; const revision: TRecordVersion;
      const callback: IServiceRecordVersionCallback): boolean;
  end;

  /// service definition with a method which will be called when a callback
  // interface instance is released on the client side
  // - may be used to implement safe publish/subscribe mechanism using
  // interface callbacks, e.g. over WebSockets
  IServiceWithCallbackReleased = interface(IInvokable)
    ['{8D518FCB-62C3-42EB-9AE7-96ED322140F7}']
    /// will be called when a callback is released on the client side
    // - this method matches the TInterfaceFactory.MethodIndexCallbackReleased
    // signature, so that it will be called with the interface instance by
    // TServiceContainerServer.FakeCallbackRelease
    // - you may use it as such - see sample Project31ChatServer.dpr:
    // ! procedure TChatService.CallbackReleased(const callback: IInvokable;
    // !   const interfaceName: RawUTF8);
    // ! begin  // unsubscribe from fConnected: array of IChatCallback
    // !   if interfaceName='IChatCallback' then
    // !     InterfaceArrayDelete(fConnected,callback);
    // ! end;
    procedure CallbackReleased(const callback: IInvokable; const interfaceName: RawUTF8);
  end;

  /// event signature triggerred when a callback instance is released
  // - used by TServiceContainerServer.OnCallbackReleasedOnClientSide
  // and TServiceContainerServer.OnCallbackReleasedOnServerSide event properties
  // - the supplied Instance will be a TInterfacedObjectFakeServer, and the
  // Callback will be a pointer to the corresponding interface value
  // - assigned implementation should be as fast a possible, since this event
  // will be executed in a global lock for all server-side callbacks
  TOnCallbackReleased = procedure(Sender: TServiceContainer;
    Instance: TInterfacedObject; Callback: pointer) of object;

  /// how TServiceContainerServer will handle SOA callbacks
  // - by default, a callback released on the client side will log a warning
  // and continue the execution (relying e.g. on a CallbackReleased() method to
  // unsubscribe the event), but coRaiseExceptionIfReleasedByClient can be
  // defined to raise an EInterfaceFactoryException in this case
  TServiceCallbackOptions = set of (
    coRaiseExceptionIfReleasedByClient);

  /// a services provider class to be used on the server side
  // - this will maintain a list of true implementation classes
  TServiceContainerServer = class(TServiceContainer)
  protected
    fPublishSignature: boolean;
    fConnectionID: Int64;
    fFakeCallbacks: TSynObjectListLocked; // TInterfacedObjectFakeServer instances
    fOnCallbackReleasedOnClientSide: TOnCallbackReleased;
    fOnCallbackReleasedOnServerSide: TOnCallbackReleased;
    fCallbackOptions: TServiceCallbackOptions;
    fRecordVersionCallback: array of IServiceRecordVersionCallbackDynArray;
    fSessionTimeout: cardinal;
    /// make some garbage collection when session is finished
    procedure OnCloseSession(aSessionID: cardinal); virtual;
    procedure FakeCallbackAdd(aFakeInstance: TObject);
    procedure FakeCallbackRemove(aFakeInstance: TObject);
    procedure FakeCallbackRelease(Ctxt: TSQLRestServerURIContext);
    procedure RecordVersionCallbackNotify(TableIndex: integer;
      Occasion: TSQLOccasion; const DeletedID: TID;
      const DeletedRevision: TRecordVersion; const AddUpdateJson: RawUTF8);
  public
    /// class method able to check if a given server-side callback event fake
    // instance has been released on the client side
    // - may be used to automatically purge a list of subscribed callbacks,
    // e.g. before trigerring the interface instance, and avoid an exception
    // - can optionally append the callback class instance information to
    // a local shortstring variable, e.g. for logging/debug purposes
    class function CallbackReleasedOnClientSide(const callback: IInterface;
      callbacktext: PShortString=nil): boolean; overload;
    /// method called on the server side to register a service via its
    // interface(s) and a specified implementation class or a shared
    // instance (for sicShared mode)
    // - will add a TServiceFactoryServer instance to the internal list
    // - will raise an exception on error
    // - will return the first of the registered TServiceFactoryServer created
    // on success (i.e. the one corresponding to the first item of the aInterfaces
    // array), or nil if registration failed (e.g. if any of the supplied interfaces
    // is not implemented by the given class)
    // - the same implementation class can be used to handle several interfaces
    // (just as Delphi allows to do natively)
    function AddImplementation(aImplementationClass: TInterfacedClass;
      const aInterfaces: array of PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation;
      aSharedImplementation: TInterfacedObject; const aContractExpected: RawUTF8): TServiceFactoryServer;
    /// initialize the list
    constructor Create(aRest: TSQLRest); override;
    /// finalize the service container
    destructor Destroy; override;
    /// register a callback interface which will be called each time a write
    // operation is performed on a given TSQLRecord with a TRecordVersion field
    // - called e.g. by TSQLRestServer.RecordVersionSynchronizeSubscribeMaster
    function RecordVersionSynchronizeSubscribeMaster(TableIndex: integer;
      RecordVersion: TRecordVersion; const SlaveCallback: IServiceRecordVersionCallback): boolean;
    /// notify any TRecordVersion callback for a table Add/Update from a
    // TDocVariant content
    // - used e.g. by TSQLRestStorageMongoDB.DocFromJSON()
    procedure RecordVersionNotifyAddUpdate(Occasion: TSQLOccasion;
      TableIndex: integer; const Document: TDocVariantData); overload;
    /// notify any TRecordVersion callback for a table Add/Update from a
    // TJSONObjectDecoder content
    // - used e.g. by TSQLRestStorageMongoDB.DocFromJSON()
    procedure RecordVersionNotifyAddUpdate(Occasion: TSQLOccasion;
      TableIndex: integer; const Decoder: TJSONObjectDecoder); overload;
    /// notify any TRecordVersion callback for a table Delete
    procedure RecordVersionNotifyDelete(TableIndex: integer;
      const ID: TID; const Revision: TRecordVersion);
    /// log method execution information to a TSQLRecordServiceLog table
    // - TServiceFactoryServer.SetServiceLog() will be called for all registered
    // interfaced-based services of this container
    // - will write to the specified aLogRest instance, and will disable
    // writing if aLogRest is nil
    // - will write to a (inherited) TSQLRecordServiceLog table, as available in
    // TSQLRest's model, unless a dedicated table is specified as aLogClass
    // - you could specify a CSV list of method names to be excluded from logging
    // (containing e.g. a password or a credit card number), containing either
    // the interface name (as 'ICalculator.Add'), or not (as 'Add')
    procedure SetServiceLog(aLogRest: TSQLRest; aLogClass: TSQLRecordServiceLogClass=nil;
      const aExcludedMethodNamesCSV: RawUTF8='');
    /// defines if the "method":"_signature_" or /root/Interface._signature
    // pseudo method is available to retrieve the whole interface signature,
    // encoded as a JSON object
    // - is set to FALSE by default, for security reasons: only "_contract_"
    // pseudo method is available - see TServiceContainer.ContractExpected
    property PublishSignature: boolean read fPublishSignature write fPublishSignature;
    /// the default TServiceFactoryServer.TimeoutSec value
    // - default is 30 minutes
    // - you can customize each service using its corresponding TimeoutSec property
    property SessionTimeout: cardinal read fSessionTimeout write fSessionTimeout;
    /// this event will be launched when a callback interface is notified as
    // relased on the Client side
    // - as an alternative, you may define the following method on the
    // registration service interface type, which will be called when a
    // callback registered via this service is released (e.g. to unsubscribe
    // the callback from an interface list, via InterfaceArrayDelete):
    // ! procedure CallbackReleased(const callback: IInvokable; const interfaceName: RawUTF8);
    property OnCallbackReleasedOnClientSide: TOnCallbackReleased
      read fOnCallbackReleasedOnClientSide;
    /// this event will be launched when a callback interface is relased on
    // the Server side
    property OnCallbackReleasedOnServerSide: TOnCallbackReleased
      read fOnCallbackReleasedOnServerSide;
    /// defines how SOA callbacks will be handled
    property CallbackOptions: TServiceCallbackOptions read fCallbackOptions
      write fCallbackOptions;
  end;

  /// this class implements a service, which may be called to push notifications
  // for master/slave replication
  // - as used by TSQLRestServer.RecordVersionSynchronizeMasterStart(), and
  // expected by TSQLRestServer.RecordVersionSynchronizeSlaveStart()
  TServiceRecordVersion = class(TInjectableObjectRest,IServiceRecordVersion)
  public
    /// will register the supplied callback for the given table
    function Subscribe(const SQLTableName: RawUTF8; const revision: TRecordVersion;
      const callback: IServiceRecordVersionCallback): boolean;
   end;

  /// a services provider class to be used on the client side
  // - this will maintain a list of fake implementation classes, which will
  // remotely call the server to make the actual process
  TServiceContainerClient = class(TServiceContainer)
  protected
    fDisableAutoRegisterAsClientDriven: boolean;
  public
    /// retrieve a service provider from its type information
    // - this overridden method will register the interface, if was not yet made
    // - in this case, the interface will be registered with sicClientDriven
    // implementation method, unless DisableAutoRegisterAsClientDriven is TRUE
    function Info(aTypeInfo: PTypeInfo): TServiceFactory; overload; override;
    /// notify the other side that the given Callback event interface is released
    // - this overriden implementation will check the private fFakeCallbacks list
    function CallBackUnRegister(const Callback: IInvokable): boolean; override;
    /// allow to disable the automatic registration as sicClientDriven in Info()
    property DisableAutoRegisterAsClientDriven: boolean
      read fDisableAutoRegisterAsClientDriven write fDisableAutoRegisterAsClientDriven;
  end;

  /// TInterfacedObject class which will notify a REST server when it is released
  // - could be used when implementing event callbacks as interfaces, so that
  // the other side instance will be notified when it is destroyed
  TInterfacedCallback = class(TInterfacedObjectLocked)
  protected
    fRest: TSQLRest;
    fInterface: TGUID;
  public
    /// initialize the instance for a given REST and callback interface
    constructor Create(aRest: TSQLRest; const aGUID: TGUID); reintroduce;
    /// notify the associated TSQLRestServer that the callback is disconnnected
    // - i.e. will call TSQLRestServer's TServiceContainer.CallBackUnRegister()
    // - this method will process the unsubscription only once
    procedure CallbackRestUnregister; virtual;
    /// finalize the instance, and notify the TSQLRestServer that the callback
    // is now unreachable
    // - i.e. will call CallbackRestUnregister
    destructor Destroy; override;
    /// the associated TSQLRestServer instance, which will be notified
    // when the callback is released
    property Rest: TSQLRest read fRest;
    /// the interface type, implemented by this callback class
    property RestInterface: TGUID read fInterface write fInterface;
  end;

  /// asynchrounous callback to emulate a synchronous/blocking process
  // - once created, process will block via a WaitFor call, which will be
  // released when CallbackFinished() is called by the process background thread
  TBlockingCallback = class(TInterfacedCallback)
  protected
    fProcess: TBlockingProcess;
    function GetEvent: TBlockingEvent;
  public
    /// initialize the callback instance
    // - specify a time out millliseconds period after which blocking execution
    // should be handled as failure (if 0 is set, default 3000 will be used)
    // - you can optionally set a REST and callback interface for automatic
    // notification when this TInterfacedCallback will be released
    constructor Create(aTimeOutMs: integer;
      aRest: TSQLRest; const aGUID: TGUID); reintroduce;
    /// finalize the callback instance
    destructor Destroy; override;
    /// called to wait for the callback to be processed, or trigger timeout
    // - will block until CallbackFinished() is called by the processing thread
    // - returns the final state of the process, i.e. beRaised or beTimeOut
    function WaitFor: TBlockingEvent; virtual;
    /// should be called by the callback when the process is finished
    // - the caller will then let its WaitFor method return
    // - if aServerUnregister is TRUE, will also call CallbackRestUnregister to
    // notify the server that the callback is no longer needed
    // - will optionally log all published properties values to the log class
    // of the supplied REST instance
    procedure CallbackFinished(aRestForLog: TSQLRest;
      aServerUnregister: boolean=false); virtual;
    /// just a wrapper to reset the internal Event state to evNone
    // - may be used to re-use the same TBlockingCallback instance, after
    // a successfull WaitFor/CallbackFinished process
    // - returns TRUE on success (i.e. status was not beWaiting)
    // - if there is a WaitFor currently in progress, returns FALSE
    function Reset: boolean; virtual;
    /// the associated blocking process instance
    property Process: TBlockingProcess read fProcess;
  published
    /// the current state of process
    // - just a wrapper around Process.Event
    // - use Reset method to re-use this instance after a WaitFor process
    property Event: TBlockingEvent read GetEvent;
  end;

  /// this class implements a callback interface, able to write all remote ORM
  // notifications to the local DB
  // - could be supplied as callback parameter, possibly via WebSockets
  // transmission, to TSQLRestServer.RecordVersionSynchronizeSubscribeMaster()
  TServiceRecordVersionCallback = class(TInterfacedCallback,IServiceRecordVersionCallback)
  protected
    fTable: TSQLRecordClass;
    fRecordVersionField: TSQLPropInfoRTTIRecordVersion;
    fBatch: TSQLRestBatch;
    fSlave: TSQLRestServer; // fRest is master remote access
    fOnNotify: TOnBatchWrite;
    // local TSQLRecordTableDeleted.ID follows current Model -> pre-compute offset
    fTableDeletedIDOffset: Int64;
    procedure SetCurrentRevision(const Revision: TRecordVersion; Event: TSQLOccasion);
  public
    /// initialize the instance able to apply callbacks for a given table on
    // a local slave REST server from a remote master REST server
    // - the optional low-level aOnNotify callback will be triggerred for each
    // incoming notification, to track the object changes in real-time
    constructor Create(aSlave: TSQLRestServer; aMaster: TSQLRestClientURI;
      aTable: TSQLRecordClass; aOnNotify: TOnBatchWrite); reintroduce;
    /// finalize this callback instance
    destructor Destroy; override;
    /// this event will be raised on any Add on a versioned record
    procedure Added(const NewContent: RawJSON); virtual;
    /// this event will be raised on any Update on a versioned record
    procedure Updated(const ModifiedContent: RawJSON); virtual;
    /// this event will be raised on any Delete on a versioned record
    procedure Deleted(const ID: TID; const Revision: TRecordVersion); virtual;
    /// match TInterfaceFactory.MethodIndexCurrentFrameCallback signature,
    // so that TSQLHttpClientWebsockets.CallbackRequest will call it
    // - it will create a temporary TSQLRestBatch for the whole "jumbo frame"
    procedure CurrentFrame(isLast: boolean); virtual;
    /// low-level event handler triggerred by Added/Updated/Deleted methods
    property OnNotify: TOnBatchWrite read fOnNotify write fOnNotify;
  end;

  /// prototype of a class implementing redirection of a given interface
  // - as returned e.g. by TSQLRest.MultiRedirect method
  // - can be used as a main callback, then call Redirect() to manage
  // an internal list of redirections
  // - when you release this instance, will call Rest.Service.CallbackUnregister
  // with the associated fake callback generated
  IMultiCallbackRedirect = interface
    ['{E803A30A-8C06-4BB9-94E6-EB87EACFE980}']
    /// add or remove an interface callback to the internal redirection list
    // - will register a callback if aSubscribe is true
    // - will unregister a callback if aSubscribe is false
    // - supplied aCallback shoud implement the expected interface GUID
    // - this method will be implemented as thread-safe
    // - you can specify some method names, or all methods redirection if []
    procedure Redirect(const aCallback: IInvokable;
      const aMethodsNames: array of RawUTF8; aSubscribe: boolean=true); overload;
    /// add or remove a class instance callback to the internal redirection list
    // - will register a callback if aSubscribe is true
    // - will unregister a callback if aSubscribe is false
    // - supplied aCallback instance should implement the expected interface GUID
    // - this method will be implemented as thread-safe
    // - you can specify some method names, or all methods redirection if []
    procedure Redirect(const aCallback: TInterfacedObject;
      const aMethodsNames: array of RawUTF8; aSubscribe: boolean=true); overload;
  end;

  /// for TSQLRestCache, stores a table values
  TSQLRestCacheEntryValue = packed record
    /// corresponding ID
    ID: TID;
    /// GetTickCount64 shr 9 timestamp when this cached value was stored
    // - resulting time period has therefore a resolution of 512 ms, and
    // overflows after 70 years without computer reboot
    // - equals 0 when there is no JSON value cached
    Timestamp512: cardinal;
    /// some associated unsigned integer value
    // - not used by TSQLRestCache, but available at TSQLRestCacheEntry level
    Tag: cardinal;
    /// JSON encoded UTF-8 serialization of the record
    JSON: RawUTF8;
  end;

  /// for TSQLRestCache, stores all tables values
  TSQLRestCacheEntryValueDynArray = array of TSQLRestCacheEntryValue;

  /// for TSQLRestCache, stores a table settings and values
  {$ifdef USERECORDWITHMETHODS}TSQLRestCacheEntry = record
    {$else}TSQLRestCacheEntry = object{$endif}
  public
    /// TRUE if this table should use caching
    // - i.e. if was not set, or worth it for this table (e.g. in-memory table)
    CacheEnable: boolean;
    /// the whole specified Table content will be cached
    CacheAll: boolean;
    /// time out value (in ms)
    // - if 0, caching will never expire
    TimeOutMS: Cardinal;
    /// the number of entries stored in Values[]
    Count: integer;
    /// all cached IDs and JSON content
    Values: TSQLRestCacheEntryValueDynArray;
    /// TDynArray wrapper around the Values[] array
    Value: TDynArray;
    /// used to lock the table cache for multi thread safety
    Mutex: TSynLocker;
    /// initialize this table cache
    // - will set Value wrapper and Mutex handle - other fields should have
    // been cleared by caller (is the case for a TSQLRestCacheEntryDynArray)
    procedure Init;
    /// reset all settings corresponding to this table cache
    procedure Clear;
    /// finalize this table cache entry
    procedure Done;
    /// flush cache for a given Value[] index
    procedure FlushCacheEntry(Index: Integer);
    /// flush cache for all Value[]
    procedure FlushCacheAllEntries;
    /// add the supplied ID to the Value[] array
    procedure SetCache(aID: TID);
    /// update/refresh the cached JSON serialization of a given ID
    procedure SetJSON(aID: TID; const aJSON: RawUTF8; aTag: cardinal=0); overload;
    /// update/refresh the cached JSON serialization of a supplied Record
    procedure SetJSON(aRecord: TSQLRecord); overload;
    /// retrieve a JSON serialization of a given ID from cache
    function RetrieveJSON(aID: TID; var aJSON: RawUTF8; aTag: PCardinal=nil): boolean; overload;
    /// unserialize a JSON cached record of a given ID
    function RetrieveJSON(aID: TID; aValue: TSQLRecord; aTag: PCardinal=nil): boolean; overload;
    /// compute how much memory stored entries are using
    // - will also flush outdated entries
    function CachedMemory(FlushedEntriesCount: PInteger=nil): cardinal;
  end;

  /// for TSQLRestCache, stores all table settings and values
  // - this dynamic array will follow TSQLRest.Model.Tables[] layout, i.e. one
  // entry per TSQLRecord class in the data model
  TSQLRestCacheEntryDynArray = array of TSQLRestCacheEntry;

  /// implement a fast TSQLRecord cache, per ID, at the TSQLRest level
  // - purpose of this caching mechanism is to speed up retrieval of some common
  // values at either Client or Server level (like configuration settings)
  // - only caching synchronization is about the following RESTful basic commands:
  // RETRIEVE, ADD, DELETION and UPDATE (that is, a complex direct SQL UPDATE
  // or via TSQLRecordMany pattern won't be taken into account)
  // - only Simple fields are cached: e.g. the BLOB fields are not stored
  // - this cache is thread-safe (access is locked per table)
  // - this caching will be located at the TSQLRest level, that is no automated
  // synchronization is implemented between TSQLRestClient and TSQLRestServer:
  // you shall ensure that your code won't fail due to this restriction
  TSQLRestCache = class
  protected
    fRest: TSQLRest;
    /// fCache[] follows fRest.Model.Tables[] array: one entry per TSQLRecord
    fCache: TSQLRestCacheEntryDynArray;
    /// retrieve a record specified by its ID from cache into JSON content
    // - return '' if the item is not in cache
    function Retrieve(aTableIndex: integer; aID: TID): RawUTF8; overload;
    /// fill a record specified by its ID from cache into a new TSQLRecord instance
    // - return false if the item is not in cache
    // - this method will call RetrieveJSON method, unserializing the cached
    // JSON content into the supplied aValue instance
    function Retrieve(aID: TID; aValue: TSQLRecord): boolean; overload;
  public
    /// create a cache instance
    // - the associated TSQLModel will be used internaly
    constructor Create(aRest: TSQLRest); reintroduce;
    /// release the cache instance
    destructor Destroy; override;
    /// flush the cache
    // - this will flush all stored JSON content, but keep the settings
    // (SetCache/SetTimeOut) as before
    procedure Flush; overload;
    /// flush the cache for a given table
    // - this will flush all stored JSON content, but keep the settings
    // (SetCache/SetTimeOut) as before for this table
    procedure Flush(aTable: TSQLRecordClass); overload;
    /// flush the cache for a given record
    // - this will flush the stored JSON content for this record (and table
    // settings will be kept)
    procedure Flush(aTable: TSQLRecordClass; aID: TID); overload;
    /// flush the cache for a set of specified records
    // - this will flush the stored JSON content for these record (and table
    // settings will be kept)
    procedure Flush(aTable: TSQLRecordClass; const aIDs: array of TID); overload;
    /// flush the cache, and destroy all settings
    // - this will flush all stored JSON content, AND destroy the settings
    // (SetCache/SetTimeOut) to default (i.e. no cache enabled)
    procedure Clear;
    // - will fill the internal JSON cache of a given Table with data coming
    // from a REST query
    // - returns the number of TSQLRecord items actually cached
    // - may be handy to pre-load a set of values (e.g. a lookup table) from a
    // single REST query, without waiting for each record to be retrieved
    function FillFromQuery(aTable: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const): integer;
    /// activate the internal caching for a whole Table
    // - any cached item of this table will be flushed
    // - return true on success
    function SetCache(aTable: TSQLRecordClass): boolean; overload;
    /// activate the internal caching for a given TSQLRecord
    // - if this item is already cached, do nothing
    // - return true on success
    function SetCache(aTable: TSQLRecordClass; aID: TID): boolean; overload;
    /// activate the internal caching for a set of specified TSQLRecord
    // - if these items are already cached, do nothing
    // - return true on success
    function SetCache(aTable: TSQLRecordClass; const aIDs: array of TID): boolean; overload;
    /// activate the internal caching for a given TSQLRecord
    // - will cache the specified aRecord.ID item
    // - if this item is already cached, do nothing
    // - return true on success
    function SetCache(aRecord: TSQLRecord): boolean; overload;
    /// set the internal caching time out delay (in ms) for a given table
    // - actual resolution is 512 ms
    // - time out setting is common to all items of the table
    // - if aTimeOut is left to its default 0 value, caching will never expire
    // - return true on success
    function SetTimeOut(aTable: TSQLRecordClass; aTimeoutMS: cardinal): boolean;
    /// returns TRUE if the table is part of the current caching policy
    function IsCached(aTable: TSQLRecordClass): boolean;
    /// returns the number of JSON serialization records within this cache
    function CachedEntries: cardinal;
    /// returns the memory used by JSON serialization records within this cache
    // - this method will also flush any outdated entries in the cache
    function CachedMemory(FlushedEntriesCount: PInteger=nil): cardinal;
    /// read-only access to the associated TSQLRest instance
    property Rest: TSQLRest read fRest;
  public { TSQLRest low level methods which are not to be called usualy: }
    /// TSQLRest instance shall call this method when a record is added or updated
    // - this overloaded method expects the content to be specified as JSON object
    procedure Notify(aTable: TSQLRecordClass; aID: TID; const aJSON: RawUTF8;
     aAction: TSQLOccasion); overload;
    /// TSQLRest instance shall call this method when a record is retrieved,
    // added or updated
    // - this overloaded method expects the content to be specified as JSON object,
    // and TSQLRecordClass to be specified as its index in Rest.Model.Tables[]
    procedure Notify(aTableIndex: integer; aID: TID; const aJSON: RawUTF8;
      aAction: TSQLOccasion); overload;
    /// TSQLRest instance shall call this method when a record is added or updated
    // - this overloaded method will call the other Trace method, serializing
    // the supplied aRecord content as JSON (not in the case of seDelete)
    procedure Notify(aRecord: TSQLRecord; aAction: TSQLOccasion); overload;
    /// TSQLRest instance shall call this method when a record is deleted
    // - this method is dedicated for a record deletion
    procedure NotifyDeletion(aTable: TSQLRecordClass; aID: TID); overload;
    /// TSQLRest instance shall call this method when a record is deleted
    // - this method is dedicated for a record deletion
    // - TSQLRecordClass to be specified as its index in Rest.Model.Tables[]
    procedure NotifyDeletion(aTableIndex: integer; aID: TID); overload;
    /// TSQLRest instance shall call this method when records are deleted
    // - TSQLRecordClass to be specified as its index in Rest.Model.Tables[]
    procedure NotifyDeletions(aTableIndex: integer; const aIDs: array of Int64); overload;
  end;

  /// how a TSQLRest class may execute read or write operations
  // - used e.g. for TSQLRestServer.AcquireWriteMode or
  // TSQLRestServer.AcquireExecutionMode/AcquireExecutionLockedTimeOut
  TSQLRestServerAcquireMode = (
    amUnlocked, amLocked, amBackgroundThread, amBackgroundORMSharedThread
    {$ifndef LVCL}, amMainThread{$endif});

  /// class-reference type (metaclass) of a TSQLRest kind
  TSQLRestClass = class of TSQLRest;

  /// a dynamic array of TSQLRest instances
  TSQLRestDynArray = array of TSQLRest;

  /// a dynamic array of TSQLRest instances, owniing the instances
  TSQLRestObjArray = array of TSQLRest;

  /// used to store the execution parameters for a TSQLRest instance
  TSQLRestAcquireExecution = class(TSynPersistentLock)
  public
    /// how read or write operations will be executed
    Mode: TSQLRestServerAcquireMode;
    /// delay before failing to acquire the lock
    LockedTimeOut: cardinal;
    /// background thread instance (if any)
    Thread: TSynBackgroundThreadMethod;
    /// finalize the memory structure, and the associated background thread
    destructor Destroy; override;
  end;

  /// optionally called after TSQLRest.AsynchRedirect background execution
  // - to retrieve any output result value, as JSON-encoded content
  // - as used in TSQLRestBackgroundTimer.AsynchBackgroundExecute protected method
  TOnAsynchRedirectResult = procedure(const aMethod: TServiceMethod;
    const aInstance: IInvokable; const aParams, aResult: RawUTF8) of object;

  /// TThread able to run one or several tasks at a periodic pace, or do
  // asynchronous interface or batch execution, with proper TSQLRest integration
  // - used e.g. by TSQLRest.TimerEnable/AsynchRedirect/AsynchBatchStart methods
  // - TSQLRest.BackgroundTimer will define one instance, but you may create
  // other dedicated instances to instantiate separated threads
  TSQLRestBackgroundTimer = class(TSynBackgroundTimer)
  protected
    fRest: TSQLRest;
    fBackgroundBatch: array of TSQLRestBatchLocked;
    fBackgroundInterning: array of TRawUTF8Interning;
    fBackgroundInterningMaxRefCount: integer;
    // used by AsynchRedirect() and AsynchBatch()
    function AsynchBatchIndex(aTable: TSQLRecordClass): integer;
    function AsynchBatchLocked(aTable: TSQLRecordClass; out aBatch: TSQLRestBatchLocked): boolean;
    procedure AsynchBatchUnLock(aBatch: TSQLRestBatchLocked);
    procedure AsynchBatchExecute(Sender: TSynBackgroundTimer;
      Event: TWaitResult; const Msg: RawUTF8);
    procedure AsynchBackgroundExecute(Sender: TSynBackgroundTimer;
      Event: TWaitResult; const Msg: RawUTF8);
    procedure AsynchBackgroundInterning(Sender: TSynBackgroundTimer;
      Event: TWaitResult; const Msg: RawUTF8);
  public
    /// initialize the thread for a periodic task processing
    constructor Create(aRest: TSQLRest; const aThreadName: RawUTF8='';
      aStats: TSynMonitorClass=nil); reintroduce; virtual;
    /// finalize the thread
    destructor Destroy; override;
    /// define asynchronous execution of interface methods in a background thread
    // - this method implements any interface via a fake class, which will
    // redirect all methods calls into calls of another interface, but as a FIFO
    // in a background thread, shared with TimerEnable/TimerDisable process
    // - parameters will be serialized and stored as JSON in the queue
    // - by design, only procedure methods without any output parameters are
    // allowed, since their execution will take place asynchronously
    // - of course, a slight delay is introduced in aDestinationInterface
    // methods execution, but the main process thread is not delayed any more,
    // and is free from potential race conditions
    // - the returned fake aCallbackInterface should be freed before TSQLRest
    // is destroyed, to release the redirection resources
    // - it is an elegant resolution to the most difficult implementation
    // problem of SOA callbacks, which is to avoid race condition on reentrance,
    // e.g. if a callback is run from a thread, and then the callback code try
    // to execute something in the context of the initial thread, protected
    // by a critical section (mutex)
    procedure AsynchRedirect(const aGUID: TGUID;
      const aDestinationInterface: IInvokable; out aCallbackInterface;
      const aOnResult: TOnAsynchRedirectResult=nil); overload;
    /// define asynchronous execution of interface methods in a background thread
    // - this method implements any interface via a fake class, which will
    // redirect all methods calls into calls of another interface, but as a FIFO
    // in a background thread, shared with TimerEnable/TimerDisable process
    // - parameters will be serialized and stored as JSON in the queue
    // - by design, only procedure methods without any output parameters are
    // allowed, since their execution will take place asynchronously
    // - of course, a slight delay is introduced in aDestinationInterface
    // methods execution, but the main process thread is not delayed any more,
    // and is free from potential race conditions
    // - the returned fake aCallbackInterface should be freed before TSQLRest
    // is destroyed, to release the redirection resources
    // - it is an elegant resolution to the most difficult implementation
    // problem of SOA callbacks, which is to avoid race condition on reentrance,
    // e.g. if a callback is run from a thread, and then the callback code try
    // to execute something in the context of the initial thread, protected
    // by a critical section (mutex)
    procedure AsynchRedirect(const aGUID: TGUID;
      const aDestinationInstance: TInterfacedObject; out aCallbackInterface;
      const aOnResult: TOnAsynchRedirectResult=nil); overload;
    /// prepare an asynchronous ORM BATCH process, executed in a background thread
    // - will initialize a TSQLRestBatch and call TimerEnable to initialize the
    // background thread, following the given processing period (in seconds),
    // or the TSQLRestBatch.Count threshold to call BatchSend
    // - actual REST/CRUD commands will take place via AsynchBatchAdd,
    // AsynchBatchUpdate and AsynchBatchDelete methods
    // - only a single AsynchBatch() call per Table is allowed at a time, unless
    // AsynchBatchStop method is used to flush the current asynchronous BATCH
    // - using a BATCH in a dedicated thread will allow very fast bacgkround
    // asynchronous process of ORM methods, sufficient for most use cases
    function AsynchBatchStart(Table: TSQLRecordClass; SendSeconds: integer;
      PendingRowThreshold: integer=500; AutomaticTransactionPerRow: integer=1000;
      Options: TSQLRestBatchOptions=[boExtendedJSON]): boolean;
    /// finalize asynchronous ORM BATCH process, executed in a background thread
    // - should have been preceded by a call to AsynchBatch(), or returns false
    // - Table=nil will release all existing batch instances
    function AsynchBatchStop(Table: TSQLRecordClass): boolean;
    /// create a new ORM member in a BATCH to be written in a background thread
    // - should have been preceded by a call to AsynchBatchStart(), or returns -1
    // - is a wrapper around TSQLRestBatch.Add() sent in the Timer thread,
    // so will return the index in the BATCH rows, not the created TID
    // - this method is thread-safe
    function AsynchBatchAdd(Value: TSQLRecord; SendData: boolean;
      ForceID: boolean=false; const CustomFields: TSQLFieldBits=[];
      DoNotAutoComputeFields: boolean=false): integer;
    /// append some JSON content in a BATCH to be writen in a background thread
    // - could be used to emulate AsynchBatchAdd() with an already pre-computed
    // JSON object
    // - is a wrapper around TSQLRestBatch.RawAdd() sent in the Timer thread,
    // so will return the index in the BATCH rows, not the created TID
    // - this method is thread-safe
    function AsynchBatchRawAdd(Table: TSQLRecordClass; const SentData: RawUTF8): integer;
    /// append some JSON content in a BATCH to be writen in a background thread
    // - could be used to emulate AsynchBatchAdd() with an already pre-computed
    // JSON object, as stored in a TTextWriter instance
    // - is a wrapper around TSQLRestBatch.RawAppend.AddNoJSONEscape(SentData)
    // in the Timer thread
    // - this method is thread-safe
    procedure AsynchBatchRawAppend(Table: TSQLRecordClass; SentData: TTextWriter);
    /// update an ORM member in a BATCH to be written in a background thread
    // - should have been preceded by a call to AsynchBatchStart(), or returns -1
    // - is a wrapper around the TSQLRestBatch.Update() sent in the Timer thread
    // - this method is thread-safe
    function AsynchBatchUpdate(Value: TSQLRecord; const CustomFields: TSQLFieldBits=[];
      DoNotAutoComputeFields: boolean=false): integer;
    /// delete an ORM member in a BATCH to be written in a background thread
    // - should have been preceded by a call to AsynchBatchStart(), or returns -1
    // - is a wrapper around the TSQLRestBatch.Delete() sent in the Timer thread
    // - this method is thread-safe
    function AsynchBatchDelete(Table: TSQLRecordClass; ID: TID): integer;
    /// allows background garbage collection of specified RawUTF8 interning
    // - will run Interning.Clean(2) every 5 minutes by default
    // - set InterningMaxRefCount=0 to disable process of the Interning instance
    procedure AsynchInterning(Interning: TRawUTF8Interning;
      InterningMaxRefCount: integer=2; PeriodMinutes: integer=5);
  published
    /// the identifier of the thread, as logged
    property Name: RawUTF8 read fThreadName;
  end;

  /// a generic REpresentational State Transfer (REST) client/server class
  TSQLRest = class
  protected
    fModel: TSQLModel;
    fCache: TSQLRestCache;
    fTransactionActiveSession: cardinal;
    fTransactionTable: TSQLRecordClass;
    fServerTimestampOffset: TDateTime;
    fServerTimestampCacheTix: cardinal;
    fServerTimestampCacheValue: TTimeLogBits;
    fServices: TServiceContainer;
    fPrivateGarbageCollector: TSynObjectList;
    fRoutingClass: TSQLRestServerURIContextClass;
    fBackgroundTimer: TSQLRestBackgroundTimer;
    fOnDecryptBody, fOnEncryptBody: TNotifyRestBody;
    fCustomEncryptAES: TAESAbstract;
    fCustomEncryptSign: TSynSigner;
    fCustomEncryptCompress: TAlgoCompress;
    fCustomEncryptContentPrefix, fCustomEncryptContentPrefixUpper, fCustomEncryptUrlIgnore: RawUTF8;
    fAcquireExecution: array[TSQLRestServerURIContextCommand] of TSQLRestAcquireExecution;
    {$ifdef WITHLOG}
    fLogClass: TSynLogClass;   // =SQLite3Log by default
    fLogFamily: TSynLogFamily; // =SQLite3Log.Family by default
    procedure SetLogClass(aClass: TSynLogClass); virtual;
    function GetLogClass: TSynLogClass;
    {$endif}
    procedure InternalCustomEncrypt(Sender: TSQLRest; var Body,Head,Url: RawUTF8);
    procedure InternalCustomDecrypt(Sender: TSQLRest; var Body,Head,Url: RawUTF8);
    function EnsureBackgroundTimerExists: TSQLRestBackgroundTimer;
    /// log the corresponding text (if logging is enabled)
    procedure InternalLog(const Text: RawUTF8; Level: TSynLogInfo); overload;
      {$ifdef HASINLINE}inline;{$endif}
    procedure InternalLog(const Format: RawUTF8; const Args: array of const;
      Level: TSynLogInfo=sllTrace); overload;
    /// internal method used by Delete(Table,SQLWhere) method
    function InternalDeleteNotifyAndGetIDs(Table: TSQLRecordClass; const SQLWhere: RawUTF8;
      var IDs: TIDDynArray): boolean;
    /// retrieve the server time stamp
    // - default implementation will use fServerTimestampOffset to compute
    // the value from PC time (i.e. NowUTC+fServerTimestampOffset as TTimeLog)
    // - inherited classes may override this method, or set the appropriate
    // value in fServerTimestampOffset protected field
    function GetServerTimestamp: TTimeLog; virtual;
    /// compute the server time stamp offset from the given
    procedure SetServerTimestamp(const Value: TTimeLog);
    /// handle Client or Server side fast in-memory cache
    // - creates the internal fCache instance, if necessary
    function GetCache: TSQLRestCache;
      {$ifdef HASINLINE}inline;{$endif}
    /// returns TRUE if this table is worth caching (e.g. not in memory)
    // - this default implementation always returns TRUE (always allow cache)
    function CacheWorthItForTable(aTableIndex: cardinal): boolean; virtual;
    /// compute SELECT ... FROM TABLE WHERE ...
    function SQLComputeForSelect(Table: TSQLRecordClass;
      const FieldNames, WhereClause: RawUTF8): RawUTF8;
    /// wrapper method for RoutingClass property
    procedure SetRoutingClass(aServicesRouting: TSQLRestServerURIContextClass);
    /// wrapper methods to access fAcquireExecution[]
    function GetAcquireExecutionMode(Cmd: TSQLRestServerURIContextCommand): TSQLRestServerAcquireMode;
    procedure SetAcquireExecutionMode(Cmd: TSQLRestServerURIContextCommand; Value: TSQLRestServerAcquireMode);
    function GetAcquireExecutionLockedTimeOut(Cmd: TSQLRestServerURIContextCommand): cardinal;
    procedure SetAcquireExecutionLockedTimeOut(Cmd: TSQLRestServerURIContextCommand; Value: cardinal);
    /// internal method called by TSQLRestServer.Batch() to process fast sending
    // to remote database engine (e.g. Oracle bound arrays or MS SQL Bulk insert)
    // - returns TRUE if this method is handled by the engine, or FALSE if
    // individual calls to Engine*() are expected
    // - this default implementation returns FALSE
    // - an overridden method returning TRUE shall ensure that calls to
    // EngineAdd / EngineUpdate / EngineDelete (depending of supplied Method)
    // will properly handle operations until InternalBatchStop() is called
    function InternalBatchStart(Method: TSQLURIMethod;
      BatchOptions: TSQLRestBatchOptions): boolean; virtual;
    /// internal method called by TSQLRestServer.Batch() to process fast sending
    // to remote database engine (e.g. Oracle bound arrays or MS SQL Bulk insert)
    // - this default implementation will raise an EORMException (since
    // InternalBatchStart returns always FALSE at this TSQLRest level)
    // - InternalBatchStart/Stop may safely use a lock for multithreading:
    // implementation in TSQLRestServer.Batch use a try..finally block
    procedure InternalBatchStop; virtual;
    /// send/execute the supplied JSON BATCH content, and return the expected array
    // - this method will be implemented for TSQLRestClient and TSQLRestServer only
    // - this default implementation will trigger an EORMException
    // - warning: supplied JSON Data can be parsed in-place, so modified
    function EngineBatchSend(Table: TSQLRecordClass; var Data: RawUTF8;
       var Results: TIDDynArray; ExpectedResultsCount: integer): integer; virtual;
    /// any overriden TSQLRest class should call it in the initialization section
    class procedure RegisterClassNameForDefinition;
    // inherited classes should unserialize the other aDefinition properties by
    // overriding this method, in a reverse logic to overriden DefinitionTo()
    constructor RegisteredClassCreateFrom(aModel: TSQLModel;
      aDefinition: TSynConnectionDefinition); virtual;
    /// used by Add() and AddWithBlobs() before EngineAdd()
    procedure GetJSONValuesForAdd(TableIndex: integer; Value: TSQLRecord;
      ForceID, DoNotAutoComputeFields, WithBlobs: boolean;
      CustomFields: PSQLFieldBits; var result: RawUTF8);
    /// used by all overloaded Add() methods
    function InternalAdd(Value: TSQLRecord; SendData: boolean; CustomFields: PSQLFieldBits;
      ForceID, DoNotAutoComputeFields: boolean): TID; virtual;
   protected // these abstract methods must be overriden by real database engine
    /// retrieve a list of members as JSON encoded data
    // - implements REST GET collection
    // - returns '' on error, or JSON data, even with no result rows
    // - override this method for direct data retrieval from the database engine
    // and direct JSON export, avoiding a TSQLTable which allocates memory for every
    // field values before the JSON export
    // - can be called for a single Table (ModelRoot/Table), or with low level SQL
    // query (ModelRoot + SQL sent as request body)
    // - if ReturnedRowCount points to an integer variable, it must be filled with
    // the number of row data returned (excluding field names)
    // - this method must be implemented in a thread-safe manner
    function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false;
      ReturnedRowCount: PPtrInt=nil): RawUTF8; virtual; abstract;
    /// Execute directly a SQL statement, without any result
    // - implements POST SQL on ModelRoot URI
    // - return true on success
    // - override this method for proper calling the database engine
    // - don't call this method in normal cases
    // - this method must be implemented to be thread-safe
    function EngineExecute(const aSQL: RawUTF8): boolean; virtual; abstract;
    /// get a member from its ID
    // - implements REST GET member
    // - returns the data of this object as JSON
    // - override this method for proper data retrieval from the database engine
    // - this method must be implemented in a thread-safe manner
    function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; virtual; abstract;
    /// create a new member
    // - implements REST POST collection
    // - SentData can contain the JSON object with field values to be added
    // - class is taken from Model.Tables[TableModelIndex]
    // - returns the TSQLRecord ID/RowID value, 0 on error
    // - if a "RowID":.. or "ID":.. member is set in SentData, it shall force
    // this value as insertion ID
    // - override this method for proper calling the database engine
    // - this method must be implemented in a thread-safe manner
    function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; virtual; abstract;
    /// update a member
    // - implements REST PUT collection
    // - SentData can contain the JSON object with field values to be added
    // - returns true on success
    // - override this method for proper calling the database engine
    // - this method must be implemented in a thread-safe manner
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; virtual; abstract;
    /// delete a member
    // - implements REST DELETE collection
    // - returns true on success
    // - override this method for proper calling the database engine
    // - this method must be implemented in a thread-safe manner
    function EngineDelete(TableModelIndex: integer; ID: TID): boolean; virtual; abstract;
    /// delete several members, from a WHERE clause
    // - IDs[] contains the already-computed matching IDs for SQLWhere
    // - returns true on success
    // - override this method for proper calling the database engine, i.e.
    // using either IDs[] or a faster SQL statement
    // - this method must be implemented in a thread-safe manner
    function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; virtual; abstract;
    /// get a blob field content from its member ID and field name
    // - implements REST GET member with a supplied blob field name
    // - returns TRUE on success
    // - returns the data of this blob as raw binary (not JSON) in BlobData
    // - override this method for proper data retrieval from the database engine
    // - this method must be implemented in a thread-safe manner
    function EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; virtual; abstract;
    /// update a blob field content from its member ID and field name
    // - implements REST PUT member with a supplied blob field name
    // - returns TRUE on success
    // - the data of this blob must be specified as raw binary (not JSON) in BlobData
    // - override this method for proper data retrieval from the database engine
    // - this method must be implemented in a thread-safe manner
    function EngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; virtual; abstract;
    /// update an individual record field value from a specified ID or Value
    // - return true on success
    // - will allow execution of requests like
    // $ UPDATE tablename SET setfieldname=setvalue WHERE wherefieldname=wherevalue
    // - SetValue and WhereValue parameters must match our inline format, i.e.
    // by double quoted with " for strings, or be plain text for numbers - e.g.
    // $ Client.EngineUpdateField(TSQLMyRecord,'FirstName','"Smith"','RowID','10')
    // but you should better use the UpdateField() overload methods instead
    // - WhereFieldName and WhereValue must be set: for security reasons,
    // implementations of this method will reject an UPDATE without any WHERE
    // clause, so you won't be able to use it to execute such statements:
    // $ UPDATE tablename SET setfieldname=setvalue
    // - this method must be implemented in a thread-safe manner
    function EngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; virtual; abstract;
    /// increments one integer field value
    // - this default implementation is just a wrapper around OneFieldValue +
    // UpdateField methods
    function EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; virtual;
    function GetCurrentSessionUserID: TID; virtual; abstract;
  public
    /// initialize the class, and associate it to a specified database Model
    constructor Create(aModel: TSQLModel); virtual;
    /// release internal used instances
    // - e.g. release associated TSQLModel or TServiceContainer
    destructor Destroy; override;
    /// save the TSQLRest properties into a persistent storage object
    // - you can then use TSQLRest.CreateFrom() to re-instantiate it
    // - current Definition.Key value will be used for the password encryption
    // - this default implementation will set the class name in Definition.Kind:
    // inherited classes should override this method and serialize other
    // properties, then override RegisteredClassCreateFrom() protected method
    // to initiate the very same instance
    procedure DefinitionTo(Definition: TSynConnectionDefinition); virtual;
    /// save the properties into a JSON file
    // - you can then use TSQLRest.CreateFromJSON() to re-instantiate it
    // - you can specify a custom Key, if the default is not enough for you
    function DefinitionToJSON(Key: cardinal=0): RawUTF8;
    /// save the properties into a JSON file
    // - you can then use TSQLRest.CreateFromFile() to re-instantiate it
    // - you can specify a custom Key, if the default is not enough for you
    procedure DefinitionToFile(const aJSONFile: TFileName; aKey: cardinal=0);
    /// create a new TSQLRest instance from its Model and stored values
    // - aDefinition.Kind will define the actual class which will be
    // instantiated: currently TSQLRestServerFullMemory, TSQLRestServerDB,
    // TSQLRestClientURINamedPipe, TSQLRestClientURIMessage,
    // TSQLHttpClientWinSock, TSQLHttpClientWinINet, TSQLHttpClientWinHTTP,
    // and TSQLHttpClientCurl classes are recognized by this method
    // - then other aDefinition fields will be used to refine the instance:
    // please refer to each overriden DefinitionTo() method documentation
    // - use TSQLRestMongoDBCreate() and/or TSQLRestExternalDBCreate() instead
    // to create a TSQLRest instance will all tables defined as external when
    // aDefinition.Kind is 'MongoDB' or a TSQLDBConnectionProperties class
    // - will raise an exception if the supplied definition are not valid
    class function CreateFrom(aModel: TSQLModel;
      aDefinition: TSynConnectionDefinition): TSQLRest;
    /// try to create a new TSQLRest instance from its Model and stored values
    // - will return nil if the supplied definition are not valid
    // - if the newly created instance is a TSQLRestServer, will force the
    // supplied aServerHandleAuthentication parameter to enable authentication
    class function CreateTryFrom(aModel: TSQLModel;
      aDefinition: TSynConnectionDefinition; aServerHandleAuthentication: boolean): TSQLRest;
    /// create a new TSQLRest instance from its Model and JSON stored values
    // - aDefinition.Kind will define the actual class which will be instantiated
    // - you can specify a custom Key, if the default is not safe enough for you
    class function CreateFromJSON(aModel: TSQLModel;
      const aJSONDefinition: RawUTF8; aKey: cardinal=0): TSQLRest;
    /// create a new TSQLRest instance from its Model and a JSON file
    // - aDefinition.Kind will define the actual class which will be instantiated
    // - you can specify a custom Key, if the default is not safe enough for you
    class function CreateFromFile(aModel: TSQLModel;
      const aJSONFile: TFileName; aKey: cardinal=0): TSQLRest;
    /// retrieve the registered class from the aDefinition.Kind string
    class function ClassFrom(aDefinition: TSynConnectionDefinition): TSQLRestClass;
    {$ifdef WITHLOG}
    /// the logging family used for this instance
    // - is set by default to SQLite3Log.Family, but could be set to something
    // else by setting a custom class to the LogClass property
    property LogFamily: TSynLogFamily read fLogFamily;
    {$endif}
    /// a local "Garbage collector" list, for some classes instances which must
    // live during the whole TSQLRestServer process
    // - is used internally by the class, but can be used for business code
    property PrivateGarbageCollector: TSynObjectList read fPrivateGarbageCollector;
  public
    /// get the row count of a specified table
    // - returns -1 on error
    // - returns the row count of the table on success
    // - calls internaly the "SELECT Count(*) FROM TableName;" SQL statement
    function TableRowCount(Table: TSQLRecordClass): Int64; virtual;
    /// check if there is some data rows in a specified table
    // - calls internaly a "SELECT RowID FROM TableName LIMIT 1" SQL statement,
    // which is much faster than testing if "SELECT count(*)" equals 0 - see
    // @http://stackoverflow.com/questions/8988915
    function TableHasRows(Table: TSQLRecordClass): boolean; virtual;
    /// search for the last inserted ID in a specified table
    // - returns -1 on error
    // - will execute by default "SELECT max(rowid) FROM TableName"
    function TableMaxID(Table: TSQLRecordClass): TID; virtual;
    /// check if a given ID do exist for a given table
    function MemberExists(Table: TSQLRecordClass; ID: TID): boolean; virtual;
    /// get the UTF-8 encoded value of an unique field with a Where Clause
    // - example of use - including inlined parameters via :(...):
    // ! aClient.OneFieldValue(TSQLRecord,'Name','ID=:(23):')
    // you should better call the corresponding overloaded method as such:
    // ! aClient.OneFieldValue(TSQLRecord,'Name','ID=?',[aID])
    // which is the same as calling:
    // ! aClient.OneFieldValue(TSQLRecord,'Name',FormatUTF8('ID=?',[],[23]))
    // - call internaly ExecuteList() to get the value
    function OneFieldValue(Table: TSQLRecordClass;
      const FieldName, WhereClause: RawUTF8): RawUTF8; overload;
    /// get the Int64 value of an unique field with a Where Clause
    // - call internaly ExecuteList() to get the value
    function OneFieldValueInt64(Table: TSQLRecordClass;
      const FieldName, WhereClause: RawUTF8; Default: Int64=0): Int64;
    /// get the UTF-8 encoded value of an unique field with a Where Clause
    // - this overloaded function will call FormatUTF8 to create the Where Clause
    // from supplied parameters, binding all '?' chars with Args[] values
    // - example of use:
    // ! aClient.OneFieldValue(TSQLRecord,'Name','ID=?',[aID])
    // - call internaly ExecuteList() to get the value
    // - note that this method prototype changed with revision 1.17 of the
    // framework: array of const used to be Args and '%' in the FormatSQLWhere
    // statement, whereas it now expects bound parameters as '?'
    function OneFieldValue(Table: TSQLRecordClass; const FieldName: RawUTF8;
      const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const): RawUTF8; overload;
    /// get the UTF-8 encoded value of an unique field with a Where Clause
    // - this overloaded function will call FormatUTF8 to create the Where Clause
    // from supplied parameters, replacing all '%' chars with Args[], and all '?'
    // chars with Bounds[] (inlining them with :(...): and auto-quoting strings)
    // - example of use:
    // ! OneFieldValue(TSQLRecord,'Name','%=?',['ID'],[aID])
    // - call internaly ExecuteList() to get the value
    function OneFieldValue(Table: TSQLRecordClass; const FieldName: RawUTF8;
      const WhereClauseFmt: RawUTF8; const Args, Bounds: array of const): RawUTF8; overload;
    /// get one integer value of an unique field with a Where Clause
    // - this overloaded function will return the field value as integer
    function OneFieldValue(Table: TSQLRecordClass; const FieldName: RawUTF8;
      const WhereClauseFmt: RawUTF8; const Args, Bounds: array of const;
      out Data: Int64): boolean; overload;
    /// get the UTF-8 encoded value of an unique field from its ID
    // - example of use: OneFieldValue(TSQLRecord,'Name',23)
    // - call internaly ExecuteList() to get the value
    function OneFieldValue(Table: TSQLRecordClass;
      const FieldName: RawUTF8; WhereID: TID): RawUTF8; overload;
    /// get the UTF-8 encoded value of some fields with a Where Clause
    // - example of use: MultiFieldValue(TSQLRecord,['Name'],Name,'ID=:(23):')
    // (using inlined parameters via :(...): is always a good idea)
    // - FieldValue[] will have the same length as FieldName[]
    // - return true on success, false on SQL error or no result
    // - call internaly ExecuteList() to get the list
    function MultiFieldValue(Table: TSQLRecordClass;
      const FieldName: array of RawUTF8; var FieldValue: array of RawUTF8;
      const WhereClause: RawUTF8): boolean; overload;
    /// get the UTF-8 encoded value of some fields from its ID
    // - example of use: MultiFieldValue(TSQLRecord,['Name'],Name,23)
    // - FieldValue[] will have the same length as FieldName[]
    // - return true on success, false on SQL error or no result
    // - call internaly ExecuteList() to get the list
    function MultiFieldValue(Table: TSQLRecordClass;
      const FieldName: array of RawUTF8; var FieldValue: array of RawUTF8;
      WhereID: TID): boolean; overload;
    /// get the UTF-8 encoded values of an unique field with a Where Clause
    // - example of use: OneFieldValue(TSQLRecord,'FirstName','Name=:("Smith"):',Data)
    // (using inlined parameters via :(...): is always a good idea)
    // - leave WhereClause void to get all records
    // - call internaly ExecuteList() to get the list
    // - returns TRUE on success, FALSE if no data was retrieved
    function OneFieldValues(Table: TSQLRecordClass; const FieldName: RawUTF8;
      const WhereClause: RawUTF8; out Data: TRawUTF8DynArray): boolean; overload;
    /// get the integer value of an unique field with a Where Clause
    // - example of use: OneFieldValue(TSQLRecordPeople,'ID','Name=:("Smith"):',Data)
    // (using inlined parameters via :(...): is always a good idea)
    // - leave WhereClause void to get all records
    // - call internaly ExecuteList() to get the list
    function OneFieldValues(Table: TSQLRecordClass; const FieldName: RawUTF8;
      const WhereClause: RawUTF8; var Data: TInt64DynArray; SQL: PRawUTF8=nil): boolean; overload;
    /// dedicated method used to retrieve free-text matching DocIDs
    // - this method works for TSQLRecordFTS3, TSQLRecordFTS4 and TSQLRecordFTS5
    // - this method expects the column/field names to be supplied in the MATCH
    // statement clause
    // - example of use:  FTSMatch(TSQLMessage,'Body MATCH :("linu*"):',IntResult)
    // (using inlined parameters via :(...): is always a good idea)
    function FTSMatch(Table: TSQLRecordFTS3Class; const WhereClause: RawUTF8;
      var DocID: TIDDynArray): boolean; overload;
    /// dedicated method used to retrieve free-text matching DocIDs with
    // enhanced ranking information
    // - this method works for TSQLRecordFTS3, TSQLRecordFTS4 and TSQLRecordFTS5
    // - this method will search in all FTS3 columns, and except some floating-point
    // constants for weigthing each column (there must be the same number of
    // PerFieldWeight parameters as there are columns in the TSQLRecordFTS3 table)
    // - example of use:  FTSMatch(TSQLDocuments,'"linu*"',IntResult,[1,0.5])
    // which will sort the results by the rank obtained with the 1st column/field
    // beeing given twice the weighting of those in the 2nd (and last) column
    // - FTSMatch(TSQLDocuments,'linu*',IntResult,[1,0.5]) will perform a
    // SQL query as such, which is the fastest way of ranking according to
    // http://www.sqlite.org/fts3.html#appendix_a
    // $ SELECT RowID FROM Documents WHERE Documents MATCH 'linu*'
    // $ ORDER BY rank(matchinfo(Documents),1.0,0.5) DESC
    function FTSMatch(Table: TSQLRecordFTS3Class; const MatchClause: RawUTF8;
      var DocID: TIDDynArray; const PerFieldWeight: array of double;
      limit: integer=0; offset: integer=0): boolean; overload;
    /// get the CSV-encoded UTF-8 encoded values of an unique field with a Where Clause
    // - example of use: OneFieldValue(TSQLRecord,'FirstName','Name=:("Smith")',Data)
    // (using inlined parameters via :(...): is always a good idea)
    // - leave WhereClause void to get all records
    // - call internaly ExecuteList() to get the list
    // - using inlined parameters via :(...): in WhereClause is always a good idea
    function OneFieldValues(Table: TSQLRecordClass; const FieldName: RawUTF8;
      const WhereClause: RawUTF8=''; const Separator: RawUTF8=','): RawUTF8; overload;
    /// get the string-encoded values of an unique field into some TStrings
    // - Items[] will be filled with string-encoded values of the given field)
    // - Objects[] will be filled with pointer(ID)
    // - call internaly ExecuteList() to get the list
    // - returns TRUE on success, FALSE if no data was retrieved
    // - if IDToIndex is set, its value will be replaced with the index in
    // Strings.Objects[] where ID=IDToIndex^
    // - using inlined parameters via :(...): in WhereClause is always a good idea
    function OneFieldValues(Table: TSQLRecordClass;
      const FieldName, WhereClause: RawUTF8; Strings: TStrings;
      IDToIndex: PID=nil): Boolean; overload;
    /// Execute directly a SQL statement, expecting a list of resutls
    // - return a result table on success, nil on failure
    // - FieldNames can be the CSV list of field names to be retrieved
    // - if FieldNames is '', will get all simple fields, excluding BLOBs
    // - if FieldNames is '*', will get ALL fields, including ID and BLOBs
    // - call internaly ExecuteList() to get the list
    // - using inlined parameters via :(...): in WhereClause is always a good idea
    function MultiFieldValues(Table: TSQLRecordClass; const FieldNames: RawUTF8;
       const WhereClause: RawUTF8=''): TSQLTableJSON; overload; virtual;
    /// Execute directly a SQL statement, expecting a list of resutls
    // - return a result table on success, nil on failure
    // - FieldNames can be the CSV list of field names to be retrieved
    // - if FieldNames is '', will get all simple fields, excluding BLOBs
    // - if FieldNames is '*', will get ALL fields, including ID and BLOBs
    // - this overloaded function will call FormatUTF8 to create the Where Clause
    // from supplied parameters, binding all '?' chars with Args[] values
    // - example of use:
    // ! aList := aClient.MultiFieldValues(TSQLRecord,'Name,FirstName','Salary>=?',[aMinSalary]);
    // - call overloaded MultiFieldValues() / ExecuteList() to get the list
    // - note that this method prototype changed with revision 1.17 of the
    // framework: array of const used to be Args and '%' in the WhereClauseFormat
    // statement, whereas it now expects bound parameters as '?'
    function MultiFieldValues(Table: TSQLRecordClass; const FieldNames: RawUTF8;
      const WhereClauseFormat: RawUTF8; const BoundsSQLWhere: array of const): TSQLTableJSON; overload;
    /// Execute directly a SQL statement, expecting a list of results
    // - return a result table on success, nil on failure
    // - FieldNames can be the CSV list of field names to be retrieved
    // - if FieldNames is '', will get all simple fields, excluding BLOBs
    // - if FieldNames is '*', will get ALL fields, including ID and BLOBs
    // - in this version, the WHERE clause can be created with the same format
    // as FormatUTF8() function, replacing all '%' chars with Args[], and all '?'
    // chars with Bounds[] (inlining them with :(...): and auto-quoting strings)
    // - example of use:
    // ! Table := MultiFieldValues(TSQLRecord,'Name','%=?',['ID'],[aID]);
    // - call overloaded MultiFieldValues() / ExecuteList() to get the list
    function MultiFieldValues(Table: TSQLRecordClass; const FieldNames: RawUTF8;
      const WhereClauseFormat: RawUTF8; const Args, Bounds: array of const): TSQLTableJSON; overload;
    /// retrieve the main field (mostly 'Name') value of the specified record
    // - use GetMainFieldName() method to get the main field name
    // - use OneFieldValue() method to get the field value
    // - return '' if no such field or record exists
    // - if ReturnFirstIfNoUnique is TRUE and no unique property is found,
    // the first RawUTF8 property is returned anyway
    function MainFieldValue(Table: TSQLRecordClass; ID: TID;
      ReturnFirstIfNoUnique: boolean=false): RawUTF8;
    /// return the ID of the record which main field match the specified value
    // - search field is mainly the "Name" property, i.e. the one with
    // "stored AS_UNIQUE" (i.e. "stored false") definition on most TSQLRecord
    // - returns 0 if no matching record was found }
    function MainFieldID(Table: TSQLRecordClass; const Value: RawUTF8): TID;
    /// return the IDs of the record which main field match the specified values
    // - search field is mainly the "Name" property, i.e. the one with
    // "stored AS_UNIQUE" (i.e. "stored false") definition on most TSQLRecord
    // - if any of the Values[] is not existing, then no ID will appear in the
    // IDs[] array - e.g. it will return [] if no matching record was found
    // - returns TRUE if any matching ID was found (i.e. if length(IDs)>0) }
    function MainFieldIDs(Table: TSQLRecordClass; const Values: array of RawUTF8;
      out IDs: TIDDynArray): boolean;
  public // here are REST basic direct calls (works with Server or Client)
    /// get a member from a SQL statement
    // - implements REST GET collection
    // - return true on success
    // - Execute 'SELECT * FROM TableName WHERE SQLWhere LIMIT 1' SQL Statememt
    // (using inlined parameters via :(...): in SQLWhere is always a good idea)
    // - since no record is specified, locking is pointless here
    // - default implementation call ExecuteList(), and fill Value from a
    // temporary TSQLTable
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // and TSQLRecordMany fields (use RetrieveBlob method or set
    // TSQLRestClientURI.ForceBlobTransfert)
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - if this default set of simple fields does not fit your need, you could
    // specify your own set
    function Retrieve(const SQLWhere: RawUTF8; Value: TSQLRecord;
      const aCustomFieldsCSV: RawUTF8=''): boolean; overload; virtual;
    /// get a member from a SQL statement
    // - implements REST GET collection
    // - return true on success
    // - same as Retrieve(const SQLWhere: RawUTF8; Value: TSQLRecord) method, but
    // this overloaded function will call FormatUTF8 to create the Where Clause
    // from supplied parameters, replacing all '%' chars with Args[], and all '?'
    // chars with Bounds[] (inlining them with :(...): and auto-quoting strings)
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    function Retrieve(const WhereClauseFmt: RawUTF8; const Args,Bounds: array of const;
      Value: TSQLRecord; const aCustomFieldsCSV: RawUTF8=''): boolean; overload;
    /// get a member from its ID
    // - return true on success
    // - Execute 'SELECT * FROM TableName WHERE ID=:(aID): LIMIT 1' SQL Statememt
    // - if ForUpdate is true, the REST method is LOCK and not GET: it tries to lock
    // the corresponding record, then retrieve its content; caller has to call
    // UnLock() method after Value usage, to release the record
    // - this method will call EngineRetrieve() abstract method
    // - the TSQLRawBlob (BLOB) fields are not retrieved by this method, to
    // preserve bandwidth: use the RetrieveBlob() methods for handling
    // BLOB fields, or set either the TSQLRestClientURI.ForceBlobTransfert
    // or TSQLRestClientURI.ForceBlobTransfertTable[] properties
    // - the TSQLRecordMany fields are not retrieved either: they are separate
    // instances created by TSQLRecordMany.Create, with dedicated methods to
    // access to the separated pivot table
   function Retrieve(aID: TID; Value: TSQLRecord;
      ForUpdate: boolean=false): boolean; overload; virtual;
    /// get a member from its TRecordReference property content
    // - instead of the other Retrieve() methods, this implementation Create an
    // instance, with the appropriated class stored in Reference
    // - returns nil on any error (invalid Reference e.g.)
    // - if ForUpdate is true, the REST method is LOCK and not GET: it tries to lock
    // the corresponding record, then retrieve its content; caller has to call
    // UnLock() method after Value usage, to release the record
    // - the TSQLRawBlob (BLOB) fields are not retrieved by this method, to
    // preserve bandwidth: use the RetrieveBlob() methods for handling
    // BLOB fields, or set either the TSQLRestClientURI.ForceBlobTransfert
    // or TSQLRestClientURI.ForceBlobTransfertTable[] properties
    // - the TSQLRecordMany fields are not retrieved either: they are separate
    // instances created by TSQLRecordMany.Create, with dedicated methods to
    // access to the separated pivot table
    function Retrieve(Reference: TRecordReference;
      ForUpdate: boolean=false): TSQLRecord; overload; virtual;
    /// get a member from a published property TSQLRecord
    // - those properties are not class instances, but TObject(aRecordID)
    // - is just a wrapper around Retrieve(aPublishedRecord.ID,aValue)
    // - return true on success
    function Retrieve(aPublishedRecord, aValue: TSQLRecord): boolean; overload;
    /// get a list of members from a SQL statement as TObjectList
    // - implements REST GET collection
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL()/DateTimeToSQL() for TDateTime, or directly any integer,
    // double, currency, RawUTF8 values to be bound to the request as parameters
    // - aCustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - return a TObjectList on success (possibly with Count=0) - caller is
    // responsible of freeing the instance
    // - this TObjectList will contain a list of all matching records
    // - return nil on error
    function RetrieveList(Table: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const;
      const aCustomFieldsCSV: RawUTF8=''): TObjectList; overload;
    /// get a list of members from a SQL statement as RawJSON
    // - implements REST GET collection
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL()/DateTimeToSQL() for TDateTime, or directly any integer,
    // double, currency, RawUTF8 values to be bound to the request as parameters
    // - aCustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - returns the raw JSON array content with all items on success, with
    // our expanded / not expanded JSON format - so can be used with SOA methods
    // and RawJSON results, for direct process from the client side
    // - returns '' on error
    // - the data is directly retrieved from raw JSON as returned by the database
    // without any conversion, so this method will be the fastest, but complex
    // types like dynamic array will be returned as Base64-encoded blob value -
    // if you need proper JSON access to those, see RetrieveDocVariantArray()
    function RetrieveListJSON(Table: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8='';
      aForceAJAX: boolean=false): RawJSON; overload;
    /// get a list of members from a SQL statement as RawJSON
    // - implements REST GET collection
    // - this overloaded version expect the SQLWhere clause to be already
    // prepared with inline parameters using a previous FormatUTF8() call
    // - aCustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - returns the raw JSON array content with all items on success, with
    // our expanded / not expanded JSON format - so can be used with SOA methods
    // and RawJSON results, for direct process from the client side
    // - returns '' on error
    // - the data is directly retrieved from raw JSON as returned by the database
    // without any conversion, so this method will be the fastest, but complex
    // types like dynamic array will be returned as Base64-encoded blob value -
    // if you need proper JSON access to those, see RetrieveDocVariantArray()
    function RetrieveListJSON(Table: TSQLRecordClass; const SQLWhere: RawUTF8;
      const aCustomFieldsCSV: RawUTF8=''; aForceAJAX: boolean=false): RawJSON; overload;
    {$ifndef NOVARIANTS}
    /// get a list of all members from a SQL statement as a TDocVariant
    // - implements REST GET collection
    // - if ObjectName='', it will return a TDocVariant of dvArray kind
    // - if ObjectName is set, it will return a TDocVariant of dvObject kind,
    // with one property containing the array of values: this returned variant
    // can be pasted e.g. directly as parameter to TSynMustache.Render()
    // - aCustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - the data will be converted to variants and TDocVariant following the
    // TSQLRecord layout, so complex types like dynamic array will be returned
    // as a true array of values (in contrast to the RetrieveListJSON method)
    // - warning: under FPC, we observed that assigning the result of this
    // method to a local variable may circumvent a memory leak FPC bug
    function RetrieveDocVariantArray(Table: TSQLRecordClass;
      const ObjectName, CustomFieldsCSV: RawUTF8; FirstRecordID: PID=nil;
      LastRecordID: PID=nil): variant; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// get a list of members from a SQL statement as a TDocVariant
    // - implements REST GET collection over a specified WHERE clause
    // - if ObjectName='', it will return a TDocVariant of dvArray kind
    // - if ObjectName is set, it will return a TDocVariant of dvObject kind,
    // with one property containing the array of values: this returned variant
    // can be pasted e.g. directly as parameter to TSynMustache.Render()
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL()/DateTimeToSQL() for TDateTime, or directly any integer,
    // double, currency, RawUTF8 values to be bound to the request as parameters
    // - aCustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - the data will be converted to variants and TDocVariant following the
    // TSQLRecord layout, so complex types like dynamic array will be returned
    // as a true array of values (in contrast to the RetrieveListJSON method)
    // - warning: under FPC, we observed that assigning the result of this
    // method to a local variable may circumvent a memory leak FPC bug
    function RetrieveDocVariantArray(Table: TSQLRecordClass; const ObjectName: RawUTF8;
      const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
      const CustomFieldsCSV: RawUTF8; FirstRecordID: PID=nil;
      LastRecordID: PID=nil): variant; overload;
    /// get all values of a SQL statement on a single column as a TDocVariant array
    // - implements REST GET collection on a single field
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL()/DateTimeToSQL() for TDateTime, or directly any integer,
    // double, currency, RawUTF8 values to be bound to the request as parameters
    // - the data will be converted to variants and TDocVariant following the
    // TSQLRecord layout, so complex types like dynamic array will be returned
    // as a true array of values (in contrast to the RetrieveListJSON method)
    function RetrieveOneFieldDocVariantArray(Table: TSQLRecordClass;
      const FieldName, FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const): variant;
    /// get one member from a SQL statement as a TDocVariant
    // - implements REST GET collection
    // - the data will be converted to a TDocVariant variant following the
    // TSQLRecord layout, so complex types like dynamic array will be returned
    // as a true array of values
    function RetrieveDocVariant(Table: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const; const CustomFieldsCSV: RawUTF8): variant;
    {$endif NOVARIANTS}
    /// get a list of members from a SQL statement as T*ObjArray
    // - implements REST GET collection
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL()/DateTimeToSQL() for TDateTime, or directly any integer,
    // double, currency, RawUTF8 values to be bound to the request as parameters
    // - aCustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - set the T*ObjArray variable with all items on success - so that it can
    // be used with SOA methods
    // - it is up to the caller to ensure that ObjClear(ObjArray) is called
    // when the T*ObjArray list is not needed any more
    // - returns true on success, false on error
    function RetrieveListObjArray(var ObjArray; Table: TSQLRecordClass;
      const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
      const aCustomFieldsCSV: RawUTF8=''): boolean;
    /// get and append a list of members as an expanded JSON array
    // - implements REST GET collection
    // - generates '[{rec1},{rec2},...]' using a loop similar to:
    // ! while FillOne do .. AppendJsonObject() ..
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL()/DateTimeToSQL() for TDateTime, or directly any integer,
    // double, currency, RawUTF8 values to be bound to the request as parameters
    // - if OutputFieldName is set, the JSON array will be written as a JSON,
    // property i.e. surrounded as '"OutputFieldName":[....],' - note ending ','
    // - CustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if CustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if CustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - is just a wrapper around TSQLRecord.AppendFillAsJsonArray()
    procedure AppendListAsJsonArray(Table: TSQLRecordClass;
      const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
      const OutputFieldName: RawUTF8; W: TJSONSerializer;
      const CustomFieldsCSV: RawUTF8='');
    /// dedicated method used to retrieve matching IDs using a fast R-Tree index
    // - a TSQLRecordRTree is associated to a TSQLRecord with a specified BLOB
    // field, and will call TSQLRecordRTree BlobToCoord and ContainedIn virtual
    // class methods to execute an optimized SQL query
    // - as alternative, with SQLite3 >= 3.24.0, you may use Auxiliary Columns
    // - will return all matching DataTable IDs in DataID[]
    // - will generate e.g. the following statement
    // $ SELECT MapData.ID From MapData, MapBox WHERE MapData.ID=MapBox.ID
    // $  AND minX>=:(-81.0): AND maxX<=:(-79.6): AND minY>=:(35.0): AND :(maxY<=36.2):
    // $  AND MapBox_in(MapData.BlobField,:('\uFFF0base64encoded-81,-79.6,35,36.2'):);
    // when the following Delphi code is executed:
    // ! aClient.RTreeMatch(TSQLRecordMapData,'BlobField',TSQLRecordMapBox,
    // !   aMapData.BlobField,ResultID);
    function RTreeMatch(DataTable: TSQLRecordClass;
      const DataTableBlobFieldName: RawUTF8; RTreeTable: TSQLRecordRTreeClass;
      const DataTableBlobField: RawByteString; var DataID: TIDDynArray): boolean;
    /// Execute directly a SQL statement, expecting a list of results
    // - return a result table on success, nil on failure
    // - will call EngineList() abstract method to retrieve its JSON content
    function ExecuteList(const Tables: array of TSQLRecordClass; const SQL: RawUTF8): TSQLTableJSON; virtual;
    /// Execute directly a SQL statement, expecting a list of results
    // - you should not have to use this method, but the ORM versions instead
    // - return a result set as JSON on success, '' on failure
    // - will call EngineList() abstract method to retrieve its JSON content
    function ExecuteJson(const Tables: array of TSQLRecordClass; const SQL: RawUTF8;
      ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawJSON; virtual;
    /// Execute directly a SQL statement, without any expected result
    // - implements POST SQL on ModelRoot URI
    // - return true on success
    // - will call EngineExecute() abstract method to run the SQL statement
    function Execute(const aSQL: RawUTF8): boolean; virtual;
    /// Execute directly a SQL statement with supplied parameters, with no result
    // - expect the same format as FormatUTF8() function, replacing all '%' chars
    // with Args[] values
    // - return true on success
    function ExecuteFmt(const SQLFormat: RawUTF8; const Args: array of const): boolean; overload;
    /// Execute directly a SQL statement with supplied parameters, with no result
    // - expect the same format as FormatUTF8() function, replacing all '%' chars
    // with Args[] values, and all '?' chars with Bounds[] (inlining them
    // with :(...): and auto-quoting strings)
    // - return true on success
    function ExecuteFmt(const SQLFormat: RawUTF8; const Args, Bounds: array of const): boolean; overload;
    /// unlock the corresponding record
    // - record should have been locked previously e.g. with Retrieve() and
    // forupdate=true, i.e. retrieved not via GET with LOCK REST-like verb
    // - use our custom UNLOCK REST-like verb
    // - returns true on success
    function UnLock(Table: TSQLRecordClass; aID: TID): boolean; overload; virtual; abstract;
    /// unlock the corresponding record
    // - record should have been locked previously e.g. with Retrieve() and
    // forupdate=true, i.e. retrieved not via GET with LOCK REST-like verb
    // - use our custom UNLOCK REST-like method
    // - calls internally UnLock() above
    // - returns true on success
    function UnLock(Rec: TSQLRecord): boolean; overload;
    /// create a new member
    // - implements REST POST collection
    // - if SendData is true, client sends the current content of Value with the
    // request, otherwise record is created with default values
    // - if ForceID is true, client sends the Value.ID field to use this ID for
    // adding the record (instead of a database-generated ID)
    // - on success, returns the new RowID value; on error, returns 0
    // - on success, Value.ID is updated with the new RowID
    // - the TSQLRawBlob(BLOB) fields values are not set by this method, to
    // preserve bandwidth - see UpdateBlobFields() and AddWithBlobs() methods
    // - the TSQLRecordMany fields are not set either: they are separate
    // instances created by TSQLRecordMany.Create, with dedicated methods to
    // access to the separated pivot table
    // - this method will call EngineAdd() to perform the request
    function Add(Value: TSQLRecord; SendData: boolean; ForceID: boolean=false;
      DoNotAutoComputeFields: boolean=false): TID; overload;
      {$ifdef FPC}inline;{$endif}
    /// create a new member, including selected fields
    // - implements REST POST collection
    // - if ForceID is true, client sends the Value.ID field to use this ID for
    // adding the record (instead of a database-generated ID)
    // - this method will call EngineAdd() to perform the request
    function Add(Value: TSQLRecord; const CustomCSVFields: RawUTF8;
      ForceID: boolean=false; DoNotAutoComputeFields: boolean=false): TID; overload;
    /// create a new member, including selected fields
    // - implements REST POST collection
    // - if ForceID is true, client sends the Value.ID field to use this ID for
    // adding the record (instead of a database-generated ID)
    // - this method will call EngineAdd() to perform the request
    function Add(Value: TSQLRecord; const CustomFields: TSQLFieldBits;
      ForceID: boolean=false; DoNotAutoComputeFields: boolean=false): TID; overload;
      {$ifdef FPC}inline;{$endif}
    /// create a new member, including its BLOB fields
    // - implements REST POST collection
    // - this method will create a JSON representation of the document
    // including the BLOB fields as Base64 encoded text, so will be less
    // efficient than a dual Add() + UpdateBlobFields() methods if the
    // binary content has a non trivial size
    // - this method will call EngineAdd() to perform the request
    function AddWithBlobs(Value: TSQLRecord; ForceID: boolean=false;
      DoNotAutoComputeFields: boolean=false): TID; virtual;
    /// create a new member, from a supplied list of field values
    // - implements REST POST collection
    // - the aSimpleFields parameters must follow explicitely the order of published
    // properties of the supplied aTable class, excepting the TSQLRawBlob and
    // TSQLRecordMany kind (i.e. only so called "simple fields")
    // - the aSimpleFields must have exactly the same count of parameters as
    // there are "simple fields" in the published properties
    // - if ForcedID is set to non null, client sends this ID to be used
    // when adding the record (instead of a database-generated ID)
    // - on success, returns the new RowID value; on error, returns 0
    // - call internaly the Add virtual method above
    function AddSimple(aTable: TSQLRecordClass; const aSimpleFields: array of const;
      ForcedID: TID=0): TID;
    /// update a member from Value simple fields content
    // - implements REST PUT collection
    // - return true on success
    // - the TSQLRawBlob(BLOB) fields values are not updated by this method, to
    // preserve bandwidth: use the UpdateBlob() methods for handling BLOB fields
    // - the TSQLRecordMany fields are not set either: they are separate
    // instances created by TSQLRecordMany.Create, with dedicated methods to
    // access to the separated pivot table
    // - if CustomFields is left void, the  simple fields will be used, or the
    // fields retrieved via a previous FillPrepare() call; otherwise, you can
    // specify your own set of fields to be transmitted (including BLOBs, even
    // if they will be Base64-encoded within the JSON content) - CustomFields
    // could be computed by TSQLRecordProperties.FieldBitsFromCSV()
    // or TSQLRecordProperties.FieldBitsFromRawUTF8()
    // - this method will always compute and send any TModTime fields
    // - this method will call EngineUpdate() to perform the request
    function Update(Value: TSQLRecord; const CustomFields: TSQLFieldBits=[];
      DoNotAutoComputeFields: boolean=false): boolean; overload; virtual;
    /// update a member from Value simple fields content
    // - implements REST PUT collection
    // - return true on success
    // - is an overloaded method to Update(Value,FieldBitsFromCSV())
    function Update(Value: TSQLRecord; const CustomCSVFields: RawUTF8;
      DoNotAutoComputeFields: boolean=false): boolean; overload;
    /// update a member from a supplied list of simple field values
    // - implements REST PUT collection
    // - the aSimpleFields parameters MUST follow explicitely both count and
    // order of published properties of the supplied aTable class, excepting the
    // TSQLRawBlob and TSQLRecordMany kind (i.e. only so called "simple fields")
    // - return true on success
    // - call internaly the Update() / EngineUpdate() virtual methods
    function Update(aTable: TSQLRecordClass; aID: TID;
      const aSimpleFields: array of const): boolean; overload;
    /// create or update a member, depending if the Value has already an ID
    // - implements REST POST if Value.ID=0 or ForceID is set, or a REST PUT
    // collection to update the record pointed by a Value.ID<>0
    // - will return the created or updated ID
    function AddOrUpdate(Value: TSQLRecord; ForceID: boolean=false): TID;
    /// update one field/column value a given member
    // - implements REST PUT collection with one field value
    // - only one single field shall be specified in FieldValue, but could
    // be of any kind of value - for BLOBs, you should better use UpdateBlob()
    // - return true on success
    // - call internaly the EngineUpdateField() abstract method
    // - note that this method won't update the TModTime properties: you should
    // rather use a classic Retrieve()/FillPrepare() followed by Update(); but
    // it will notify the internal Cache
    function UpdateField(Table: TSQLRecordClass; ID: TID;
      const FieldName: RawUTF8; const FieldValue: array of const): boolean; overload; virtual;
    /// update one field in one or several members, depending on a WHERE clause
    // - implements REST PUT collection with one field value on a one where value
    // - only one single field shall be specified in FieldValue, but could
    // be of any kind of value - for BLOBs, you should better use UpdateBlob()
    // - only one single field shall be specified in WhereFieldValue, but could
    // be of any kind of value - for security reasons, void WHERE clause will
    // be rejected
    // - return true on success
    // - call internaly the EngineUpdateField() abstract method
    // - note that this method won't update the TModTime properties: you should
    // rather use a classic Retrieve()/FillPrepare() followed by Update(); but
    // it will notify the internal Cache
    function UpdateField(Table: TSQLRecordClass;
      const WhereFieldName: RawUTF8; const WhereFieldValue: array of const;
      const FieldName: RawUTF8; const FieldValue: array of const): boolean; overload; virtual;
    {$ifndef NOVARIANTS}
    /// update one field in a given member with a value specified as variant
    // - implements REST PUT collection with one field value
    // - any value can be set in FieldValue, but for BLOBs, you should better
    // use UpdateBlob()
    // - return true on success
    // - call internaly the EngineUpdateField() abstract method
    // - note that this method won't update the TModTime properties: you should
    // rather use a classic Retrieve()/FillPrepare() followed by Update(); but
    // it will notify the internal Cache
    function UpdateField(Table: TSQLRecordClass; ID: TID;
      const FieldName: RawUTF8; const FieldValue: variant): boolean; overload; virtual;
    /// update one field in one or several members, depending on a WHERE clause,
    // with both update and where values specified as variant
    // - implements REST PUT collection with one field value on a one where value
    // - any value can be set in FieldValue, but for BLOBs, you should better
    // use UpdateBlob()
    // - for security reasons, void WHERE clause will be rejected
    // - return true on success
    // - call internaly the EngineUpdateField() abstract method
    // - note that this method won't update the TModTime properties, nor the
    // internal table Cache: you should rather use a classic Retrieve()/FillPrepare()
    // followed by an Update() of the whole record
    function UpdateField(Table: TSQLRecordClass;
      const WhereFieldName: RawUTF8; const WhereFieldValue: variant;
      const FieldName: RawUTF8; const FieldValue: variant): boolean; overload; virtual;
    /// update one field in one or several members, depending on a set of IDs
    // - return true on success
    // - note that this method won't update the TModTime properties: you should
    // rather use a classic Retrieve()/FillPrepare() followed by Update(), but
    // it will be much slower, even over a BATCH; anyway, it will update the
    // internal Cache
    // - will be executed as a regular SQL statement:
    // $ UPDATE table SET fieldname=fieldvalue WHERE RowID IN (...)
    // - warning: this method will call directly EngineExecute(), and will
    // work just fine with SQLite3, but some other DB engines may not allow
    // a huge number of items within the IN(...) clause
    function UpdateField(Table: TSQLRecordClass; const IDs: array of Int64;
      const FieldName: RawUTF8; const FieldValue: variant): boolean; overload; virtual;
    {$endif NOVARIANTS}
    /// increments one integer field value
    // - if available, this method will use atomic value modification, e.g.
    // $ UPDATE table SET field=field+?
    function UpdateFieldIncrement(Table: TSQLRecordClass; ID: TID;
      const FieldName: RawUTF8; Increment: Int64=1): boolean; virtual;
    /// override this method to guess if this record can be updated or deleted
    // - this default implementation returns always true
    // - e.g. you can add digital signature to a record to disallow record editing
    // - the ErrorMsg can be set to a variable, which will contain an explicit
    // error message
    function RecordCanBeUpdated(Table: TSQLRecordClass; ID: TID; Action: TSQLEvent;
      ErrorMsg: PRawUTF8 = nil): boolean; virtual;
    /// delete a member
    // - implements REST DELETE collection
    // - return true on success
    // - call internaly the EngineDelete() abstract method
    function Delete(Table: TSQLRecordClass; ID: TID): boolean; overload; virtual;
    /// delete a member with a WHERE clause
    // - implements REST DELETE collection
    // - return true on success
    // - this default method call OneFieldValues() to retrieve all matching IDs,
    // then will delete each row using protected EngineDeleteWhere() virtual method
    function Delete(Table: TSQLRecordClass; const SQLWhere: RawUTF8): boolean; overload; virtual;
    /// delete a member with a WHERE clause
    // - implements REST DELETE collection
    // - return true on success
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL/DateTimeToSQL for TDateTime, or directly any integer / double /
    // currency / RawUTF8 values to be bound to the request as parameters
    // - is a simple wrapper around:
    // ! Delete(Table,FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere))
    function Delete(Table: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const): boolean; overload;

    /// access the internal caching parameters for a given TSQLRecord
    // - will always return a TSQLRestCache instance, creating one if needed
    // - purpose of this caching mechanism is to speed up retrieval of some
    // common values at either Client or Server level (like configuration settings)
    // - by default, this CRUD level per-ID cache is disabled
    // - use Cache.SetCache() and Cache.SetTimeOut() methods to set the appropriate
    // configuration for this particular TSQLRest instance
    // - only caching synchronization is about the direct RESTful/CRUD commands:
    // RETRIEVE, ADD, UPDATE and DELETE (that is, a complex direct SQL UPDATE or
    // via TSQLRecordMany pattern won't be taken into account - only exception is
    // TSQLRestStorage tables accessed as SQLite3 virtual table)
    // - this caching will be located at the TSQLRest level, that is no automated
    // synchronization is implemented between TSQLRestClient and TSQLRestServer -
    // you shall ensure that your business logic is safe, calling Cache.Flush()
    // overloaded methods on purpose: better no cache than unproper cache -
    // "premature optimization is the root of all evil"
    property Cache: TSQLRestCache read GetCache;
    /// access the internal caching parameters for a given TSQLRecord
    // - will return nil if no TSQLRestCache instance has been defined
    function CacheOrNil: TSQLRestCache;
      {$ifdef HASINLINE}inline;{$endif}

    /// get a blob field content from its record ID and supplied blob field name
    // - implements REST GET collection with a supplied member ID and a blob field name
    // - return true on success
    // - this method is defined as abstract, i.e. there is no default implementation:
    // it must be implemented 100% RestFul with a
    // GET ModelRoot/TableName/TableID/BlobFieldName request for example
    // - this method retrieve the blob data as a TSQLRawBlob string using
    // EngineRetrieveBlob()
    function RetrieveBlob(Table: TSQLRecordClass; aID: TID;
      const BlobFieldName: RawUTF8; out BlobData: TSQLRawBlob): boolean; overload; virtual;
    /// get a blob field content from its record ID and supplied blob field name
    // - implements REST GET collection with a supplied member ID and field name
    // - return true on success
    // - this method will create a TStream instance (which must be freed by the
    // caller after use) and fill it with the blob data
    function RetrieveBlob(Table: TSQLRecordClass; aID: TID;
      const BlobFieldName: RawUTF8; out BlobStream: THeapMemoryStream): boolean; overload;
    /// update a blob field from its record ID and supplied blob field name
    // - implements REST PUT collection with a supplied member ID and field name
    // - return true on success
    // - call internaly the EngineUpdateBlob() abstract method
    // - this method expect the Blob data to be supplied as TSQLRawBlob, using
    // EngineUpdateBlob()
    function UpdateBlob(Table: TSQLRecordClass; aID: TID;
      const BlobFieldName: RawUTF8; const BlobData: TSQLRawBlob): boolean; overload; virtual;
    /// update a blob field from its record ID and blob field name
    // - implements REST PUT collection with a supplied member ID and field name
    // - return true on success
    // - call internaly the EngineUpdateBlob() abstract method
    // - this method expect the Blob data to be supplied as a TStream: it will
    // send the whole stream content (from its beginning position upto its
    // current size) to the database engine
    function UpdateBlob(Table: TSQLRecordClass; aID: TID;
      const BlobFieldName: RawUTF8; BlobData: TStream): boolean; overload;
    /// update a blob field from its record ID and blob field name
    // - implements REST PUT collection with a supplied member ID and field name
    // - return true on success
    // - call internaly the EngineUpdateBlob() abstract method
    // - this method expect the Blob data to be supplied as direct memory pointer
    // and size
    function UpdateBlob(Table: TSQLRecordClass; aID: TID;
      const BlobFieldName: RawUTF8; BlobData: pointer; BlobSize: integer): boolean; overload;
    /// update all BLOB fields of the supplied Value
    // - call several REST PUT collection (one for each BLOB) for the member
    // - uses the UpdateBlob() method to send the BLOB properties content to the Server
    // - called internaly by Add and Update methods when ForceBlobTransfert /
    // ForceBlobTransfertTable[] is set
    // - you can use this method by hand, to avoid several calls to UpdateBlob()
    // - returns TRUE on success (or if there is no BLOB field)
    // - returns FALSE on error (e.g. if Value is invalid or with db/transmission)
    function UpdateBlobFields(Value: TSQLRecord): boolean; virtual;
    /// get all BLOB fields of the supplied value from the remote server
    // - call several REST GET collection (one for each BLOB) for the member
    // - call internaly e.g. by TSQLRestClient.Retrieve method when
    // ForceBlobTransfert / ForceBlobTransfertTable[] is set
    function RetrieveBlobFields(Value: TSQLRecord): boolean; virtual;

    /// begin a transaction
    // - implements REST BEGIN collection
    // - may be used to speed up CRUD statements like Add/Update/Delete
    // - in the current implementation, nested transactions are not allowed
    // - must be ended with Commit on success
    // - must be aborted with Rollback if any SQL statement failed
    // - default implementation just handle the protected fTransactionActiveSession flag
    // - return true if no transaction is active, false otherwise
    // - in aClient-Server environment with multiple Clients connected at the
    // same time, you should better use BATCH process, specifying a positive
    // AutomaticTransactionPerRow parameter to BatchStart()
    // - in a multi-threaded or Client-Server with multiple concurrent Client
    // connections, you may check the returned value, as such:
    //  !if Client.TransactionBegin(TSQLRecordPeopleObject) then
    //  !try
    //  !  //.... modify the database content, raise exceptions on error
    //  !  Client.Commit;
    //  !except
    //  !  Client.RollBack; // in case of error
    //  !end;
    // or use the TransactionBeginRetry() method
    // - the supplied SessionID will allow multi-user transaction safety on the
    // Server-Side: all database modification from another session will wait
    // for the global transaction to be finished; on Client-side, the SessionID
    // is just ignored (TSQLRestClient will override this method with a default
    // SessionID=CONST_AUTHENTICATION_NOT_USED=1 parameter)
    // - if you have an external database engine which expect transactions to
    // take place in the same thread, ensure TSQLRestServer force execution of
    // this method when accessed from RESTful clients in the same thread, e.g.:
    // ! AcquireExecutionMode[execORMWrite] := amBackgroundThread;
    // ! AcquireWriteMode := amBackgroundThread; // same as previous
    function TransactionBegin(aTable: TSQLRecordClass; SessionID: cardinal): boolean; virtual;
    /// check current transaction status
    // - returns the session ID if a transaction is active
    // - returns 0 if no transaction is active
    function TransactionActiveSession: cardinal;
    /// end a transaction
    // - implements REST END collection
    // - write all pending SQL statements to the disk
    // - default implementation just reset the protected fTransactionActiveSession flag
    // - the supplied SessionID will allow multi-user transaction safety on the
    // Server-Side: all database modification from another session will wait
    // for the global transaction to be finished; on Client-side, the SessionID
    // is just ignored (TSQLRestClient will override this method with a default
    // SessionID=CONST_AUTHENTICATION_NOT_USED=1 parameter)
    // - if you have an external database engine which expect transactions to
    // take place in the same thread, ensure TSQLRestServer force execution of
    // this method when accessed from RESTful clients in the same thread, e.g.:
    // ! AcquireExecutionMode[execORMWrite] := amBackgroundThread;
    // ! AcquireWriteMode := amBackgroundThread; // same as previous
    // - by default, any exception will be catch and ignored, unless RaiseException
    // is set to TRUE so that the caller will be able to handle it
    procedure Commit(SessionID: cardinal; RaiseException: boolean=false); virtual;
    /// abort a transaction
    // - implements REST ABORT collection
    // - restore the previous state of the database, before the call to TransactionBegin
    // - default implementation just reset the protected fTransactionActiveSession flag
    // - the supplied SessionID will allow multi-user transaction safety on the
    // Server-Side: all database modification from another session will wait
    // for the global transaction to be finished; on Client-side, the SessionID
    // is just ignored (TSQLRestClient will override this method with a default
    // SessionID=CONST_AUTHENTICATION_NOT_USED=1 parameter)
    // - if you have an external database engine which expect transactions to
    // take place in the same thread, ensure TSQLRestServer force execution of
    // this method when accessed from RESTful clients in the same thread, e.g.:
    // ! AcquireExecutionMode[execORMWrite] := amBackgroundThread;
    // ! AcquireWriteMode := amBackgroundThread; // same as previous
    procedure RollBack(SessionID: cardinal); virtual;
    /// execute a BATCH sequence prepared in a TSQLRestBatch instance
    // - implements the "Unit Of Work" pattern, i.e. safe transactional process
    // even on multi-thread environments
    // - send all pending Add/Update/Delete statements to the DB or remote server
    // - will return the URI Status value, i.e. 200/HTTP_SUCCESS OK on success
    // - a dynamic array of integers will be created in Results,
    // containing all ROWDID created for each BatchAdd call, 200 (=HTTP_SUCCESS)
    // for all successfull BatchUpdate/BatchDelete, or 0 on error
    // - any error during server-side process MUST be checked against Results[]
    // (the main URI Status is 200 if about communication success, and won't
    // imply that all statements in the BATCH sequence were successfull),
    // or boRollbackOnError should be set in TSQLRestBatchOptions
    // - note that the caller shall still free the supplied Batch instance
    function BatchSend(Batch: TSQLRestBatch; var Results: TIDDynArray): integer; overload; virtual;
    /// execute a BATCH sequence prepared in a TSQLRestBatch instance
    // - just a wrapper around the overloaded BatchSend() method without the
    // Results: TIDDynArray parameter
    function BatchSend(Batch: TSQLRestBatch): integer; overload;

    {$ifdef ISDELPHI2010} // Delphi 2009/2010 generics support is buggy :(
    /// get an instance of one interface-based service
    // - may return nil if this service interface is not available
    function Service<T: IInterface>: T;
    /// get a list of members from a SQL statement
    // - implements REST GET collection
    // - aCustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - return a TObjectList<T> on success (possibly with Count=0) - caller is
    // responsible of freeing the instance
    // - return nil on error
    // - you can write for instance:
    // !var List: TObjectList<TSQLRecordTest>;
    // !    R: TSQLRecordTest;
    // ! ...
    // !    List := Client.RetrieveList<TSQLRecordTest>('ID,Test');
    // !    if List<>nil then
    // !    try
    // !      for R in List do
    // !        writeln(R.ID,'=',R.Test);
    // !    finally
    // !      List.Free;
    // !    end;
    function RetrieveList<T: TSQLRecord>(const aCustomFieldsCSV: RawUTF8=''): TObjectList<T>; overload;
       {$ifdef HASINLINE}inline;{$endif}
    /// get a list of members from a SQL statement
    // - implements REST GET collection with a WHERE clause
    // - for better server speed, the WHERE clause should use bound parameters
    // identified as '?' in the FormatSQLWhere statement, which is expected to
    // follow the order of values supplied in BoundsSQLWhere open array - use
    // DateToSQL()/DateTimeToSQL() for TDateTime, or directly any integer,
    // double, currency, RawUTF8 values to be bound to the request as parameters
    // - aCustomFieldsCSV can be the CSV list of field names to be retrieved
    // - if aCustomFieldsCSV is '', will get all simple fields, excluding BLOBs
    // - if aCustomFieldsCSV is '*', will get ALL fields, including ID and BLOBs
    // - return a TObjectList<T> on success (possibly with Count=0) - caller is
    // responsible of freeing the instance
    // - return nil on error
    function RetrieveList<T: TSQLRecord>(const FormatSQLWhere: RawUTF8;
      const BoundsSQLWhere: array of const;
      const aCustomFieldsCSV: RawUTF8=''): TObjectList<T>; overload;
    {$endif ISDELPHIXE}

    /// you can call this method in TThread.Execute to ensure that
    // the thread will be taken into account during process
    // - this abstract method won't do anything, but TSQLRestServer's will
    procedure BeginCurrentThread(Sender: TThread); virtual;
    /// you can call this method just before a thread is finished to ensure
    // e.g. that the associated external DB connection will be released
    // - this abstract method will call fLogClass.Add.NotifyThreadEnded
    // but TSQLRestServer.EndCurrentThread will do the main process
    procedure EndCurrentThread(Sender: TThread); virtual;
    /// enter the Mutex associated with the write operations of this instance
    // - just a wrapper around fAcquireExecution[execORMWrite].Safe.Lock
    procedure WriteLock;
    /// leave the Mutex associated with the write operations of this instance
    // - just a wrapper around fAcquireExecution[execORMWrite].Safe.UnLock
    procedure WriteUnLock;
    /// allows to safely execute a processing method in a background thread
    // - returns a TSynBackgroundThreadMethod instance, ready to execute any
    // background task via its RunAndWait() method
    // - will properly call BeginCurrentThread/EndCurrentThread methods
    // - you should supply some runtime information to name the thread, for
    // proper debugging
    function NewBackgroundThreadMethod(const Format: RawUTF8; const Args: array of const): TSynBackgroundThreadMethod;
    /// allows to safely execute a process at a given pace
    // - returns a TSynBackgroundThreadProcess instance, ready to execute the
    // supplied aOnProcess event in a loop, as aOnProcessMS periodic task
    // - will properly call BeginCurrentThread/EndCurrentThread methods
    // - you should supply some runtime information to name the thread, for
    // proper debugging
    function NewBackgroundThreadProcess(aOnProcess: TOnSynBackgroundThreadProcess;
      aOnProcessMS: cardinal; const Format: RawUTF8; const Args: array of const;
      aStats: TSynMonitorClass=nil): TSynBackgroundThreadProcess;
    /// allows to safely execute a process in parallel
    // - returns a TSynParallelProcess instance, ready to execute any task
    // in parrallel in a thread-pool given by ThreadCount
    // - will properly call BeginCurrentThread/EndCurrentThread methods
    // - you should supply some runtime information to name the thread, for
    // proper debugging
    function NewParallelProcess(ThreadCount: integer; const Format: RawUTF8;
      const Args: array of const): TSynParallelProcess;
    /// define a task running on a periodic number of seconds in a background thread
    // - could be used to run background maintenance or monitoring tasks on
    // this TSQLRest instance, at a low pace (typically every few minutes)
    // - will instantiate and run a shared TSynBackgroundTimer instance for this
    // TSQLRest, so all tasks will share the very same thread
    // - you can run BackgroundTimer.EnQueue or ExecuteNow methods to implement
    // a FIFO queue, or force immediate execution of the process
    // - will call BeginCurrentThread/EndCurrentThread as expected e.g. by logs
    function TimerEnable(aOnProcess: TOnSynBackgroundTimerProcess;
      aOnProcessSecs: cardinal): TSynBackgroundTimer;
    /// undefine a task running on a periodic number of seconds
    // - should have been registered by a previous call to TimerEnable() method
    // - returns true on success, false if the supplied task was not registered
    function TimerDisable(aOnProcess: TOnSynBackgroundTimerProcess): boolean;
    /// define asynchronous execution of interface methods in a background thread
    // - this class allows to implements any interface via a fake class, which will
    // redirect all methods calls into calls of another interface, but as a FIFO
    // in a background thread, shared with TimerEnable/TimerDisable process
    // - it is an elegant resolution to the most difficult implementation
    // problem of SOA callbacks, which is to avoid race condition on reentrance,
    // e.g. if a callback is run from a thread, and then the callback code try
    // to execute something in the context of the initial thread, protected
    // by a critical section (mutex)
    // - is a wrapper around BackgroundTimer.AsynchRedirect()
    procedure AsynchRedirect(const aGUID: TGUID;
      const aDestinationInterface: IInvokable; out aCallbackInterface;
      const aOnResult: TOnAsynchRedirectResult=nil); overload;
    /// define asynchronous execution of interface methods in a background thread
    // - this class allows to implements any interface via a fake class, which will
    // redirect all methods calls into calls of another interface, but as a FIFO
    // in a background thread, shared with TimerEnable/TimerDisable process
    // - it is an elegant resolution to the most difficult implementation
    // problem of SOA callbacks, which is to avoid race condition on reentrance,
    // e.g. if a callback is run from a thread, and then the callback code try
    // to execute something in the context of the initial thread, protected
    // by a critical section (mutex)
    // - is a wrapper around BackgroundTimer.AsynchRedirect()
    procedure AsynchRedirect(const aGUID: TGUID;
      const aDestinationInstance: TInterfacedObject; out aCallbackInterface;
      const aOnResult: TOnAsynchRedirectResult=nil); overload;
    /// prepare an asynchronous ORM BATCH process, executed in a background thread
    // - will initialize a TSQLRestBatch and call TimerEnable to initialize the
    // background thread, following the given processing period (in seconds),
    // or the TSQLRestBatch.Count threshold to call BatchSend
    // - actual REST/CRUD commands will take place via AsynchBatchAdd,
    // AsynchBatchUpdate and AsynchBatchDelete methods
    // - only a single AsynchBatch() call per Table is allowed at a time, unless
    // AsynchBatchStop method is used to flush the current asynchronous BATCH
    // - using a BATCH in a dedicated thread will allow very fast bacgkround
    // asynchronous process of ORM methods, sufficient for most use cases
    // - is a wrapper around BackgroundTimer.AsynchBatchStart()
    function AsynchBatchStart(Table: TSQLRecordClass; SendSeconds: integer;
      PendingRowThreshold: integer=500; AutomaticTransactionPerRow: integer=1000;
      Options: TSQLRestBatchOptions=[boExtendedJSON]): boolean;
    /// finalize asynchronous ORM BATCH process, executed in a background thread
    // - should have been preceded by a call to AsynchBatch(), or returns false
    // - Table=nil will release all existing batch instances
    // - is a wrapper around BackgroundTimer.AsynchBatchStop()
    function AsynchBatchStop(Table: TSQLRecordClass): boolean;
    /// create a new ORM member in a BATCH to be written in a background thread
    // - should have been preceded by a call to AsynchBatchStart(), or returns -1
    // - is a wrapper around BackgroundTimer.AsynchBatchAdd(),
    // so will return the index in the BATCH rows, not the created TID
    // - this method is thread-safe
    function AsynchBatchAdd(Value: TSQLRecord; SendData: boolean;
      ForceID: boolean=false; const CustomFields: TSQLFieldBits=[];
      DoNotAutoComputeFields: boolean=false): integer;
    /// append some JSON content in a BATCH to be written in a background thread
    // - could be used to emulate AsynchBatchAdd() with an already pre-computed
    // JSON object
    // - is a wrapper around BackgroundTimer.AsynchBatchRawAdd(),
    // so will return the index in the BATCH rows, not the created TID
    // - this method is thread-safe
    function AsynchBatchRawAdd(Table: TSQLRecordClass; const SentData: RawUTF8): integer;
    /// append some JSON content in a BATCH to be writen in a background thread
    // - could be used to emulate AsynchBatchAdd() with an already pre-computed
    // JSON object, as stored in a TTextWriter instance
    // - is a wrapper around BackgroundTimer.AsynchBatchRawAppend()
    // - this method is thread-safe
    procedure AsynchBatchRawAppend(Table: TSQLRecordClass; SentData: TTextWriter);
    /// update an ORM member in a BATCH to be written in a background thread
    // - should have been preceded by a call to AsynchBatchStart(), or returns -1
    // - is a wrapper around BackgroundTimer.AsynchBatchUpdate()
    // - this method is thread-safe
    function AsynchBatchUpdate(Value: TSQLRecord; const CustomFields: TSQLFieldBits=[];
      DoNotAutoComputeFields: boolean=false): integer;
    /// delete an ORM member in a BATCH to be written in a background thread
    // - should have been preceded by a call to AsynchBatchStart(), or returns -1
    // - is a wrapper around the TSQLRestBatch.Delete() sent in the Timer thread
    // - this method is thread-safe
    function AsynchBatchDelete(Table: TSQLRecordClass; ID: TID): integer;
    /// allows background garbage collection of specified RawUTF8 interning
    // - will run Interning.Clean(2) every 5 minutes by default
    // - set InterningMaxRefCount=0 to disable process of the Interning instance
    // - note that InterningMaxRefCount and PeriodMinutes parameters (if not 0),
    // are common for all TRawUTF8Interning instances (the latest value wins)
    // - you may e.g. run the following to clean up TDocVariant interned RawUTF8:
    // ! aRest.AsynchInterning(DocVariantType.InternNames);
    // ! aRest.AsynchInterning(DocVariantType.InternValues);
    procedure AsynchInterning(Interning: TRawUTF8Interning;
      InterningMaxRefCount: integer=2; PeriodMinutes: integer=5);
    /// define redirection of interface methods calls in one or several instances
    // - this class allows to implements any interface via a fake class, which
    // will redirect all methods calls to one or several other interfaces
    // - returned aCallbackInterface will redirect all its methods (identified
    // by aGUID) into an internal list handled by IMultiCallbackRedirect.Redirect
    // - typical use is thefore:
    // ! fSharedCallback: IMyService;
    // ! fSharedCallbacks: IMultiCallbackRedirect;
    // ! ...
    // !   if fSharedCallbacks=nil then begin
    // !     fSharedCallbacks := aRest.MultiRedirect(IMyService,fSharedCallback);
    // !     aServices.SubscribeForEvents(fSharedCallback);
    // !   end;
    // !   fSharedCallbacks.Redirect(TMyCallback.Create,[]);
    // !   // now each time fSharedCallback receive one event, all callbacks
    // !   // previously registered via Redirect() will receive it
    // ! ...
    // !   fSharedCallbacks := nil; // will stop redirection
    // !                            // and unregister callbacks, if needed
    function MultiRedirect(const aGUID: TGUID; out aCallbackInterface;
      aCallBackUnRegisterNeeded: boolean=true): IMultiCallbackRedirect; overload;
    /// will gather CPU and RAM information in a background thread
    // - you can specify the update frequency, in seconds
    // - access to the information via the returned instance, which maps
    // the TSystemUse.Current class function
    // - do nothing if global TSystemUse.Current was already assigned
    function SystemUseTrack(periodSec: integer=10): TSystemUse;
    /// initialize some custom AES encryption and/or digital signature, with
    // optional compression
    // - will intercept the calls by setting OnDecryptBody/OnEncryptBody events
    // - will own the supplied aes instance or won't encrypt the content if nil
    // - will digitally sign the content body and uri with the supplied
    // TSynSigner, or won't compute any digital signature if sign=nil
    // - if both aes and sign are nil, then call interception is disabled
    // - you can optionally specify a compression algorithm (like AlgoSynLZ or
    // AlgoDeflate/AlgoDeflateFast) to be applied before encryption
    // - any URI starting with uriignore characters won't be encrypted: it could
    // be used to define a method-based service for handshake and aes/sign
    // mutual agreement
    // - TSQLRestServer will require incoming requests to be of the corresponding
    // [aesclass][signalgo]/[originaltype] HTTP content-type e.g.
    // 'aesofb256sha256/application/json' - any plain request will be rejected
    // - note that it will only encrypt and sign the HTTP requests bodies, so URI
    // or plain GET won't be checked - as such, it is not a replacement of
    // TSQLRestServerAuthentication nor TWebSocketProtocolBinary encryption,
    // but a cheap alternative to HTTPS, when you need to protect HTTP flow
    // from MiM attacks (e.g. in a IoT context) with simple and proven algorithms
    procedure SetCustomEncryption(aes: TAESAbstract; sign: PSynSigner; comp: TAlgoCompress;
      const uriignore: RawUTF8='');
    /// how this class execute its internal commands
    // - by default, TSQLRestServer.URI() will lock for Write ORM according to
    // AcquireWriteMode (i.e. AcquireExecutionMode[execORMWrite]=amLocked) and
    // other operations won't be protected (for better scaling)
    // - you can tune this behavior by setting this property to the expected
    // execution mode, e.g. execute all method-based services in a dedicated
    // thread via
    // ! aServer.AcquireExecutionMode[execSOAByMethod] := amBackgroundThread;
    // - if you use external DB and a custom ConnectionTimeOutMinutes value,
    // both read and write access should be locked, so you should set:
    // ! aServer.AcquireExecutionMode[execORMGet] := am***;
    // ! aServer.AcquireExecutionMode[execORMWrite] := am***;
    // here, safe blocking am*** modes are any mode but amUnlocked, i.e. either
    // amLocked, amBackgroundThread, amBackgroundORMSharedThread or amMainThread
    property AcquireExecutionMode[Cmd: TSQLRestServerURIContextCommand]: TSQLRestServerAcquireMode
      read GetAcquireExecutionMode write SetAcquireExecutionMode;
    /// the time (in mili seconds) to try locking internal commands of this class
    // - this value is used only for AcquireExecutionMode[*]=amLocked
    // - by default, TSQLRestServer.URI() will lock for Write ORM according to
    // AcquireWriteTimeOut  (i.e. AcquireExecutionLockedTimeOut[execORMWrite])
    // and other operations won't be locked nor have any time out set
    property AcquireExecutionLockedTimeOut[Cmd: TSQLRestServerURIContextCommand]: cardinal
      read GetAcquireExecutionLockedTimeOut write SetAcquireExecutionLockedTimeOut;
    /// how this class will handle write access to the database
    // - is a common wrapper to AcquireExecutionMode[execORMWrite] property
    // - default amLocked mode will wait up to AcquireWriteTimeOut mili seconds
    // to have a single access to the server write ORM methods
    // - amBackgroundThread will execute the write methods in a queue, in a
    // dedicated unique thread (which can be convenient, especially for
    // external database transaction process)
    // - amBackgroundORMSharedThread will execute all ORM methods in a queue, in
    // a dedicated unique thread, shared for both execORMWrite and execORMGet,
    // but still dedicated for execSOAByMethod and execSOAByInterface
    // - a slower alternative to amBackgroundThread may be amMainThread
    // - you can set amUnlocked for a concurrent write access, but be aware
    // that it may lead into multi-thread race condition issues, depending on
    // the database engine used
    property AcquireWriteMode: TSQLRestServerAcquireMode index execORMWrite
      read GetAcquireExecutionMode write SetAcquireExecutionMode;
    /// the time (in mili seconds) which the class will wait for acquiring a
    // write acccess to the database, when AcquireWriteMode is amLocked
    // - is a common wrapper to AcquireExecutionLockedTimeOut[execORMWrite]
    // - in order to handle safe transactions and multi-thread safe writing, the
    // server will identify transactions using the client Session ID: this
    // property will set the time out wait period
    // - default value is 5000, i.e. TSQLRestServer.URI will wait up to 5 seconds
    // in order to acquire the right to write on the database before returning
    // a "408 Request Time-out" status error
    property AcquireWriteTimeOut: cardinal index execORMWrite
      read GetAcquireExecutionLockedTimeOut write SetAcquireExecutionLockedTimeOut;

    /// used e.g. by IAdministratedDaemon to implement "pseudo-SQL" commands
    // - this default implementation will handle #time #model #rest commands
    procedure AdministrationExecute(const DatabaseName,SQL: RawUTF8;
      var result: TServiceCustomAnswer); virtual;
    /// access to the interface-based services list
    // - may be nil if no service interface has been registered yet: so be
    // aware that the following line may trigger an access violation if
    // no ICalculator is defined on server side:
    // ! if fServer.Services['Calculator'].Get(Calc)) then
    // !   ...
    // - safer typical use, following the DI/IoC pattern, and which will not
    // trigger any access violation if Services=nil, could be:
    // ! if fServer.Services.Resolve(ICalculator,Calc) then
    // !   ...
    property Services: TServiceContainer read fServices;
    /// access or initialize the internal IoC resolver, used for interface-based
    // remote services, and more generaly any Services.Resolve() call
    // - create and initialize the internal TServiceContainer if no service
    // interface has been registered yet    // - may be used to inject some dependencies, which are not interface-based
    // remote services, but internal IoC, without the ServiceRegister()
    // or ServiceDefine() methods - e.g.
    // ! aRest.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(aRest)],true);
    // - overriden methods will return TServiceContainerClient or
    // TServiceContainerServer instances, on TSQLRestClient or TSQLRestServer
    function ServiceContainer: TServiceContainer; virtual; abstract;
    /// the routing classs of the service remote request
    // - by default, will use TSQLRestRoutingREST, i.e. an URI-based
    // layout which is secure (since will use our RESTful authentication scheme),
    // and also very fast
    // - but TSQLRestRoutingJSON_RPC can e.g. be set (on BOTH client and
    // server sides), if the client will rather use JSON/RPC alternative pattern
    // - NEVER set the abstract TSQLRestServerURIContext class on this property
    property ServicesRouting: TSQLRestServerURIContextClass
      read fRoutingClass write SetRoutingClass;
    /// low-level background timer thread associated with this TSQLRest
    // - contains nil if TimerEnable/AsynchInvoke was never executed
    // - you may instantiate your own TSQLRestBackgroundTimer instances, if
    // more than one working thread is needed
    property BackgroundTimer: TSQLRestBackgroundTimer read fBackgroundTimer;
    /// the Database Model associated with this REST Client or Server
    property Model: TSQLModel read fModel;
    /// event called before TSQLRestServer.URI or after TSQLRestClientURI.URI
    // - defined e.g. by SetCustomEncryption
    property OnDecryptBody: TNotifyRestBody read fOnDecryptBody write fOnDecryptBody;
    /// event called after TSQLRestServer.URI or before TSQLRestClientURI.URI
    // - defined e.g. by SetCustomEncryption
    property OnEncryptBody: TNotifyRestBody read fOnEncryptBody write fOnEncryptBody;
  published
    /// the current UTC Date and Time, as retrieved from the server
    // - this property will return the timestamp as TTimeLog / Int64
    // after correction from the Server returned time-stamp (if any)
    // - is used e.g. by TSQLRecord.ComputeFieldsBeforeWrite to update TModTime
    // and TCreateTime published fields
    // - default implementation will return the executable UTC time, i.e. NowUTC
    // so that any GUI code should convert this UTC value into local time
    // - on TSQLRestServer, if you use an external database, the TSQLDBConnection
    // ServerTimestamp value will be set to this property
    // - you can use this value in a WHERE clause for a query, as such:
    // ! aRec.CreateAndFillPrepare(Client,'Datum<=?',[TimeLogToSQL(Client.ServerTimestamp)]);
    // - or you could use ServerTimestamp everywhere in your code, when you need
    // a reference time base
    property ServerTimestamp: TTimeLog read GetServerTimestamp write SetServerTimestamp;
    {$ifdef WITHLOG}
    /// the logging class used for this instance
    // - is set by default to SQLite3Log, but could be set to a custom class
    property LogClass: TSynLogClass read GetLogClass write SetLogClass;
    {$endif}
  public
    /// the custom queries parameters for User Interface Query action
    QueryCustom: array of TSQLQueryCustom;
    /// evaluate a basic operation for implementing User Interface Query action
    // - expect both Value and Reference to be UTF-8 encoded (as in TSQLTable
    // or TSQLTableToGrid)
    // - aID parameter is ignored in this function implementation (expect only
    // this parameter to be not equal to 0)
    // - is TSQLQueryEvent prototype compatible
    // - for qoContains and qoBeginWith, the Reference is expected to be
    // already uppercase
    // - for qoSoundsLike* operators, Reference is not a PUTF8Char, but a
    // typecase of a prepared TSynSoundEx object instance (i.e. pointer(@SoundEx))
    class function QueryIsTrue(aTable: TSQLRecordClass; aID: TID;
      FieldType: TSQLFieldType; Value: PUTF8Char; Operator: integer;
      Reference: PUTF8Char): boolean;
    /// add a custom query
    // - one event handler with an enumeration type containing all available
    // query names
    // - and associated operators
    procedure QueryAddCustom(aTypeInfo: pointer; aEvent: TSQLQueryEvent;
      const aOperators: TSQLQueryOperators);
  end;

  {$M+}
  /// a simple TThread for doing some process within the context of a REST instance
  // - also define a Start method for compatibility with older versions of Delphi
  // - inherited classes should override InternalExecute abstract method
  TSQLRestThread = class(TThread)
  protected
    fRest: TSQLRest;
    fOwnRest: boolean;
    fLog: TSynLog;
    fSafe: TSynLocker;
    fEvent: TEvent;
    fExecuting: boolean;
    /// allows customization in overriden Create (before Execute)
    fThreadName: RawUTF8;
    /// will call BeginCurrentThread/EndCurrentThread and catch exceptions
    procedure Execute; override;
    /// you should override this method with the proper process
    procedure InternalExecute; virtual; abstract;
  public
    /// initialize the thread
    // - if aOwnRest is TRUE, the supplied REST instance will be
    // owned by this thread
    constructor Create(aRest: TSQLRest; aOwnRest, aCreateSuspended: boolean);
    {$ifndef HASTTHREADSTART}
    /// method to be called to start the thread
    // - Resume is deprecated in the newest RTL, since some OS - e.g. Linux -
    // do not implement this pause/resume feature; we define here this method
    // for older versions of Delphi
    procedure Start;
    {$endif}
    {$ifdef HASTTHREADTERMINATESET}
    /// properly terminate the thread
    // - called by TThread.Terminate
    procedure TerminatedSet; override;
    {$else}
    /// properly terminate the thread
    // - called by reintroduced Terminate
    procedure TerminatedSet; virtual;
    /// reintroduced to call TeminatedSet
    procedure Terminate; reintroduce;
    {$endif}
    /// wait for Execute to be ended (i.e. fExecuting=false)
    procedure WaitForNotExecuting(maxMS: integer=500);
    /// finalize the thread
    // - and the associated REST instance if OwnRest is TRUE
    destructor Destroy; override;
    /// safe version of Sleep() which won't break the thread process
    // - returns TRUE if the thread was Terminated
    // - returns FALSE if successfully waited up to MS milliseconds
    function SleepOrTerminated(MS: integer): boolean;
    /// read-only access to the associated REST instance
    property Rest: TSQLRest read FRest;
    /// TRUE if the associated REST instance will be owned by this thread
    property OwnRest: boolean read fOwnRest;
    /// a critical section is associated to this thread
    // - could be used to protect shared resources within the internal process
    property Safe: TSynLocker read fSafe;
    /// read-only access to the TSynLog instance of the associated REST instance
    property Log: TSynLog read fLog;
    /// a event associated to this thread
    property Event: TEvent read fEvent;
    /// publishes the thread running state
    property Terminated;
    /// publishes the thread executing state (set when Execute leaves)
    property Executing: boolean read fExecuting;
  end;
  {$M-}

  /// event signature used to notify a client callback
  // - implemented e.g. by TSQLHttpServer.NotifyCallback
  TSQLRestServerNotifyCallback = function(aSender: TSQLRestServer;
    const aInterfaceDotMethodName,aParams: RawUTF8;
    aConnectionID: Int64; aFakeCallID: integer;
    aResult, aErrorMsg: PRawUTF8): boolean of object;

  /// event signature used by TSQLRestServer.OnServiceCreateInstance
  // - as called by TServiceFactoryServer.CreateInstance
  // - the actual Instance class can be quickly retrieved from
  // Sender.ImplementationClass
  TOnServiceCreateInstance = procedure(
    Sender: TServiceFactoryServer; Instance: TInterfacedObject) of object;

{$ifdef MSWINDOWS}
  TSQLRestServerNamedPipeResponse = class;

  /// Server thread accepting connections from named pipes
  TSQLRestServerNamedPipe = class(TSQLRestThread)
  private
  protected
    fServer: TSQLRestServer;
    fChild: array of TSQLRestServerNamedPipeResponse;
    fChildRunning: integer;
    fPipeName: TFileName;
    procedure InternalExecute; override;
  public
    /// register a new response thread
    procedure AddChild(new: TSQLRestServerNamedPipeResponse);
    /// unregister a new response thread
    procedure RemoveChild(new: TSQLRestServerNamedPipeResponse);
    /// create the server thread
    constructor Create(aServer: TSQLRestServer; const PipeName: TFileName); reintroduce;
    /// release all associated memory, and wait for all
    // TSQLRestServerNamedPipeResponse children to be terminated
    destructor Destroy; override;
    /// the associated pipe name
    property PipeName: TFileName read fPipeName;
  end;

  /// Server child thread dealing with a connection through a named pipe
  TSQLRestServerNamedPipeResponse = class(TSQLRestThread)
  private
  protected
    fServer: TSQLRestServer;
    fPipe: cardinal;
    fMasterThread: TSQLRestServerNamedPipe;
    procedure InternalExecute; override;
  public
    /// create the child connection thread
    constructor Create(aServer: TSQLRestServer; aMasterThread: TSQLRestServerNamedPipe;
      aPipe: cardinal); reintroduce;
    /// release all associated memory, and decrement fMasterThread.fChildRunning
    destructor Destroy; override;
  end;

{$ifdef FPC}
  TWMCopyData = record
    Msg: UINT;
    From: WPARAM;
    CopyDataStruct: LPARAM;
    Result: LRESULT;
  end;
{$endif}
{$endif}

  /// function prototype for remotely calling a TSQLRestServer
  // - use PUTF8Char instead of string: no need to share a memory manager, and can
  // be used with any language (even C or .NET, thanks to the cdecl calling convention)
  // - you can specify some POST/PUT data in SendData (leave as nil otherwise)
  // - returns in result.Lo the HTTP STATUS integer error or success code
  // - returns in result.Hi the server database internal status
  // - on success, allocate and store the resulting JSON body into Resp^, headers in Head^
  // - use a GlobalFree() function to release memory for Resp and Head responses
  TURIMapRequest = function(url, method, SendData: PUTF8Char; Resp, Head: PPUTF8Char): Int64Rec; cdecl;

  TSQLRestServerAuthentication = class;

  /// structure used to specify custom request paging parameters for TSQLRestServer
  // - default values are the one used for YUI component paging (i.e.
  // PAGINGPARAMETERS_YAHOO constant, as set by TSQLRestServer.Create)
  // - warning: using paging can be VERY expensive on Server side, especially
  // when used with external databases (since all data is retrieved before
  // paging, when SQLite3 works in virtual mode)
  TSQLRestServerURIPagingParameters = record
    /// parameter name used to specify the request sort order
    // - default value is 'SORT='
    Sort: RawUTF8;
    /// parameter name used to specify the request sort direction
    // - default value is 'DIR='
    Dir: RawUTF8;
    /// parameter name used to specify the request starting offset
    // - default value is 'STARTINDEX='
    StartIndex: RawUTF8;
    /// parameter name used to specify the request the page size (LIMIT clause)
    // - default value is 'RESULTS='
    Results: RawUTF8;
    /// parameter name used to specify the request field names
    // - default value is 'SELECT='
    Select: RawUTF8;
    /// parameter name used to specify the request WHERE clause
    // - default value is 'WHERE='
    Where: RawUTF8;
    /// returned JSON field value of optional total row counts
    // - default value is nil, i.e. no total row counts field
    // - computing total row counts can be very expensive, depending on the
    // database back-end used (especially for external databases)
    // - can be set e.g. to ',"totalRows":%' value (note that the initial "," is
    // expected by the produced JSON content, and % will be set with the value)
    SendTotalRowsCountFmt: RawUTF8;
  end;

  ///  used to define how to trigger Events on record update
  // - see TSQLRestServer.OnUpdateEvent property and InternalUpdateEvent() method
  // - returns true on success, false if an error occured (but action must continue)
  // - to be used only server-side, not to synchronize some clients: the framework
  // is designed around a stateless RESTful architecture (like HTTP/1.1), in which
  // clients ask the server for refresh (see TSQLRestClientURI.UpdateFromServer)
  TNotifySQLEvent = function(Sender: TSQLRestServer; Event: TSQLEvent;
    aTable: TSQLRecordClass; const aID: TID; const aSentData: RawUTF8): boolean of object;
  ///  used to define how to trigger Events on record field update
  // - see TSQLRestServer.OnBlobUpdateEvent property and InternalUpdateEvent() method
  // - returns true on success, false if an error occured (but action must continue)
  // - to be used only server-side, not to synchronize some clients: the framework
  // is designed around a stateless RESTful architecture (like HTTP/1.1), in which
  // clients ask the server for refresh (see TSQLRestClientURI.UpdateFromServer)
  TNotifyFieldSQLEvent = function(Sender: TSQLRestServer; Event: TSQLEvent;
    aTable: TSQLRecordClass; const aID: TID; const aAffectedFields: TSQLFieldBits): boolean of object;
  /// session-related callbacks triggered by TSQLRestServer
  // - for OnSessionCreate, returning TRUE will abort the session creation -
  // and you can set Ctxt.Call^.OutStatus to a corresponding error code
  TNotifySQLSession = function(Sender: TSQLRestServer; Session: TAuthSession;
    Ctxt: TSQLRestServerURIContext): boolean of object;
  /// callback allowing to customize the retrieval of an authenticated user
  // - as defined in TSQLRestServer.OnAuthenticationUserRetrieve
  // - and executed by TSQLRestServerAuthentication.GetUser
  // - on call, either aUserID will be <> 0, or aUserName is to be used
  // - if the function returns nil, default Server.SQLAuthUserClass.Create()
  // methods won't be called, and the user will be reported as not found
  TOnAuthenticationUserRetrieve = function(Sender: TSQLRestServerAuthentication;
    Ctxt: TSQLRestServerURIContext; aUserID: TID; const aUserName: RawUTF8): TSQLAuthUser of object;
  /// callback raised in case of authentication failure
  // - as used by TSQLRestServerURIContext.AuthenticationFailed event
  TNotifyAuthenticationFailed = procedure(Sender: TSQLRestServer;
    Reason: TNotifyAuthenticationFailedReason; Session: TAuthSession;
    Ctxt: TSQLRestServerURIContext) of object;
  /// callback raised before TSQLRestServer.URI execution
  // - should return TRUE to execute the command, FALSE to cancel it
  TNotifyBeforeURI = function(Ctxt: TSQLRestServerURIContext): boolean of object;
  /// callback raised after TSQLRestServer.URI execution
  TNotifyAfterURI = procedure(Ctxt: TSQLRestServerURIContext) of object;
  /// callback raised if TSQLRestServer.URI execution failed
  // - should return TRUE to execute Ctxt.Error(E,...), FALSE if returned
  // content has already been set as expected by the client
  TNotifyErrorURI = function(Ctxt: TSQLRestServerURIContext; E: Exception): boolean of object;
  {$ifndef NOVARIANTS}
  /// callback allowing to customize the information returned by root/timestamp/info
  TOnInternalInfo = procedure(Sender: TSQLRestServer; var info: TDocVariantData) of object;
  {$endif}

  TSQLRestStorageInMemory = class;
  TSQLVirtualTableModule = class;

  /// class-reference type (metaclass) of our abstract table storage
  // - may be e.g. TSQLRestStorageInMemory, TSQLRestStorageInMemoryExternal,
  // TSQLRestStorageExternal or TSQLRestStorageMongoDB
  TSQLRestStorageClass = class of TSQLRestStorage;

  /// class-reference type (metaclass) of our TObjectList memory-stored table storage
  // - may be TSQLRestStorageInMemory or TSQLRestStorageInMemoryExternal
  TSQLRestStorageInMemoryClass = class of TSQLRestStorageInMemory;

  /// table containing the available user access rights for authentication
  // - this class should be added to the TSQLModel, together with TSQLAuthUser,
  // to allow authentication support
  // - you can inherit from it to add your custom properties to each user info:
  // TSQLModel will search for any class inheriting from TSQLAuthGroup to
  // manage per-group authorization data
  // - by default, it won't be accessible remotely by anyone
  TSQLAuthGroup = class(TSQLRecord)
  private
    fIdent: RawUTF8;
    fSessionTimeOut: integer;
    fAccessRights: RawUTF8;
    function GetSQLAccessRights: TSQLAccessRights;
    procedure SetSQLAccessRights(const Value: TSQLAccessRights);
  public
    /// called when the associated table is created in the database
    // - on a new database, if TSQLAuthUser and TSQLAuthGroup tables are defined
    // in the associated TSQLModel, it this will add 'Admin', 'Supervisor',
    // and 'User' rows in the AuthUser table (with 'synopse' as default password),
    // and associated 'Admin', 'Supervisor', 'User' and 'Guest' groups, with the
    // following access rights to the AuthGroup table:
    // $            POSTSQL SELECTSQL Service AuthR AuthW TablesR TablesW
    // $ Admin        Yes     Yes       Yes    Yes   Yes    Yes    Yes
    // $ Supervisor   No      Yes       Yes    Yes   No     Yes    Yes
    // $ User         No      No        Yes    No    No     Yes    Yes
    // $ Guest        No      No        No     No    No     Yes    No
    // - 'Admin' will be the only able to execute remote not SELECT SQL statements
    // for POST commands (reSQL flag in TSQLAccessRights.AllowRemoteExecute) and
    // modify the Auth tables (i.e. AuthUser and AuthGroup)
    // - 'Admin' and 'Supervisor' will allow any SELECT SQL statements to be
    // executed, even if the table can't be retrieved and checked (corresponding
    // to the reSQLSelectWithoutTable flag)
    // - 'User' won't have the reSQLSelectWithoutTable flag, nor the right
    // to retrieve the Auth tables data for other users
    // - 'Guest' won't have access to the interface-based remote JSON-RPC service
    // (no reService flag), nor perform any modification to a table: in short,
    // this is an ORM read-only limited user
    // - you MUST override the default 'synopse' password to a custom value,
    // or at least customize the global AuthAdminDefaultPassword,
    // AuthSupervisorDefaultPassword, AuthUserDefaultPassword variables
    // - of course, you can change and tune the settings of the AuthGroup and
    // AuthUser tables, but only 'Admin' group users will be able to remotely
    // modify the content of those two tables
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
    /// corresponding TSQLAccessRights for this authentication group
    // - content is converted into/from text format via AccessRight DB property
    // (so it will be not fixed e.g. by the binary TSQLFieldTables layout, i.e.
    // the MAX_SQLTABLES constant value)
    property SQLAccessRights: TSQLAccessRights read GetSQLAccessRights write SetSQLAccessRights;
  published
    /// the access right identifier, ready to be displayed
    // - the same identifier can be used only once (this column is marked as
    // unique via a "stored AS_UNIQUE" (i.e. "stored false") attribute)
    // - so you can retrieve a TSQLAuthGroup ID from its identifier, as such:
    // ! UserGroupID := fClient.MainFieldID(TSQLAuthGroup,'User');
    property Ident: RawUTF8 index 50 read fIdent write fIdent stored AS_UNIQUE;
    /// the number of minutes a session is kept alive
    property SessionTimeout: integer read fSessionTimeOut write fSessionTimeOut;
    /// a textual representation of a TSQLAccessRights buffer
    property AccessRights: RawUTF8 index 1600 read fAccessRights write fAccessRights;
  end;

  /// table containing the Users registered for authentication
  // - this class should be added to the TSQLModel, together with TSQLAuthGroup,
  // to allow authentication support
  // - you can inherit from it to add your custom properties to each user info:
  // TSQLModel will search for any class inheriting from TSQLAuthUser to manage
  // per-user authorization data
  // - by default, it won't be accessible remotely by anyone; to enhance security,
  // you could use the TSynValidatePassWord filter to this table
  TSQLAuthUser = class(TSQLRecord)
  protected
    fLogonName: RawUTF8;
    fPasswordHashHexa: RawUTF8;
    fDisplayName: RawUTF8;
    fGroup: TSQLAuthGroup;
    fData: TSQLRawBlob;
    procedure SetPasswordPlain(const Value: RawUTF8);
    /// check if the user can authenticate in its current state
    // - called by TSQLRestServerAuthentication.GetUser() method
    // - this default implementation will return TRUE, i.e. allow the user
    // to log on
    // - override this method to disable user authentication, e.g. if the
    // user is disabled via a custom ORM boolean and date/time field
    function CanUserLog(Ctxt: TSQLRestServerURIContext): boolean; virtual;
  public
    /// static function allowing to compute a hashed password
    // - as expected by this class
    // - defined as virtual so that you may use your own hashing class
    // - you may specify your own values in aHashSalt/aHashRound, to enable
    // PBKDF2_HMAC_SHA256() use instead of plain SHA256(): it will increase
    // security on storage side (reducing brute force attack via rainbow tables)
    class function ComputeHashedPassword(const aPasswordPlain: RawUTF8;
      const aHashSalt: RawUTF8=''; aHashRound: integer=20000): RawUTF8; virtual;
    /// able to set the PasswordHashHexa field from a plain password content
    // - in fact, PasswordHashHexa := SHA256('salt'+PasswordPlain) in UTF-8
    // - use SetPassword() method if you want to customize the hash salt value
    // and use the much safer PBKDF2_HMAC_SHA256 algorithm
    property PasswordPlain: RawUTF8 write SetPasswordPlain;
    /// set the PasswordHashHexa field from a plain password content and salt
    // - use this method to specify aHashSalt/aHashRound values, enabling
    // PBKDF2_HMAC_SHA256() use instead of plain SHA256(): it will increase
    // security on storage side (reducing brute force attack via rainbow tables)
    // - you may use an application specific fixed salt, and/or append the
    // user LogonName to make the challenge unique for each TSQLAuthUser
    // - the default aHashRound=20000 is slow but secure - since the hashing
    // process is expected to be done on client side, you may specify your
    // own higher/slower value, depending on the security level you expect
    procedure SetPassword(const aPasswordPlain, aHashSalt: RawUTF8;
      aHashRound: integer=20000);
  published
    /// the User identification Name, as entered at log-in
    // - the same identifier can be used only once (this column is marked as
    // unique via a "stored AS_UNIQUE" - i.e. "stored false" - attribute), and
    // therefore indexed in the database (e.g. hashed in TSQLRestStorageInMemory)
    property LogonName: RawUTF8 index 20 read fLogonName write fLogonName stored AS_UNIQUE;
    /// the User Name, as may be displayed or printed
    property DisplayName: RawUTF8 index 50 read fDisplayName write fDisplayName;
    /// the hexa encoded associated SHA-256 hash of the password
    // - see TSQLAuthUser.ComputeHashedPassword() or SetPassword() methods
    // - store the SHA-256 32 bytes as 64 hexa chars
    property PasswordHashHexa: RawUTF8 index 64 read fPasswordHashHexa write fPasswordHashHexa;
    /// the associated access rights of this user
    // - access rights are managed by group
    // - in TAuthSession.User instance, GroupRights property will contain a
    // REAL TSQLAuthGroup instance for fast retrieval in TSQLRestServer.URI
    // - note that 'Group' field name is not allowed by SQLite
    property GroupRights: TSQLAuthGroup read fGroup write fGroup;
    /// some custom data, associated to the User
    // - Server application may store here custom data
    // - its content is not used by the framework but 'may' be used by your
    // application
    property Data: TSQLRawBlob read fData write fData;
  end;

  /// class used to maintain in-memory sessions
  // - this is not a TSQLRecord table so won't be remotely accessible, for
  // performance and security reasons
  // - the User field is a true instance, copy of the corresponding database
  // content (for better speed)
  // - you can inherit from this class, to add custom session process
  TAuthSession = class(TSynPersistent)
  protected
    fUser: TSQLAuthUser;
    fID: RawUTF8;
    fIDCardinal: cardinal;
    fTimeOutTix: cardinal;
    fTimeOutShr10: cardinal;
    fPrivateKey: RawUTF8;
    fPrivateSalt: RawUTF8;
    fSentHeaders: RawUTF8;
    fRemoteIP: RawUTF8;
    fPrivateSaltHash: Cardinal;
    fLastTimestamp: Cardinal;
    fExpectedHttpAuthentication: RawUTF8;
    fAccessRights: TSQLAccessRights;
    fMethods: TSynMonitorInputOutputObjArray;
    fInterfaces: TSynMonitorInputOutputObjArray;
    function GetUserName: RawUTF8;
    function GetUserID: TID;
    function GetGroupID: TID;
    procedure SaveTo(W: TFileBufferWriter); virtual;
    procedure ComputeProtectedValues; virtual;
    constructor CreateFrom(var P: PAnsiChar; PEnd: PAnsiChar; Server: TSQLRestServer); virtual;
  public
    /// initialize a session instance with the supplied TSQLAuthUser instance
    // - this aUser instance will be handled by the class until Destroy
    // - raise an exception on any error
    // - on success, will also retrieve the aUser.Data BLOB field content
    constructor Create(aCtxt: TSQLRestServerURIContext; aUser: TSQLAuthUser); reintroduce; virtual;
    /// will release the User and User.GroupRights instances
    destructor Destroy; override;
  public
    /// the session ID number, as numerical value
    // - never equals to 1 (CONST_AUTHENTICATION_NOT_USED, i.e. authentication
    // mode is not enabled), nor 0 (CONST_AUTHENTICATION_SESSION_NOT_STARTED,
    // i.e. session still in handshaking phase)
    property IDCardinal: cardinal read fIDCardinal;
    /// the associated User
    // - this is a true TSQLAuthUser instance, and User.GroupRights will contain
    // also a true TSQLAuthGroup instance
    property User: TSQLAuthUser read fUser;
    /// set by the Access() method to the current GetTickCount64 shr 10
    // timestamp + TimeoutSecs
    property TimeOutTix: cardinal read fTimeOutTix;
    /// copy of the associated user access rights
    // - extracted from User.TSQLAuthGroup.SQLAccessRights
    property AccessRights: TSQLAccessRights read fAccessRights;
    /// the hexadecimal private key as returned to the connected client
    // as 'SessionID+PrivateKey'
    property PrivateKey: RawUTF8 read fPrivateKey;
    /// the transmitted HTTP headers, if any
    // - can contain e.g. 'RemoteIp: 127.0.0.1' or 'User-Agent: Mozilla/4.0'
    property SentHeaders: RawUTF8 read fSentHeaders;
    /// per-session statistics about method-based services
    // - Methods[] follows TSQLRestServer.fPublishedMethod[] array
    // - is initialized and maintained only if mlSessions is defined in
    // TSQLRestServer.StatLevels property
    property Methods: TSynMonitorInputOutputObjArray read fMethods;
    /// per-session statistics about interface-based services
    // - Interfaces[] follows TSQLRestServer.Services.fListInterfaceMethod[] array
    // - is initialized and maintained only if mlSessions is defined in
    // TSQLRestServer.StatLevels property
    property Interfaces: TSynMonitorInputOutputObjArray read fInterfaces;
  published
    /// the session ID number, as text
    property ID: RawUTF8 read fID;
    /// the associated User Name, as in User.LogonName
    property UserName: RawUTF8 read GetUserName;
    /// the associated User ID, as in User.ID
    property UserID: TID read GetUserID;
    /// the associated Group ID, as in User.GroupRights.ID
    property GroupID: TID read GetGroupID;
    /// the timestamp (in numbers of 1024 ms) until a session is kept alive
    // - extracted from User.TSQLAuthGroup.SessionTimeout
    // - is used for fast comparison with GetTickCount64 shr 10
    property TimeoutShr10: cardinal read fTimeOutShr10;
    /// the remote IP, if any
    // - is extracted from SentHeaders properties
    property RemoteIP: RawUTF8 read fRemoteIP;
  end;

  /// class-reference type (metaclass) used to define overridden session instances
  // - since all sessions data remain in memory, ensure they are not taking too
  // much resource (memory or process time)
  // - if you plan to use session persistence, ensure you override the
  // TAuthSession.SaveTo/CreateFrom methods in the inherited class
  TAuthSessionClass = class of TAuthSession;

  /// class-reference type (metaclass) used to define an authentication scheme
  TSQLRestServerAuthenticationClass = class of TSQLRestServerAuthentication;

  /// maintain a list of TSQLRestServerAuthentication instances
  TSQLRestServerAuthenticationDynArray = array of TSQLRestServerAuthentication;

  /// define how TSQLRestServerAuthentication.ClientSetUser() should interpret
  // the supplied password
  // - passClear means that the password is not encrypted, e.g. as entered
  // by the user in the login screen
  // - passHashed means that the passwod is already hashed as in
  // TSQLAuthUser.PasswordHashHexa i.e. SHA256('salt'+Value)
  // - passKerberosSPN indicates that the password is the Kerberos SPN domain
  TSQLRestServerAuthenticationClientSetUserPassword = (
    passClear, passHashed, passKerberosSPN);

  /// optional behavior of TSQLRestServerAuthentication class
  // - by default, saoUserByLogonOrID is set, allowing
  // TSQLRestServerAuthentication.GetUser() to retrieve the TSQLAuthUser by
  // logon name or by ID, if the supplied logon name is an integer
  // - if saoHandleUnknownLogonAsStar is defined, any user successfully
  // authenticated could be logged with the same ID (and authorization)
  // than TSQLAuthUser.Logon='*' - of course, this is meaningfull only with
  // an external credential check (e.g. via SSPI or Active Directory)
  TSQLRestServerAuthenticationOption = (
    saoUserByLogonOrID, saoHandleUnknownLogonAsStar);

  /// defines the optional behavior of TSQLRestServerAuthentication class
  TSQLRestServerAuthenticationOptions = set of TSQLRestServerAuthenticationOption;

  /// abstract class used to implement server-side authentication in TSQLRestServer
  // - inherit from this class to implement expected authentication scheme
  TSQLRestServerAuthentication = class
  protected
    fServer: TSQLRestServer;
    fOptions: TSQLRestServerAuthenticationOptions;
    fAlgoName: RawUTF8;
    // GET ModelRoot/auth?UserName=...&Session=... -> release session
    function AuthSessionRelease(Ctxt: TSQLRestServerURIContext): boolean;
    /// retrieve an User instance from its logon name
    // - should return nil if not found
    // - this default implementation will retrieve it from ORM, and
    // call TSQLAuthUser.CanUserLog() to ensure authentication is allowed
    // - if aUserName is an integer, it will try to retrieve it from ORM using
    // the supplied value as its TSQLAuthUser.ID: it may be convenient when the
    // client is not an end-user application but a mORMot server (in a cloud
    // architecture), since it will benefit from local ORM cache
    // - you can override this method and return an on-the-fly created value
    // as a TSQLRestServer.SQLAuthUserClass instance (i.e. not persisted
    // in database nor retrieved by ORM), but the resulting TSQLAuthUser
    // must have its ID and LogonName properties set with unique values (which
    // will be used to identify it for a later call and session owner
    // identification), and its GroupRights property must not yet contain a real
    // TSQLAuthGroup instance, just a TSQLAuthGroup(aGroupID) value (as directly
    // retrieved from the ORM) - TAuthSession.Create will retrieve the instance
    // - another possibility, orthogonal to all TSQLRestServerAuthentication
    // classes, may be to define a TSQLRestServer.OnAuthenticationUserRetrieve
    // custom event
    function GetUser(Ctxt: TSQLRestServerURIContext;
      const aUserName: RawUTF8): TSQLAuthUser; virtual;
    /// create a session on the server for a given user
    // - this default implementation will call fServer.SessionCreate() and
    // return a '{"result":"HEXASALT","logonname":"UserName"}' JSON content
    // and will always call User.Free
    // - on failure, will call TSQLRestServerURIContext.AuthenticationFailed()
    // with afSessionAlreadyStartedForThisUser or afSessionCreationAborted reason
    procedure SessionCreate(Ctxt: TSQLRestServerURIContext; var User: TSQLAuthUser); virtual;
    /// Ctxt.Returns(['result',result,....[,'data',data]],200,header);
    procedure SessionCreateReturns(Ctxt: TSQLRestServerURIContext;
      Session: TAuthSession; const result, data, header: RawUTF8);
    /// abstract method which will be called by ClientSetUser() to process the
    // authentication step on the client side
    // - at call, a TSQLAuthUser instance will be supplied, with LogonName set
    // with aUserName and PasswordHashHexa with a SHA-256 hash of aPassword
    // - override with the expected method, returning the session key on success
    class function ClientComputeSessionKey(Sender: TSQLRestClientURI;
      User: TSQLAuthUser): RawUTF8; virtual; abstract;
    /// is called by ClientComputeSessionKey() overriden method to execute the
    // root/Auth service with the supplied parameters, then retrieve and
    // decode the "result": session key and any other values (e.g. "version")
    class function ClientGetSessionKey(Sender: TSQLRestClientURI;
      User: TSQLAuthUser; const aNameValueParameters: array of const): RawUTF8; virtual;
  public
    /// initialize the authentication method to a specified server
    // - you can define several authentication schemes for the same server
    constructor Create(aServer: TSQLRestServer); virtual;
    /// called by the Server to implement the Auth RESTful method
    // - overridden method shall return TRUE if the request has been handled
    // - returns FALSE to let the next registered TSQLRestServerAuthentication
    // class to try implementing the content
    // - Ctxt.Parameters has been tested to contain an UserName=... value
    // - method execution is protected by TSQLRestServer.fSessions.Lock
    function Auth(Ctxt: TSQLRestServerURIContext): boolean; virtual; abstract;
    /// called by the Server to check if the execution context match a session
    // - returns a session instance corresponding to the remote request, and
    // fill Ctxt.Session* members according to in-memory session information
    // - returns nil if this remote request does not match this authentication
    // - method execution should be protected by TSQLRestServer.fSessions.Lock
    function RetrieveSession(Ctxt: TSQLRestServerURIContext): TAuthSession; virtual; abstract;
    /// allow to tune the authentication process
    // - default value is [saoUserByLogonOrID]
    property Options: TSQLRestServerAuthenticationOptions read fOptions write fOptions;
    /// class method to be used on client side to create a remote session
    // - call this method instead of TSQLRestClientURI.SetUser() if you need
    // a custom authentication class
    // - if saoUserByLogonOrID is defined in the server Options, aUserName may
    // be a TSQLAuthUser.ID and not a TSQLAuthUser.LogonName
    // - if passClear is used, you may specify aHashSalt and aHashRound,
    // to enable PBKDF2_HMAC_SHA256() use instead of plain SHA256(), and increase
    // security on storage side (reducing brute force attack via rainbow tables)
    // - will call the ModelRoot/Auth service, i.e. call TSQLRestServer.Auth()
    // published method to create a session for this user
    // - returns true on success
    class function ClientSetUser(Sender: TSQLRestClientURI;
      const aUserName, aPassword: RawUTF8;
      aPasswordKind: TSQLRestServerAuthenticationClientSetUserPassword=passClear;
      const aHashSalt: RawUTF8=''; aHashRound: integer=20000): boolean; virtual;
    /// class method to be called on client side to sign an URI
    // - used by TSQLRestClientURI.URI()
    // - shall match the method as expected by RetrieveSession() virtual method
    class procedure ClientSessionSign(Sender: TSQLRestClientURI;
      var Call: TSQLRestURIParams); virtual; abstract;
  end;

  /// weak authentication scheme using URL-level parameter
  TSQLRestServerAuthenticationURI = class(TSQLRestServerAuthentication)
  public
    /// will check URI-level signature
    // - retrieve the session ID from 'session_signature=...' parameter
    // - method execution should be protected by TSQLRestServer.fSessions.Lock
    function RetrieveSession(Ctxt: TSQLRestServerURIContext): TAuthSession; override;
    /// class method to be called on client side to add the SessionID to the URI
    // - append '&session_signature=SessionID' to the url
    class procedure ClientSessionSign(Sender: TSQLRestClientURI;
      var Call: TSQLRestURIParams); override;
  end;

  /// algorithms known by TSQLRestServerAuthenticationSignedURI to digitaly
  // compute the session_signature parameter value for a given URI
  // - by default, suaCRC32 will compute fast but not cryptographically secure
  // ! crc32(crc32(privatesalt,timestamp,8),url,urllen)
  // - suaCRC32C and suaXXHASH will be faster and slightly safer
  // - but you can select other stronger alternatives, which result will be
  // reduced to 32-bit hexadecimal - suaMD5 will be the fastest cryptographic
  // hash available on all platforms, for enhanced security, by calling e.g.
  // ! (aServer.AuthenticationRegister(TSQLRestServerAuthenticationDefault) as
  // !   TSQLRestServerAuthenticationDefault).Algorithm := suaMD5;
  // - suaSHA1, suaSHA256 and suaSHA512 will be the slowest, to provide
  // additional level of trust, depending on your requirements: note that
  // since the hash is reduced to 32-bit resolution, those may not provide
  // higher security than suaMD5
  // - note that SynCrossPlatformRest clients only implements suaCRC32 yet
  TSQLRestServerAuthenticationSignedURIAlgo =
    (suaCRC32, suaCRC32C, suaXXHASH, suaMD5, suaSHA1, suaSHA256, suaSHA512);

  /// function prototype for TSQLRestServerAuthenticationSignedURI computation
  // of the session_signature parameter value
  TSQLRestServerAuthenticationSignedURIComputeSignature = function(
    privatesalt: cardinal; timestamp, url: PAnsiChar; urllen: integer): cardinal of object;

  /// secure authentication scheme using URL-level digital signature
  // - default suaCRC32 format of session_signature is
  // !Hexa8(SessionID)+
  // !Hexa8(Timestamp)+
  // !Hexa8(crc32('SessionID+HexaSessionPrivateKey'+Sha256('salt'+PassWord)+
  // !            Hexa8(Timestamp)+url))
  TSQLRestServerAuthenticationSignedURI = class(TSQLRestServerAuthenticationURI)
  protected
    fNoTimestampCoherencyCheck: Boolean;
    fTimestampCoherencySeconds: cardinal;
    fTimestampCoherencyTicks: cardinal;
    fComputeSignature: TSQLRestServerAuthenticationSignedURIComputeSignature;
    procedure SetNoTimestampCoherencyCheck(value: boolean);
    procedure SetTimestampCoherencySeconds(value: cardinal);
    procedure SetAlgorithm(value: TSQLRestServerAuthenticationSignedURIAlgo);
    // class functions implementing TSQLRestServerAuthenticationSignedURIAlgo
    class function ComputeSignatureCrc32(privatesalt: cardinal;
      timestamp, url: PAnsiChar; urllen: integer): cardinal;
    class function ComputeSignatureCrc32c(privatesalt: cardinal;
      timestamp, url: PAnsiChar; urllen: integer): cardinal;
    class function ComputeSignaturexxHash(privatesalt: cardinal;
      timestamp, url: PAnsiChar; urllen: integer): cardinal;
    class function ComputeSignatureMD5(privatesalt: cardinal;
      timestamp, url: PAnsiChar; urllen: integer): cardinal;
    class function ComputeSignatureSHA1(privatesalt: cardinal;
      timestamp, url: PAnsiChar; urllen: integer): cardinal;
    class function ComputeSignatureSHA256(privatesalt: cardinal;
      timestamp, url: PAnsiChar; urllen: integer): cardinal;
    class function ComputeSignatureSHA512(privatesalt: cardinal;
      timestamp, url: PAnsiChar; urllen: integer): cardinal;
    class function GetComputeSignature(algo: TSQLRestServerAuthenticationSignedURIAlgo): TSQLRestServerAuthenticationSignedURIComputeSignature;
  public
    /// initialize the authentication method to a specified server
    constructor Create(aServer: TSQLRestServer); override;
    /// will check URI-level signature
    // - check session_signature=... parameter to be a valid digital signature
    // - method execution should be protected by TSQLRestServer.fSessions.Lock
    function RetrieveSession(Ctxt: TSQLRestServerURIContext): TAuthSession; override;
    /// class method to be called on client side to sign an URI
    // - generate the digital signature as expected by overridden RetrieveSession()
    // - timestamp resolution is about 256 ms in the current implementation
    class procedure ClientSessionSign(Sender: TSQLRestClientURI;
      var Call: TSQLRestURIParams); override;
    /// allow any order when creating sessions
    // - by default, signed sessions are expected to be sequential, and new
    // signed session signature can't be older in time than the last one,
    // with a tolerance of TimestampCoherencySeconds
    // - but if your client is asynchronous (e.g. for AJAX requests), session
    // may be rejected due to the delay involved on the client side: you can set
    // this property to TRUE to enabled a weaker but more tolerant behavior
    // ! (aServer.AuthenticationRegister(TSQLRestServerAuthenticationDefault) as
    // !   TSQLRestServerAuthenticationSignedURI).NoTimestampCoherencyCheck := true;
    property NoTimestampCoherencyCheck: Boolean read fNoTimestampCoherencyCheck
      write SetNoTimestampCoherencyCheck;
    /// time tolerance in seconds for the signature timestamps coherency check
    // - by default, signed sessions are expected to be sequential, and new
    // signed session signature can't be older in time than the last one,
    // with a tolerance time defined by this property
    // - default value is 5 seconds, which cover most kind of clients (AJAX or
    // WebSockets), even over a slow Internet connection
    property TimestampCoherencySeconds: cardinal read fTimestampCoherencySeconds
      write SetTimestampCoherencySeconds;
    /// customize the session_signature signing algorithm with a specific function
    // - the very same function should be set on TSQLRestClientURI
    // - to select a known hash algorithm, you may change the Algorithm property
    property ComputeSignature: TSQLRestServerAuthenticationSignedURIComputeSignature
      read fComputeSignature write fComputeSignature;
    /// customize the session_signature signing algorithm
    // - you need to set this value on the server side only; those known algorithms
    // will be recognized by TSQLRestClientURI on the client side during the
    // session handshake, to select the matching ComputeSignature function
    property Algorithm: TSQLRestServerAuthenticationSignedURIAlgo write SetAlgorithm;
  end;

  /// mORMot secure RESTful authentication scheme
  // - this method will use a password stored via safe SHA-256 hashing in the
  // TSQLAuthUser ORM table
  TSQLRestServerAuthenticationDefault = class(TSQLRestServerAuthenticationSignedURI)
  protected
    /// check a supplied password content
    // - will match ClientComputeSessionKey() algorithm as overridden here, i.e.
    // a SHA-256 based signature with a 10 minutes activation window
    function CheckPassword(Ctxt: TSQLRestServerURIContext;
      User: TSQLAuthUser; const aClientNonce, aPassWord: RawUTF8): boolean; virtual;
    /// class method used on client side to create a remote session
    // - will call the ModelRoot/Auth service, i.e. call TSQLRestServer.Auth()
    // published method to create a session for this user: so
    // TSQLRestServerAuthenticationDefault should be registered on server side
    // - User.LogonName and User.PasswordHashHexa will be checked
    class function ClientComputeSessionKey(Sender: TSQLRestClientURI;
      User: TSQLAuthUser): RawUTF8; override;
  public
    /// will try to handle the Auth RESTful method with mORMot authentication
    // - to be called in a two pass "challenging" algorithm:
    // $ GET ModelRoot/auth?UserName=...
    // $  -> returns an hexadecimal nonce contents (valid for 5 minutes)
    // $ GET ModelRoot/auth?UserName=...&PassWord=...&ClientNonce=...
    // $ -> if password is OK, will open the corresponding session
    // $    and return 'SessionID+HexaSessionPrivateKey'
    // The Password parameter as sent for the 2nd request will be computed as
    // ! Sha256(ModelRoot+Nonce+ClientNonce+UserName+Sha256('salt'+PassWord))
    // - the returned HexaSessionPrivateKey content will identify the current
    // user logged and its corresponding session (the same user may have several
    // sessions opened at once, each with its own private key)
    // - then the private session key must be added to every query sent to
    // the server as a session_signature=???? parameter, which will be computed
    // as such:
    // $ ModelRoot/url?A=1&B=2&session_signature=012345670123456701234567
    // were the session_signature= parameter will be computed as such:
    // ! Hexa8(SessionID)+Hexa8(Timestamp)+
    // ! Hexa8(crc32('SessionID+HexaSessionPrivateKey'+Sha256('salt'+PassWord)+
    // !  Hexa8(Timestamp)+url))
    // ! with url='ModelRoot/url?A=1&B=2'
    // this query authentication uses crc32 for hashing instead of SHA-256 in
    // in order to lower the Server-side CPU consumption; the salted password
    // (i.e. TSQLAuthUser.PasswordHashHexa) and client-side Timestamp are
    // inserted inside the session_signature calculation to prevent naive
    // man-in-the-middle attack (MITM)
    // - the session ID will be used to retrieve the rights associated with the
    // user which opened the session via a successful call to the Auth service
    // - when you don't need the session any more (e.g. if the TSQLRestClientURI
    // instance is destroyed), you can call the service as such:
    // $ GET ModelRoot/auth?UserName=...&Session=...
    // - for a way of computing SHA-256 in JavaScript, see for instance
    // @http://www.webtoolkit.info/javascript-sha256.html
    function Auth(Ctxt: TSQLRestServerURIContext): boolean; override;
  end;

  /// mORMot weak RESTful authentication scheme
  // - this method will authenticate with a given username, but no signature
  // - on client side, this scheme is not called by TSQLRestClientURI.SetUser()
  // method - so you have to write:
  // ! TSQLRestServerAuthenticationNone.ClientSetUser(Client,'User','');
  TSQLRestServerAuthenticationNone = class(TSQLRestServerAuthenticationURI)
  protected
    /// class method used on client side to create a remote session
    // - will call the ModelRoot/Auth service, i.e. call TSQLRestServer.Auth()
    // published method to create a session for this user: so
    // TSQLRestServerAuthenticationNone should be registered on server side
    // - will check User.LogonName, but User.PasswordHashHexa will be ignored
    class function ClientComputeSessionKey(Sender: TSQLRestClientURI;
      User: TSQLAuthUser): RawUTF8; override;
  public
    /// will try to handle the Auth RESTful method with mORMot authentication
    // - to be called in a weak one pass request:
    // $ GET ModelRoot/auth?UserName=...
    // $ -> if the specified user name exists, will open the corresponding
    // $    session and return 'SessionID+HexaSessionPrivateKey'
    function Auth(Ctxt: TSQLRestServerURIContext): boolean; override;
  end;

  /// abstract class for implementing HTTP authentication
  // - do not use this abstract class, but e.g. TSQLRestServerAuthenticationHttpBasic
  // - this class will transmit the session_signature as HTTP cookie, not at
  // URI level, so is expected to be used only from browsers or old clients
  TSQLRestServerAuthenticationHttpAbstract = class(TSQLRestServerAuthentication)
  protected
    /// should be overriden according to the HTTP authentication scheme
    class function ComputeAuthenticateHeader(
      const aUserName,aPasswordClear: RawUTF8): RawUTF8; virtual; abstract;
  public
    /// will check the caller signature
    // - retrieve the session ID from "Cookie: mORMot_session_signature=..." HTTP header
    // - method execution should be protected by TSQLRestServer.fSessions.Lock
    function RetrieveSession(Ctxt: TSQLRestServerURIContext): TAuthSession; override;
    /// class method to be called on client side to sign an URI in Auth Basic
    // resolution is about 256 ms in the current implementation
    // - set "Cookie: mORMot_session_signature=..." HTTP header
    class procedure ClientSessionSign(Sender: TSQLRestClientURI;
      var Call: TSQLRestURIParams); override;
    /// class method to be used on client side to create a remote session
    // - call TSQLRestServerAuthenticationHttpBasic.ClientSetUser() instead of
    // TSQLRestClientURI.SetUser(), and never the method of this abstract class
    // - needs the plain aPassword, so aPasswordKind should be passClear
    // - returns true on success
    class function ClientSetUser(Sender: TSQLRestClientURI; const aUserName, aPassword: RawUTF8;
      aPasswordKind: TSQLRestServerAuthenticationClientSetUserPassword=passClear;
      const aHashSalt: RawUTF8=''; aHashRound: integer=20000): boolean; override;
    /// class method to be used on client side to force the HTTP header for
    // the corresponding HTTP authentication, without creating any remote session
    // - call virtual protected method ComputeAuthenticateHeader()
    // - here the password should be given as clear content
    // - potential use case is to use a mORMot client through a HTTPS proxy,
    // e.g. with TSQLRestServerAuthenticationHttpBasic authentication
    // - then you can use TSQLRestServerAuthentication*.ClientSetUser() to
    // define any another "mORMot only" authentication
    // - this method is also called by the ClientSetUser() method of this class
    // for a full client + server authentication via HTTP
    // TSQLRestServerAuthenticationHttp*.ClientSetUser()
    class procedure ClientSetUserHttpOnly(Sender: TSQLRestClientURI;
      const aUserName, aPasswordClear: RawUTF8); virtual;
  end;

  /// authentication using HTTP Basic scheme
  // - this protocol send both name and password as clear (just base-64 encoded)
  // so should only be used over SSL / HTTPS, or for compatibility reasons
  // - will rely on TSQLRestServerAuthenticationNone for authorization
  // - on client side, this scheme is not called by TSQLRestClientURI.SetUser()
  // method - so you have to write:
  // ! TSQLRestServerAuthenticationHttpBasic.ClientSetUser(Client,'User','password');
  // - for a remote proxy-only authentication (without creating any mORMot
  // session), you can write:
  // ! TSQLRestServerAuthenticationHttpBasic.ClientSetUserHttpOnly(Client,'proxyUser','proxyPass');
  TSQLRestServerAuthenticationHttpBasic = class(TSQLRestServerAuthenticationHttpAbstract)
  protected
    /// this overriden method returns "Authorization: Basic ...." HTTP header
    class function ComputeAuthenticateHeader(
      const aUserName,aPasswordClear: RawUTF8): RawUTF8; override;
    /// decode "Authorization: Basic ...." header
    // - you could implement you own password transmission pattern, by
    // overriding both ComputeAuthenticateHeader and GetUserPassFromInHead methods
    class function GetUserPassFromInHead(Ctxt: TSQLRestServerURIContext;
      out userPass,user,pass: RawUTF8): boolean; virtual;
    /// check a supplied password content
    // - this default implementation will use the SHA-256 hash value stored
    // within User.PasswordHashHexa
    // - you can override this method to provide your own password check
    // mechanism, for the given TSQLAuthUser instance
    function CheckPassword(Ctxt: TSQLRestServerURIContext;
      User: TSQLAuthUser; const aPassWord: RawUTF8): boolean; virtual;
  public
    /// will check URI-level signature
    // - retrieve the session ID from 'session_signature=...' parameter
    // - will also check incoming "Authorization: Basic ...." HTTP header
    // - method execution should be protected by TSQLRestServer.fSessions.Lock
    function RetrieveSession(Ctxt: TSQLRestServerURIContext): TAuthSession; override;
    /// handle the Auth RESTful method with HTTP Basic
    // - will first return HTTP_UNAUTHORIZED (401), then expect user and password
    // to be supplied as incoming "Authorization: Basic ...." headers
    function Auth(Ctxt: TSQLRestServerURIContext): boolean; override;
  end;

  {$ifdef DOMAINAUTH}

  /// authentication of the current logged user using Windows Security Support
  // Provider Interface (SSPI) or GSSAPI library on Linux
  // - is able to authenticate the currently logged user on the client side,
  // using either NTLM (Windows only) or Kerberos - it will allow to safely
  // authenticate on a mORMot server without prompting the user to enter its
  // password
  // - if ClientSetUser() receives aUserName as '', aPassword should be either
  // '' if you expect NTLM authentication to take place, or contain the SPN
  // registration (e.g. 'mymormotservice/myserver.mydomain.tld') for Kerberos
  // authentication
  // - if ClientSetUser() receives aUserName as 'DomainName\UserName', then
  // authentication will take place on the specified domain, with aPassword
  // as plain password value
  TSQLRestServerAuthenticationSSPI = class(TSQLRestServerAuthenticationSignedURI)
  protected
    /// Windows built-in authentication
    // - holds information between calls to ServerSSPIAuth
    fSSPIAuthContexts: TSecContextDynArray;
    /// class method used on client side to create a remote session
    // - will call the ModelRoot/Auth service, i.e. call TSQLRestServer.Auth()
    // published method to create a session for this user: so
    // TSQLRestServerAuthenticationSSPI should be registered on server side
    // - Windows SSPI authentication will be performed - in this case,
    // table TSQLAuthUser shall contain an entry for the logged Windows user,
    // with the LoginName in form 'DomainName\UserName'
    // - if User.LogonName is '', then User.PasswordHashHexa is '' for
    // NTLM authentication, or the SPN registration for Kerberos authentication
    // - if User.LogonName is set as 'DomainName\UserName', then authentication
    // will take place on the specified domain, with User.PasswordHashHexa as
    // plain password
    class function ClientComputeSessionKey(Sender: TSQLRestClientURI;
      User: TSQLAuthUser): RawUTF8; override;
  public
    /// initialize the authentication method to a specified server
    constructor Create(aServer: TSQLRestServer); override;
    /// finalize internal memory structures
    destructor Destroy; override;
    /// will try to handle the Auth RESTful method with Windows SSPI API
    // - to be called in a two pass algorithm, used to cypher the password
    // - the client-side logged user will be identified as valid, according
    // to a Windows SSPI API secure challenge
    function Auth(Ctxt: TSQLRestServerURIContext): boolean; override;
  end;

  {$endif DOMAINAUTH}

  /// supported REST authentication schemes
  // - used by the overloaded TSQLHttpServer.Create(TSQLHttpServerDefinition)
  // constructor in mORMotHttpServer.pas, and also in dddInfraSettings.pas
  // - asSSPI won't be defined under Linux, since it is a Windows-centric feature
  TSQLHttpServerRestAuthentication = (
    adDefault, adHttpBasic, adWeak, adSSPI);

  /// parameters supplied to publish a TSQLRestServer via HTTP
  // - used by the overloaded TSQLHttpServer.Create(TSQLHttpServerDefinition)
  // constructor in mORMotHttpServer.pas, and also in dddInfraSettings.pas
  TSQLHttpServerDefinition = class(TSynPersistentWithPassword)
  protected
    FBindPort: RawByteString;
    FAuthentication: TSQLHttpServerRestAuthentication;
    FEnableCORS: RawUTF8;
    FThreadCount: byte;
    FHttps: boolean;
    FHttpSysQueueName: SynUnicode;
    FRemoteIPHeader: RawUTF8;
  published
    /// defines the port to be used for REST publishing
    // - may include an optional IP address to bind, e.g. '127.0.0.1:8888'
    property BindPort: RawByteString read FBindPort write FBindPort;
    /// which authentication is expected to be published
    property Authentication: TSQLHttpServerRestAuthentication
      read FAuthentication write FAuthentication;
    /// allow Cross-origin resource sharing (CORS) access
    // - set this property to '*' if you want to be able to access the
    // REST methods from an HTML5 application hosted in another location,
    // or define a CSV white list of TMatch-compatible origins
    // - will set e.g. the following HTTP header:
    // ! Access-Control-Allow-Origin: *
    property EnableCORS: RawUTF8 read FEnableCORS write FEnableCORS;
    /// how many threads the thread pool associated with this HTTP server
    // should create
    // - if set to 0, will use default value 32
    // - this parameter may be ignored depending on the actual HTTP
    // server used, which may not have any thread pool
    property ThreadCount: byte read fThreadCount write fThreadCount;
    /// defines if https:// protocol should be used
    // - implemented only by http.sys server under Windows, not by socket servers
    property Https: boolean read FHttps write FHttps;
    /// the displayed name in the http.sys queue
    // - used only by http.sys server under Windows, not by socket-based servers
    property HttpSysQueueName: SynUnicode read FHttpSysQueueName write FHttpSysQueueName;
    /// the value of a custom HTTP header containing the real client IP
    // - by default, the RemoteIP information will be retrieved from the socket
    // layer - but if the server runs behind some proxy service, you should
    // define here the HTTP header name which indicates the true remote client
    // IP value, mostly as 'X-Real-IP' or 'X-Forwarded-For'
    property RemoteIPHeader: RawUTF8 read fRemoteIPHeader write fRemoteIPHeader;
    /// if defined, this HTTP server will use WebSockets, and our secure
    // encrypted binary protocol
    // - when stored in the settings JSON file, the password will be safely
    // encrypted as defined by TSynPersistentWithPassword
    // - use the inherited PlainPassword property to set or read its value
    property WebSocketPassword: RawUTF8 read fPassWord write fPassWord;
  end;

  /// TSynAuthentication* class using TSQLAuthUser/TSQLAuthGroup for credentials
  // - could be used e.g. for SynDBRemote access in conjunction with mORMot
  TSynAuthenticationRest = class(TSynAuthenticationAbstract)
  protected
    fServer: TSQLRestServer;
    fAllowedGroups: TIntegerDynArray;
    function GetPassword(const UserName: RawUTF8; out Password: RawUTF8): boolean; override;
    function GetUsersCount: integer; override;
  public
    /// initialize the authentication scheme
    // - you can optionally set the groups allowing to use SynDBRemote - if none
    // is specify, username/password is enough
    constructor Create(aServer: TSQLRestServer; const aAllowedGroups: array of integer); reintroduce;
    /// add some new groups to validate an user authentication
    procedure RegisterAllowedGroups(const aAllowedGroups: array of integer);
    /// to be used to compute a Hash on the client side, for a given Token
    // - the password will be hashed as expected by the GetPassword() method
    class function ComputeHash(Token: Int64; const UserName,PassWord: RawUTF8): cardinal; override;
  end;

  /// common ancestor for tracking TSQLRecord modifications
  // - e.g. TSQLRecordHistory and TSQLRecordVersion will inherit from this class
  // to track TSQLRecord changes
  TSQLRecordModification = class(TSQLRecord)
  protected
    fModifiedRecord: TID;
    fTimestamp: TModTime;
  public
    /// returns the modified record table, as stored in ModifiedRecord
    function ModifiedTable(Model: TSQLModel): TSQLRecordClass;
      {$ifdef HASINLINE}inline;{$endif}
    /// returns the record table index in the TSQLModel, as stored in ModifiedRecord
    function ModifiedTableIndex: integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// returns the modified record ID, as stored in ModifiedRecord
    function ModifiedID: TID;
      {$ifdef HASINLINE}inline;{$endif}
  published
    /// identifies the modified record
    // - ID and table index in TSQLModel is stored as one RecordRef integer
    // - you can use ModifiedTable/ModifiedID to retrieve the TSQLRecord item
    // - in case of the record deletion, all matching TSQLRecordHistory won't
    // be touched by TSQLRestServer.AfterDeleteForceCoherency(): so this
    // property is a plain TID/Int64, not a TRecordReference field
    property ModifiedRecord: TID read fModifiedRecord write fModifiedRecord;
    /// when the modification was recorded
    // - even if in most cases, this timestamp may be synchronized over TSQLRest
    // instances (thanks to TSQLRestClientURI.ServerTimestampSynchronize), it
    // is not safe to use this field as absolute: you should rather rely on
    // pure monotonic ID/RowID increasing values (see e.g. TSQLRecordVersion)
    property Timestamp: TModTime read fTimestamp write fTimestamp;
  end;

  /// common ancestor for tracking changes on TSQLRecord tables
  // - used by TSQLRestServer.TrackChanges() method for simple fields history
  // - TSQLRestServer.InternalUpdateEvent will use this table to store individual
  // row changes as SentDataJSON, then will compress them in History BLOB
  // - note that any layout change of the tracked TSQLRecord table (e.g. adding
  // a new property) will break the internal data format, so will void the table
  TSQLRecordHistory = class(TSQLRecordModification)
  protected
    fEvent: TSQLHistoryEvent;
    fSentData: RawUTF8;
    fHistory: TSQLRawBlob;
    // BLOB storage layout is: RTTIheader + offsets + recordsdata
    fHistoryModel: TSQLModel;
    fHistoryTable: TSQLRecordClass;
    fHistoryTableIndex: integer;
    fHistoryUncompressed: RawByteString;
    fHistoryUncompressedCount: integer;
    fHistoryUncompressedOffset: TIntegerDynArray;
    fHistoryAdd: TFileBufferWriter;
    fHistoryAddCount: integer;
    fHistoryAddOffset: TIntegerDynArray;
    /// override this to customize fields intialization
    class procedure InitializeFields(const Fields: array of const; var JSON: RawUTF8); virtual;
  public
    /// load the change history of a given record
    // - then you can use HistoryGetLast, HistoryCount or HistoryGet() to access
    // all previous stored versions
    constructor CreateHistory(aClient: TSQLRest; aTable: TSQLRecordClass; aID: TID);
    /// finalize any internal memory
    destructor Destroy; override;
    /// called when the associated table is created in the database
    // - create index on History(ModifiedRecord,Event) for process speed-up
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
  public
    /// prepare to access the History BLOB content
    // - ModifiedRecord should have been set to a proper value
    // - returns FALSE if the History BLOB is incorrect (e.g. TSQLRecord
    // layout changed): caller shall flush all previous history
    function HistoryOpen(Model: TSQLModel): boolean;
    /// returns how many revisions are stored in the History BLOB
    // - HistoryOpen() or CreateHistory() should have been called before
    // - this method will ignore any previous HistoryAdd() call
    function HistoryCount: integer;
    /// retrieve an historical version
    // - HistoryOpen() or CreateHistory() should have been called before
    // - this method will ignore any previous HistoryAdd() call
    // - if Rec=nil, will only retrieve Event and Timestamp
    // - if Rec is set, will fill all simple properties of this TSQLRecord
    function HistoryGet(Index: integer; out Event: TSQLHistoryEvent;
      out Timestamp: TModTime; Rec: TSQLRecord): boolean; overload;
    /// retrieve an historical version
    // - HistoryOpen() or CreateHistory() should have been called before
    // - this method will ignore any previous HistoryAdd() call
    // - will fill all simple properties of the supplied TSQLRecord instance
    function HistoryGet(Index: integer; Rec: TSQLRecord): boolean; overload;
    /// retrieve an historical version
    // - HistoryOpen() or CreateHistory() should have been called before
    // - this method will ignore any previous HistoryAdd() call
    // - will return either nil, or a TSQLRecord with all simple properties set
    function HistoryGet(Index: integer): TSQLRecord; overload;
    /// retrieve the latest stored historical version
    // - HistoryOpen() or CreateHistory() should have been called before
    // - this method will ignore any previous HistoryAdd() call
    // - you should not have to use it, since a TSQLRest.Retrieve() is faster
    function HistoryGetLast(Rec: TSQLRecord): boolean; overload;
    /// retrieve the latest stored historical version
    // - HistoryOpen() or CreateHistory() should have been called before,
    // otherwise it will return nil
    // - this method will ignore any previous HistoryAdd() call
    // - you should not have to use it, since a TSQLRest.Retrieve() is faster
    function HistoryGetLast: TSQLRecord; overload;
    /// add a record content to the History BLOB
    // - HistoryOpen() should have been called before using this method -
    // CreateHistory() won't allow history modification
    // - use then HistorySave() to compress and replace the History field
    procedure HistoryAdd(Rec: TSQLRecord; Hist: TSQLRecordHistory);
    /// update the History BLOB field content
    // - HistoryOpen() should have been called before using this method -
    // CreateHistory() won't allow history modification
    // - if HistoryAdd() has not been used, returns false
    // - ID field should have been set for proper persistence on Server
    // - otherwise compress the data into History BLOB, deleting the oldest
    // versions if resulting size is biggger than expected, and returns true
    // - if Server is set, write save the History BLOB to database
    // - if Server and LastRec are set, its content will be compared with the
    // current record in DB (via a Retrieve() call) and stored: it will allow
    // to circumvent any issue about inconsistent use of tracking, e.g. if the
    // database has been modified directly, by-passing the ORM
    function HistorySave(Server: TSQLRestServer;
      LastRec: TSQLRecord=nil): boolean;
  published
    /// the kind of modification stored
    // - is heArchiveBlob when this record stores the compress BLOB in History
    // - otherwise, SentDataJSON may contain the latest values as JSON
    property Event: TSQLHistoryEvent read fEvent write fEvent;
    /// for heAdd/heUpdate, the data is stored as JSON
    // - note that we defined a default maximum size of 4KB for this column,
    // to avoid using a CLOB here - perhaps it may not be enough for huge
    // records - feedback is welcome...
    property SentDataJSON: RawUTF8 index 4000 read fSentData write fSentData;
    /// after some events are written as individual SentData content, they
    // will be gathered and compressed within one BLOB field
    // - use HistoryOpen/HistoryCount/HistoryGet to access the stored data after
    // a call to CreateHistory() constructor
    // - as any BLOB field, this one won't be retrieved by default: use
    // explicitly TSQLRest.RetrieveBlobFields(aRecordHistory) to get it if you
    // want to access it directly, and not via CreateHistory()
    property History: TSQLRawBlob read fHistory write fHistory;
  end;

  /// class-reference type (metaclass) to specify the storage table to be used
  // for tracking TSQLRecord changes
  // - you can create your custom type from TSQLRecordHistory, even for a
  // particular table, to split the tracked changes storage in several tables:
  // ! type
  // !  TSQLRecordMyHistory = class(TSQLRecordHistory);
  // - as expected by TSQLRestServer.TrackChanges() method
  TSQLRecordHistoryClass = class of TSQLRecordHistory;

  /// ORM table used to store the deleted items of a versioned table
  // - the ID/RowID primary key of this table will be the version number
  // (i.e. value computed by TSQLRestServer.InternalRecordVersionCompute),
  // mapped with the corresponding 'TableIndex shl 58' (so that e.g.
  // TSQLRestServer.RecordVersionSynchronizeToBatch() could easily ask for the
  // deleted rows of a given table with a single WHERE clause on the ID/RowID)
  TSQLRecordTableDeleted = class(TSQLRecord)
  protected
    fDeleted: Int64;
  published
    /// this Deleted published field will track the deleted row
    // - defined as Int64 and not TID, to avoid the generation of the index on
    // this column, which is not needed here (all requests are about ID/RowID)
    property Deleted: Int64 read fDeleted write fDeleted;
  end;

  /// class-reference type (metaclass) to specify the storage table to be used
  // for tracking TSQLRecord deletion
  TSQLRecordTableDeletedClass = class of TSQLRecordTableDeleted;

  /// defines what is stored in a TSQLRestTempStorageItem entry
  TSQLRestTempStorageItemKind = set of (itemInsert,itemFakeID);

  /// used to store an entry in the TSQLRestTempStorage class
  TSQLRestTempStorageItem = record
    /// the ID of this entry
    // - after an AddCopy(ForceID=false), is a "fake" ID, which is > maxInt
    ID: TID;
    /// the stored item, either after adding or updating
    // - equals nil if the item has been deleted
    Value: TSQLRecord;
    /// identify the fields stored in the Value instance
    // - e.g. an Update() - or even an Add() - may only have set only simple or
    // specific fields
    ValueFields: TSQLFieldBits;
    /// what is stored in this entry
    Kind: TSQLRestTempStorageItemKind;
  end;

  /// used to store the entries in the TSQLRestTempStorage class
  TSQLRestTempStorageItemDynArray = array of TSQLRestTempStorageITem;

  /// abstract class used for temporary in-memory storage of TSQLRecord
  // - purpose of this class is to gather write operations (Add/Update/Delete)
  // - inherited implementations may send all updates at once to a server (i.e.
  // "asynchronous write"), or maintain a versioned image of the content
  // - all public methods (AddCopy/AddOwned/Update/Delete/FlushAsBatch) are
  // thread-safe, protected by a mutex lock
  TSQLRestTempStorage = class(TSynPersistentLock)
  protected
    fStoredClass: TSQLRecordClass;
    fStoredClassRecordProps: TSQLRecordProperties;
    fItem: TSQLRestTempStorageItemDynArray;
    fItems: TDynArray;
    fLastFakeID: TID;
    fCount: integer;
    function InternalSetFields(const FieldNames: RawUTF8; out Fields: TSQLFieldBits): boolean;
    procedure InternalAddItem(const item: TSQLRestTempStorageItem);
  public
    /// initialize the temporary storage for a given class
    constructor Create(aClass: TSQLRecordClass); reintroduce; virtual;
    /// finalize this temporary storage instance
    destructor Destroy; override;
    /// add a copy of a TSQLRecord to the internal storage list
    // - if ForceID is true, Value.ID will be supplied with the ID to add
    // - if ForceID is false, a "fake" ID is returned, which may be used later
    // on for Update() calls - WARNING: but this ID should not be stored as
    // a cross reference in another record, since it is private to this storage;
    // the definitive ID will be returned eventually after proper persistence
    // (e.g. sent as TSQLRestBatch to a mORMot server)
    // - FieldNames can be the CSV list of field names to be set
    // - if FieldNames is '', will set all simple fields, excluding BLOBs
    // - if FieldNames is '*', will set ALL fields, including BLOBs
    // - this method will clone the supplied Value, and make its own copy
    // for its internal storage - consider use AddOwned() if the caller does
    // not need to store the instance afterwards
    function AddCopy(Value: TSQLRecord; ForceID: boolean;
      const FieldNames: RawUTF8=''): TID; overload;
    /// add and own a TSQLRecord in the internal storage list
    // - if ForceID is true, Value.ID will be supplied with the ID to add
    // - if ForceID is false, a "fake" ID is returned, which may be used later
    // on for Update() calls - WARNING: but this ID should not be stored as
    // a cross reference in another record, since it is private to this storage;
    // the definitive ID will be returned eventually after proper persistence
    // (e.g. sent as TSQLRestBatch to a mORMot server)
    // - FieldNames can be the CSV list of field names to be set
    // - if FieldNames is '', will set all simple fields, excluding BLOBs
    // - if FieldNames is '*', will set ALL fields, including BLOBs
    // - this method will store the supplied Value, and let its internal
    // storage owns it and manage its lifetime - consider use AddCopy() if the
    // caller does need to store this instance afterwards
    // - returns 0 in case of error (e.g. ForceID and no or duplicated Value.ID)
    function AddOwned(Value: TSQLRecord; ForceID: boolean;
      const FieldNames: RawUTF8=''): TID; overload;
    /// add, update or delete a TSQLRecord in the internal storage list
    // - could be used from a TNotifySQLEvent/InternalUpdateEvent(seAdd) callback
    // - here the value to be added is supplied as a JSON object and a ID field
    // - returns false in case of error (e.g. duplicated ID or void JSON)
    function FromEvent(Event: TSQLEvent; ID: TID; const JSON: RawUTF8): boolean;
    /// add and own a TSQLRecord in the internal storage list
    // - if ForceID is true, Value.ID will be supplied with the ID to add
    // - if ForceID is false, a "fake" ID is returned, which may be used later
    // on for Update() calls - WARNING: but this ID should not be stored as
    // a cross reference in another record, since it is private to this storage;
    // the definitive ID will be returned eventually after proper persistence
    // (e.g. sent as TSQLRestBatch to a mORMot server)
    // - this overloaded version expects the fields to be specified as bits
    // - this method will store the supplied Value, and let its internal
    // storage owns it and manage its lifetime - consider use AddCopy() if the
    // caller does need to store this instance afterwards
    // - returns 0 in case of error (e.g. ForceID and no or duplicated Value.ID)
    function AddOwned(Value: TSQLRecord; ForceID: boolean;
      const Fields: TSQLFieldBits): TID; overload;
    /// mark a TSQLRecord as deleted in the internal storage list
    procedure Delete(const ID: TID);
    /// update a TSQLRecord and store the new values in the internal storage list
    // - Value.ID is used to identify the record to be updated (which may be
    // a just added "fake" ID)
    // - FieldNames can be the CSV list of field names to be updated
    // - if FieldNames is '', will update all simple fields, excluding BLOBs
    // - if FieldNames is '*', will update ALL fields, including BLOBs
    // - the supplied Value won't be owned by this instance: the caller should
    // release it when Value is no longer needed
    // - returns false in case of error (e.g. unknwown ID or invalid fields)
    function Update(Value: TSQLRecord; const FieldNames: RawUTF8=''): boolean; overload;
    /// update a TSQLRecord and store the new values in the internal storage list
    // - Value.ID is used to identify the record to be updated (which may be
    // a just added "fake" ID)
    // - this overloaded version expects the fields to be specified as bits
    // - the supplied Value won't be owned by this instance: the caller should
    // release it when Value is no longer needed
    // - returns false in case of error (e.g. unknwown ID or no field set)
    function Update(Value: TSQLRecord; const Fields: TSQLFieldBits): boolean; overload;
    /// convert the internal list as a TSQLRestBatch instance, ready to be
    // sent to the server
    function FlushAsBatch(Rest: TSQLRest;
      AutomaticTransactionPerRow: cardinal=1000): TSQLRestBatch;
    /// direct access to the low-level storage list
    // - the Count property is the number of items, length(Item) is the capacity
    // - the list is stored in increasing ID order
    property Item: TSQLRestTempStorageItemDynArray read fItem;
    /// how many entries are stored in the low-level storage list
    property Count: integer read fCount;
  end;

  /// how TSQLRestServer should maintain its statistical information
  // - used by TSQLRestServer.StatLevels property
  TSQLRestServerMonitorLevels = set of (
    mlTables, mlMethods, mlInterfaces, mlSessions, mlSQLite3);

  /// used for high-level statistics in TSQLRestServer.URI()
  TSQLRestServerMonitor = class(TSynMonitorServer)
  protected
    fServer: TSQLRestServer;
    fStartDate: RawUTF8;
    fCurrentThreadCount: TSynMonitorOneCount;
    fSuccess: TSynMonitorCount64;
    fOutcomingFiles: TSynMonitorCount64;
    fServiceMethod: TSynMonitorCount64;
    fServiceInterface: TSynMonitorCount64;
    fCreated: TSynMonitorCount64;
    fRead: TSynMonitorCount64;
    fUpdated: TSynMonitorCount64;
    fDeleted: TSynMonitorCount64;
    // [Write: boolean] per-table statistics
    fPerTable: array[boolean] of TSynMonitorWithSizeObjArray;
    // no overriden Changed: TSQLRestServer.URI will do it in finally block
  public
    /// initialize the instance
    constructor Create(aServer: TSQLRestServer); reintroduce;
    /// finalize the instance
    destructor Destroy; override;
    /// should be called when a task successfully ended
    // - thread-safe method
    procedure ProcessSuccess(IsOutcomingFile: boolean); virtual;
    /// update and returns the CurrentThreadCount property
    // - this method is thread-safe
    function NotifyThreadCount(delta: integer): integer;
    /// update the Created/Read/Updated/Deleted properties
    // - this method is thread-safe
    procedure NotifyORM(aMethod: TSQLURIMethod);
    /// update the per-table statistics
    // - this method is thread-safe
    procedure NotifyORMTable(TableIndex, DataSize: integer; Write: boolean;
       const MicroSecondsElapsed: QWord);
  published
    /// when this monitoring instance (therefore the server) was created
    property StartDate: RawUTF8 read fStartDate;
    /// number of valid responses
    // - i.e. which returned status code 200/HTTP_SUCCESS or 201/HTTP_CREATED
    // - any invalid request will increase the TSynMonitor.Errors property
    property Success: TSynMonitorCount64 read fSuccess;
    /// count of the remote method-based service calls
    property ServiceMethod: TSynMonitorCount64 read fServiceMethod;
    /// count of the remote interface-based service calls
    property ServiceInterface: TSynMonitorCount64 read fServiceInterface;
    /// count of files transmitted directly (not part of Output size property)
    // - i.e. when the service uses STATICFILE_CONTENT_TYPE/HTTP_RESP_STATICFILE
    // as content type to let the HTTP server directly serve the file content
    property OutcomingFiles: TSynMonitorCount64 read fOutcomingFiles;
    /// number of current declared thread counts
    // - as registered by BeginCurrentThread/EndCurrentThread
    property CurrentThreadCount: TSynMonitorOneCount read fCurrentThreadCount;
    /// how many Create / Add ORM operations did take place
    property Created: TSynMonitorCount64 read fCreated;
    /// how many Read / Get ORM operations did take place
    property Read: TSynMonitorCount64 read fRead;
    /// how many Update ORM operations did take place
    property Updated: TSynMonitorCount64 read fUpdated;
    /// how many Delete ORM operations did take place
    property Deleted: TSynMonitorCount64 read fDeleted;
  end;

  /// ORM table used to store TSynMonitorUsage information in TSynMonitorUsageRest
  // - the ID primary field is the TSynMonitorUsageID (accessible from UsageID
  // public property) shifted by 16 bits (by default) to include a
  // TSynUniqueIdentifierProcess value
  TSQLMonitorUsage = class(TSQLRecordNoCaseExtended)
  protected
    fGran: TSynMonitorUsageGranularity;
    fProcess: Int64;
    fInfo: variant;
    fComment: RawUTF8;
  public
    /// compute the corresponding 23 bit TSynMonitorUsageID.Value time slice
    // - according to the stored Process field, after bit shift
    // - allows a custom aProcessIDShift if it is not set as default 16 bits
    function UsageID(aProcessIDShift: integer=16): integer;
  published
    /// the granularity of the statistics of this entry
    property Gran: TSynMonitorUsageGranularity read fGran write fGran;
    /// identify which application is monitored
    // - match the lower bits of each record ID
    // - by default, is expected to be a TSynUniqueIdentifierProcess 16-bit value
    property Process: Int64 read fProcess write fProcess;
    /// the actual statistics information, stored as a TDocVariant JSON object
    property Info: variant read fInfo write fInfo;
    /// a custom text, which may be used e.g. by support or developpers
    property Comment: RawUTF8 read fComment write fComment;
  end;
  /// class-reference type (metaclass) of a TSQLMonitorUsage table
  TSQLMonitorUsageClass = class of TSQLMonitorUsage;

  /// will store TSynMonitorUsage information in TSQLMonitorUsage ORM tables
  // - TSQLRecord.ID will be the TSynMonitorUsageID shifted by ProcessIDShift bits
  TSynMonitorUsageRest = class(TSynMonitorUsage)
  protected
    fStorage: TSQLRest;
    fProcessID: Int64;
    fProcessIDShift: integer;
    fStoredClass: TSQLMonitorUsageClass;
    fStoredCache: array[mugHour..mugYear] of TSQLMonitorUsage;
    fSaveBatch: TSQLRestBatch;
    function SaveDB(ID: integer; const Track: variant; Gran: TSynMonitorUsageGranularity): boolean; override;
    function LoadDB(ID: integer; Gran: TSynMonitorUsageGranularity; out Track: variant): boolean; override;
  public
    /// initialize storage via ORM
    // - if a 16-bit TSynUniqueIdentifierProcess is supplied, it will be used to
    // identify the generating process by shifting TSynMonitorUsageID values
    // by aProcessIDShift bits (default 16 but you may increase it up to 40 bits)
    // - will use TSQLMonitorUsage table, unless another one is specified
    constructor Create(aStorage: TSQLRest; aProcessID: Int64;
      aStoredClass: TSQLMonitorUsageClass=nil; aProcessIDShift: integer=16); reintroduce; virtual;
    /// finalize the process, saving pending changes
    destructor Destroy; override;
    /// you can set an optional Batch instance to speed up DB writing
    // - when calling the Modified() method
    property SaveBatch: TSQLRestBatch read fSaveBatch write fSaveBatch;
  published
    /// the actual ORM class used for persistence
    property StoredClass: TSQLMonitorUsageClass read fStoredClass;
    /// how the information could be stored for several processes
    // - e.g. when several SOA nodes gather monitoring information in a
    // shared (MongoDB) database
    // - is by default a TSynUniqueIdentifierProcess value, but may be
    // any integer up to ProcessIDShift bits as set in Create()
    property ProcessID: Int64 read fProcessID;
    /// how process ID are stored within the mORMot TSQLRecord.ID
    // - equals 16 bits by default, to match TSynUniqueIdentifierProcess resolution
    property ProcessIDShift: integer read fProcessIDShift;
  end;

  /// the flags used for TSQLRestServer.AddStats
  TSQLRestServerAddStat = (withTables, withMethods, withInterfaces, withSessions);
  /// some flags used for TSQLRestServer.AddStats
  TSQLRestServerAddStats = set of TSQLRestServerAddStat;

  /// a specialized UTF-8 string type, used for TSQLRestServerURI storage
  // - URI format is 'address:port/root', but port or root are optional
  // - you could use TSQLRestServerURI record to store and process it
  TSQLRestServerURIString = type RawUTF8;

  /// a list of UTF-8 strings, used for TSQLRestServerURI storage
  // - URI format is 'address:port/root', but port or root are optional
  // - you could use TSQLRestServerURI record to store and process each item
  TSQLRestServerURIStringDynArray = array of TSQLRestServerURIString;

  /// used to access a TSQLRestServer from its TSQLRestServerURIString URI
  // - URI format is 'address:port/root', and may be transmitted as
  // TSQLRestServerURIString text instances
  {$ifdef USERECORDWITHMETHODS}TSQLRestServerURI = record
    {$else}TSQLRestServerURI = object{$endif}
  private
    function GetURI: TSQLRestServerURIString;
    procedure SetURI(const Value: TSQLRestServerURIString);
  public
    /// the TSQLRestServer IP Address or DNS name
    Address: RawUTF8;
    /// the TSQLRestServer IP port
    Port: RawUTF8;
    /// the TSQLRestServer model Root
    Root: RawUTF8;
    /// returns TRUE if all field values do match, case insensitively
    function Equals(const other: TSQLRestServerURI): boolean;
    /// property which allows to read or set the Address/Port/Root fields as
    // one UTF-8 text field (i.e. a TSQLRestServerURIString instance)
    // - URI format is 'address:port/root', but port or root are optional
    property URI: TSQLRestServerURIString read GetURI write SetURI;
  end;
  /// store a list of TSQLRestServer URIs
  TSQLRestServerURIDynArray = array of TSQLRestServerURI;

  /// used to publish all Services supported by a TSQLRestServer instance
  // - as expected by TSQLRestServer.ServicesPublishedInterfaces
  // - can be serialized as a JSON object via RecordLoadJSON/RecordSaveJSON
  {$ifdef USERECORDWITHMETHODS}TServicesPublishedInterfaces = record
    {$else}TServicesPublishedInterfaces = object{$endif}
  public
    /// how this TSQLRestServer could be accessed
    PublicURI: TSQLRestServerURI;
    /// the list of supported services names
    // - in fact this is the Interface name without the initial 'I', e.g.
    // 'Calculator' for ICalculator
    Names: TRawUTF8DynArray;
  end;
  /// store a list of published Services supported by a TSQLRestServer instance
  TServicesPublishedInterfacesDynArray = array of TServicesPublishedInterfaces;

  /// used e.g. by TSQLRestServer to store a list of TServicesPublishedInterfaces
  TServicesPublishedInterfacesList = class(TSynPersistentLock)
  private
    fDynArray: TDynArray;
    fDynArrayTimeoutTix: TDynArray;
    fTimeoutTix: TInt64DynArray;
    fTimeoutTixCount: integer;
    fLastPublishedJson: cardinal;
    fTimeOut: integer;
  public
    /// the internal list of published services
    // - the list is stored in-order, i.e. it will follow the RegisterFromJSON()
    // execution order: the latest registrations will appear last
    List: TServicesPublishedInterfacesDynArray;
    /// how many items are actually stored in List[]
    Count: Integer;
    /// initialize the storage
    // - an optional time out period, in milliseconds, may be defined - but the
    // clients should ensure that RegisterFromClientJSON() is called in order
    // to refresh the list (e.g. from _contract_ HTTP body)
    constructor Create(aTimeoutMS: integer); reintroduce; virtual;
    /// add the JSON serialized TServicesPublishedInterfaces to the list
    // - called by TSQLRestServerURIContext.InternalExecuteSOAByInterface when
    // the client provides its own services as _contract_ HTTP body
    // - warning: supplied PublishedJson will be parsed in place, so modified
    procedure RegisterFromClientJSON(var PublishedJson: RawUTF8);
    /// set the list from JSON serialized TServicesPublishedInterfacesDynArray
    // - may be used to duplicate the whole TSQLRestServer.AssociatedServices
    // content, as returned from /root/Stat?findservice=*
    // - warning: supplied PublishedJson will be parsed in place, so modified
    procedure RegisterFromServerJSON(var PublishedJson: RawUTF8);
    /// set the list from a remote TSQLRestServer
    // - will call /root/Stat?findservice=* URI, then RegisterFromServerJSON()
    function RegisterFromServer(Client: TSQLRestClientURI): boolean;
    /// search for a public URI in the registration list
    function FindURI(const aPublicURI: TSQLRestServerURI): integer;
    /// search for the latest registrations of a service, by name
    // - will lookup for the Interface name without the initial 'I', e.g.
    // 'Calculator' for ICalculator - warning: research is case-sensitive
    // - if the service name has been registered several times, all
    // registration will be returned, the latest in first position
    function FindService(const aServiceName: RawUTF8): TSQLRestServerURIDynArray;
    /// return all services URI by name, from the registration list, as URIs
    // - will lookup for the Interface name without the initial 'I', e.g.
    // 'Calculator' for ICalculator - warning: research is case-sensitive
    // - the returned string will contain all matching server URI, the latest
    // registration being the first to appear, e.g.
    // $ ["addresslast:port/root","addressprevious:port/root","addressfirst:port/root"]
    function FindServiceAll(const aServiceName: RawUTF8): TSQLRestServerURIStringDynArray; overload;
    /// return all services URI by name, from the registration list, as JSON
    // - will lookup for the Interface name without the initial 'I', e.g.
    // 'Calculator' for ICalculator - warning: research is case-sensitive
    // - the returned JSON array will contain all matching server URI, encoded as
    // a TSQLRestServerURI JSON array, the latest registration being
    // the first to appear, e.g.
    // $ [{"Address":"addresslast","Port":"port","Root":"root"},...]
    // - if aServiceName='*', it will return ALL registration items, encoded as
    // a TServicesPublishedInterfaces JSON array, e.g.
    // $ [{"PublicURI":{"Address":"1.2.3.4","Port":"123","Root":"root"},"Names":['Calculator']},...]
    procedure FindServiceAll(const aServiceName: RawUTF8; aWriter: TTextWriter); overload;
    /// the number of milliseconds after which an entry expires
    // - is 0 by default, meaning no expiration
    // - you can set it to a value so that any service URI registered with
    // RegisterFromJSON() AFTER this property modification may expire
    property TimeOut: integer read fTimeOut write fTimeOut;
  end;

  /// class-reference type (metaclass) of a table containing the Users
  // registered for authentication
  // - see also TSQLRestServer.OnAuthenticationUserRetrieve custom event
  TSQLAuthUserClass = class of TSQLAuthUser;

  /// class-reference type (metaclass) of the table containing the available
  // user access rights for authentication, defined as a group
  TSQLAuthGroupClass = class of TSQLAuthGroup;

  /// class-reference type (metaclass) of a REST server
  TSQLRestServerClass = class of TSQLRestServer;

  /// some options for TSQLRestServer process
  // - read-only rsoNoAJAXJSON indicates that JSON data is transmitted in "not
  // expanded" format: you should NEVER change this option by including
  // this property in TSQLRestServer.Options, but always call explicitly
  // TSQLRestServer.NoAJAXJSON := true so that the SetNoAJAXJSON virtual
  // method should be called as expected (e.g. to flush TSQLRestServerDB cache)
  // - rsoGetAsJsonNotAsString will let ORM GET return to AJAX (non Delphi)
  // clients JSON objects instead of the JSON text stored in database fields
  // - rsoGetID_str will add a "ID_str": string field to circumvent JavaScript
  // limitation of 53-bit for integers - only for AJAX (non Delphi) clients
  // - unauthenticated requests from browsers (i.e. not Delphi clients) may
  // be redirected to the TSQLRestServer.Auth() method via rsoRedirectForbiddenToAuth
  // (e.g. for TSQLRestServerAuthenticationHttpBasic popup)
  // - some REST/AJAX clients may expect to return status code 204 as
  // instead of 200 in case of a successful operation, but with no returned
  // body (e.g. a DELETE with SAPUI5 / OpenUI5 framework): include
  // rsoHttp200WithNoBodyReturns204 so that any HTTP_SUCCESS (200) with no
  // returned body will return a HTTP_NOCONTENT (204), as expected by
  // some clients
  // - by default, Add() or Update() will return HTTP_CREATED (201) or
  // HTTP_SUCCESS (200) with no body, unless rsoAddUpdateReturnsContent is set
  // to return as JSON the last inserted/updated record
  // - TModTime / TCreateTime fields are expected to be filled on client side,
  // unless you set rsoComputeFieldsBeforeWriteOnServerSide so that AJAX requests
  // will set the fields on the server side by calling the TSQLRecord
  // ComputeFieldsBeforeWrite virtual method, before writing to the database
  // - rsoSecureConnectionRequired will ensure Call is flagged as llfSecured
  // (i.e. in-process, HTTPS, or encrypted WebSockets) - with the only exception
  // of the Timestamp method-based service (for monitoring purposes) - note that
  // this option doesn't make sense behind a proxy, just with a true HTTPS server
  // - by default, cookies will contain only 'Path=/Model.Root', but
  // '; Path=/' may be also added setting rsoCookieIncludeRootPath
  // - you can disable the 'HttpOnly' flag via rsoCookieHttpOnlyFlagDisable
  // - TSQLRestServerURIContext.AuthenticationBearerToken will return the
  // ?authenticationbearer=... URI parameter value alternatively to the HTTP
  // header unless rsoAuthenticationURIDisable is set (for security reasons)
  // - you can switch off root/timestamp/info URI via rsoTimestampInfoURIDisable
  // - URI() header output will be sanitized for any EOL injection, unless
  // rsoHttpHeaderCheckDisable is defined (to gain a few cycles?)
  // - by default, TSQLAuthUser.Data blob is retrieved from the database,
  // unless rsoGetUserRetrieveNoBlobData is defined
  // - rsoNoInternalState could be state to avoid transmitting the
  // 'Server-InternalState' header, e.g. if the clients wouldn't need it
  TSQLRestServerOption = (
    rsoNoAJAXJSON,
    rsoGetAsJsonNotAsString,
    rsoGetID_str,
    rsoRedirectForbiddenToAuth,
    rsoHttp200WithNoBodyReturns204,
    rsoAddUpdateReturnsContent,
    rsoComputeFieldsBeforeWriteOnServerSide,
    rsoSecureConnectionRequired,
    rsoCookieIncludeRootPath,
    rsoCookieHttpOnlyFlagDisable,
    rsoAuthenticationURIDisable,
    rsoTimestampInfoURIDisable,
    rsoHttpHeaderCheckDisable,
    rsoGetUserRetrieveNoBlobData,
    rsoNoInternalState);
  /// allow to customize the TSQLRestServer process via its Options property
  TSQLRestServerOptions = set of TSQLRestServerOption;

  /// a generic REpresentational State Transfer (REST) server
  // - descendent must implement the protected EngineList() Retrieve() Add()
  // Update() Delete() methods
  // - automatic call of this methods by a generic URI() RESTful function
  // - any published method of descendants must match TSQLRestServerCallBack
  // prototype, and is expected to be thread-safe
  TSQLRestServer = class(TSQLRest)
  protected
    fVirtualTableDirect: boolean;
    fHandleAuthentication: boolean;
    fBypassORMAuthentication: TSQLURIMethods;
    /// the TSQLAuthUser and TSQLAuthGroup classes, as defined in model
    fSQLAuthUserClass: TSQLAuthUserClass;
    fSQLAuthGroupClass: TSQLAuthGroupClass;
    fAfterCreation: boolean;
    fOptions: TSQLRestServerOptions;
    fJWTForUnauthenticatedRequest: TJWTAbstract;
    /// how in-memory sessions are handled
    fSessionClass: TAuthSessionClass;
    /// will contain the in-memory representation of some static tables
    // - this array has the same length as the associated Model.Tables[]
    // - fStaticData[] will contain pure in-memory tables, not declared as
    // SQLite3 virtual tables, therefore not available from joined SQL statements
    fStaticData: TSQLRestDynArray;
    /// map TSQLRestStorageInMemory or TSQLRestStorageExternal engines
    // - this array has the same length as the associated Model.Tables[]
    // - fStaticVirtualTable[] will contain in-memory or external tables declared
    // as SQLite3 virtual tables, therefore available from joined SQL statements
    // - the very same TSQLRestStorage is handled in fStaticData
    fStaticVirtualTable: TSQLRestDynArray;
    /// in-memory storage of TAuthSession instances
    fSessions: TSynObjectListLocked;
    fSessionsDeprecatedTix: cardinal;
    /// used to compute genuine TAuthSession.ID cardinal value
    fSessionCounter: cardinal;
    fSessionAuthentication: TSQLRestServerAuthenticationDynArray;
    {$ifdef MSWINDOWS}
    /// thread initialized by ExportServerNamedPipe() to response to client through a pipe
    fExportServerNamedPipeThread: TSQLRestServerNamedPipe;
    /// internal server window handle, initialized by ExportServerMessage() method
    fServerWindow: HWND;
    /// internal server window class name, initialized by ExportServerMessage() method
    // - use "string" type, i.e. UnicodeString for Delphi 2009+, in order
    // to call directly the correct FindWindow?()=FindWindow Win32 API
    fServerWindowName: string;
    {$endif}
    fPublishedMethod: TSQLRestServerMethods;
    fPublishedMethods: TDynArrayHashed;
    fPublishedMethodTimestampIndex: integer;
    fPublishedMethodAuthIndex: integer;
    fPublishedMethodBatchIndex: integer;
    fPublicURI: TSQLRestServerURI;
    fAssociatedServices: TServicesPublishedInterfacesList;
    fStats: TSQLRestServerMonitor;
    fStatLevels: TSQLRestServerMonitorLevels;
    fStatUsage: TSynMonitorUsage;
    fShutdownRequested: boolean;
    fCreateMissingTablesOptions: TSQLInitializeTableOptions;
    fRootRedirectGet: RawUTF8;
    fSafeRootUpper: RawUTF8;
    fSafeProtocol: IProtocol;
    fSafeProtocolNext: IProtocol;
    fSafeProtocols: TSynDictionary;
    fRecordVersionMax: TRecordVersion;
    fRecordVersionDeleteIgnore: boolean;
    fOnIdleLastTix: cardinal;
    fSQLRecordVersionDeleteTable: TSQLRecordTableDeletedClass;
    fRecordVersionSlaveCallbacks: array of IServiceRecordVersionCallback;
    fIPBan, fIPWhiteJWT: TIPBan;
    // TSQLRecordHistory.ModifiedRecord handles up to 64 (=1 shl 6) tables
    fTrackChangesHistoryTableIndex: TIntegerDynArray;
    fTrackChangesHistoryTableIndexCount: cardinal;
    fTrackChangesHistory: array of record
      CurrentRow: integer;
      MaxSentDataJsonRow: integer;
      MaxRevisionJSON: integer;
      MaxUncompressedBlobSize: integer;
    end;
    constructor RegisteredClassCreateFrom(aModel: TSQLModel;
      aServerHandleAuthentication: boolean; aDefinition: TSynConnectionDefinition); reintroduce; virtual;
    function GetAuthenticationSchemesCount: integer;
    function GetCurrentSessionUserID: TID; override;
    // called by Stat() and Info() method-based services
    procedure InternalStat(Ctxt: TSQLRestServerURIContext; W: TTextWriter); virtual;
    procedure AddStat(Flags: TSQLRestServerAddStats; W: TTextWriter);
    {$ifndef NOVARIANTS}
    procedure InternalInfo(var info: TDocVariantData); virtual;
    {$endif}
    procedure SetStatUsage(usage: TSynMonitorUsage);
    function GetServiceMethodStat(const aMethod: RawUTF8): TSynMonitorInputOutput;
    /// fast get the associated static server, if any
    function GetStaticDataServer(aClass: TSQLRecordClass): TSQLRest;
    /// retrieve a TSQLRestStorage instance associated to a Virtual Table
    // - is e.g. TSQLRestStorageInMemory instance associated to a
    // TSQLVirtualTableBinary or TSQLVirtualTableJSON class
    // - may be a TSQLRestStorageExternal (as defined in mORMotDB unit)
    // for a virtual table giving access to an external database
    function GetVirtualTable(aClass: TSQLRecordClass): TSQLRest;
    /// fast get the associated static server or Virtual table, if any
    // - this can be used to call directly the TSQLRestStorage instance
    // on the server side
    // - same as a dual call to StaticDataServer[aClass] + StaticVirtualTable[aClass]
    // - TSQLRestServer.URI will make a difference between the a static server
    // or a TSQLVirtualTable, but this method won't - you can set a reference
    // to a TSQLRestServerKind variable to retrieve the database server type
    function GetStaticTable(aClass: TSQLRecordClass): TSQLRest;
       {$ifdef HASINLINE}inline;{$endif}
    /// overloaded method using table index in associated Model
    function GetStaticTableIndex(aTableIndex: integer): TSQLRest;
      overload; {$ifdef HASINLINE}inline;{$endif}
    function GetStaticTableIndex(aTableIndex: integer;
      out Kind: TSQLRestServerKind): TSQLRest; overload;
       {$ifdef HASINLINE}inline;{$endif}
    function GetRemoteTable(TableIndex: Integer): TSQLRest;
    function IsInternalSQLite3Table(aTableIndex: integer): boolean;
    /// intercepts all calls to TSQLRestServer.URI for fSafeProtocol
    // - e.g. ModelRoot/_safe_ URI called by the clients to implement a secure
    // custom encryption, by sending POST requests with an encrypted body as
    // BINARY_CONTENT_TYPE ('application/octet-stream') input and output
    procedure InternalSafeProtocol(var Call: TSQLRestURIParams; var SafeID: integer);
    /// retrieve a list of members as JSON encoded data - used by OneFieldValue()
    // and MultiFieldValue() public functions
    function InternalAdaptSQL(TableIndex: integer; var SQL: RawUTF8): TSQLRest;
    function InternalListRawUTF8(TableIndex: integer; const SQL: RawUTF8): RawUTF8;
    /// will retrieve the monotonic value of a TRecordVersion field from the DB
    procedure InternalRecordVersionMaxFromExisting(RetrieveNext: PID); virtual;
    procedure InternalRecordVersionDelete(TableIndex: integer; ID: TID;
      Batch: TSQLRestBatch); virtual;
    procedure InternalRecordVersionHandle(Occasion: TSQLOccasion;
      TableIndex: integer; var Decoder: TJSONObjectDecoder;
      RecordVersionField: TSQLPropInfoRTTIRecordVersion); virtual;
    /// will compute the next monotonic value for a TRecordVersion field
    // - you may override this method to customize the returned Int64 value
    // (e.g. to support several synchronization nodes)
    function InternalRecordVersionComputeNext: TRecordVersion; virtual;
    /// this method is overridden for setting the NoAJAXJSON field
    // of all associated TSQLRestStorage servers
    procedure SetNoAJAXJSON(const Value: boolean); virtual;
    function GetNoAJAXJSON: boolean;
    /// add a new session to the internal session list
    // - do not use this method directly: this callback is to be used by
    // TSQLRestServerAuthentication* classes
    // - will check that the logon name is valid
    // - on failure, will call TSQLRestServerURIContext.AuthenticationFailed()
    // with afSessionAlreadyStartedForThisUser or afSessionCreationAborted reason
    procedure SessionCreate(var User: TSQLAuthUser; Ctxt: TSQLRestServerURIContext;
      out Session: TAuthSession); virtual;
    /// search for Ctxt.Session ID and fill Ctxt.Session* members if found
    // - returns nil if not found, or fill aContext.User/Group values if matchs
    // - this method will also check for outdated sessions, and delete them
    // - this method is not thread-safe: caller should use Sessions.Lock/Unlock
    function SessionAccess(Ctxt: TSQLRestServerURIContext): TAuthSession;
    /// delete a session from its index in Sessions[]
    // - will perform any needed clean-up, and log the event
    // - this method is not thread-safe: caller should use Sessions.Lock/Unlock
    procedure SessionDelete(aSessionIndex: integer; Ctxt: TSQLRestServerURIContext);
    /// returns TRUE if this table is worth caching (e.g. already in memory)
    // - this overridden implementation returns FALSE for TSQLRestStorageInMemory
    function CacheWorthItForTable(aTableIndex: cardinal): boolean; override;
    /// overridden methods which will perform CRUD operations
    // - will call any static TSQLRestStorage, or call MainEngine*() virtual methods
    function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override;
    function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override;
    function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawUTF8; override;
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override;
    function EngineDelete(TableModelIndex: integer; ID: TID): boolean; override;
    function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; override;
    function EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override;
    function EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; override;
    function EngineBatchSend(Table: TSQLRecordClass; var Data: RawUTF8;
       var Results: TIDDynArray; ExpectedResultsCount: integer): integer; override;
    /// virtual methods which will perform CRUD operations on the main DB
    function MainEngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; virtual; abstract;
    function MainEngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; virtual; abstract;
    function MainEngineList(const SQL: RawUTF8; ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8; virtual; abstract;
    function MainEngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; virtual; abstract;
    function MainEngineDelete(TableModelIndex: integer; ID: TID): boolean; virtual; abstract;
    function MainEngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; virtual; abstract;
    function MainEngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; virtual; abstract;
    function MainEngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; virtual; abstract;
    function MainEngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; virtual; abstract;
    function MainEngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; virtual; abstract;
  public
    /// this integer property is incremented by the database engine when any SQL
    // statement changes the database contents (i.e. on any not SELECT statement)
    // - its value can be published to the client on every remote request
    // - it may be used by client to avoid retrieve data only if necessary
    // - if its value is 0, this feature is not activated on the server, and the
    // client must ignore it and always retrieve the content
    InternalState: Cardinal;
    /// a method can be specified here to trigger events after any table update
    // - is called BEFORE deletion, and AFTER insertion or update
    // - note that the aSentData parameter does not contain all record fields,
    // but only transmitted information: e.g. if only one field is updated, only
    // this single field (and the ID) is available
    // - to be used only server-side, not to synchronize some clients: the framework
    // is designed around a stateless RESTful architecture (like HTTP/1.1), in which
    // clients ask the server for refresh (see TSQLRestClientURI.UpdateFromServer)
    OnUpdateEvent: TNotifySQLEvent;
    /// a method can be specified here to trigger events after any blob update
    // - is called AFTER update of one or several blobs, never on delete nor insert
    // - to be used only server-side, not to synchronize some clients: the framework
    // is designed around a stateless RESTful architecture (like HTTP/1.1), in which
    // clients ask the server for refresh (see TSQLRestClientURI.UpdateFromServer)
    OnBlobUpdateEvent: TNotifyFieldSQLEvent;
    /// a method can be specified to be notified when a session is created
    // - for OnSessionCreate, returning TRUE will abort the session creation -
    // and you can set Ctxt.Call^.OutStatus to a corresponding error code
    // - it could be used e.g. to limit the number of client sessions
    OnSessionCreate: TNotifySQLSession;
    /// a custom method to retrieve the TSQLAuthUser instance for authentication
    // - will be called by TSQLRestServerAuthentication.GetUser() instead of
    // plain SQLAuthUserClass.Create()
    OnAuthenticationUserRetrieve: TOnAuthenticationUserRetrieve;
    /// this event handler will be executed when a session failed to initialize
    // (DenyOfService attack?) or the request is not valid (ManIntheMiddle attack?)
    // - e.g. if the URI signature is invalid, or OnSessionCreate event handler
    // aborted the session creation by returning TRUE (in this later case,
    // the Session parameter is not nil)
    // - you can access the current execution context from the Ctxt parameter,
    // e.g. to retrieve the caller's IP and ban aggressive users in Ctxt.RemoteIP
    // or the text error message corresponding to Reason in Ctxt.CustomErrorMsg
    OnAuthenticationFailed: TNotifyAuthenticationFailed;
    /// a method can be specified to be notified when a session is closed
    // - for OnSessionClosed, the returning boolean value is ignored
    // - Ctxt is nil if the session is closed due to a timeout
    // - Ctxt is not nil if the session is closed explicitly by the client
    OnSessionClosed: TNotifySQLSession;
    /// this event will be executed to push notifications from the server to
    // a remote client, using a (fake) interface parameter
    // - is nil by default, but may point e.g. to TSQLHttpServer.NotifyCallback
    OnNotifyCallback: TSQLRestServerNotifyCallback;
    /// this event will be executed by TServiceFactoryServer.CreateInstance
    // - you may set a callback to customize a server-side service instance,
    // i.e. inject class-level dependencies:
    // !procedure TMyClass.OnCreateInstance(
    // !  Sender: TServiceFactoryServer; Instance: TInterfacedObject);
    // !begin
    // !  if Sender.ImplementationClass=TLegacyStockQuery then
    // !    TLegacyStockQuery(Instance).fDbConnection := fDbConnection;
    // !end;
    // - consider using a TInjectableObjectClass implementation for pure IoC/DI
    OnServiceCreateInstance: TOnServiceCreateInstance;
    /// event trigerred when URI() starts to process a request
    // - the supplied Ctxt parameter will give access to the command about to
    // be executed, e.g. Ctxt.Command=execSOAByInterface will identify a SOA
    // service execution, with the corresponding Service and ServiceMethodIndex
    // parameters as set by TSQLRestServerURIContext.URIDecodeSOAByInterface
    // - should return TRUE if the method can be executed
    // - should return FALSE if the method should not be executed, and the
    // callback should set the corresponding error to the supplied context e.g.
    // ! Ctxt.Error('Unauthorized method',HTTP_NOTALLOWED);
    // - since this event will be executed by every TSQLRestServer.URI call,
    // it should better not make any slow process (like writing to a remote DB)
    // - see also TSQLRest.OnDecryptBody, which is common to the client side, so
    // may be a better place for implementing shared process (e.g. encryption)
    OnBeforeURI: TNotifyBeforeURI;
    /// event trigerred when URI() finished to process a request
    // - the supplied Ctxt parameter will give access to the command which has
    // been executed, e.g. via Ctxt.Call.OutStatus or Ctxt.MicroSecondsElapsed
    // - since this event will be executed by every TSQLRestServer.URI call,
    // it should better not make any slow process (like writing to a remote DB)
    // - see also TSQLRest.OnDecryptBody/OnEncryptBody, which is common to the
    // client side, so may be better to implement shared process (e.g. encryption)
    OnAfterURI: TNotifyAfterURI;
    /// event trigerred when URI() failed to process a request
    // - if Ctxt.ExecuteCommand raised an execption, this callback will be
    // run with all neeed information
    // - should return TRUE to execute Ctxt.Error(E,...), FALSE if returned
    // content has already been set as expected by the client
    OnErrorURI: TNotifyErrorURI;
    {$ifndef NOVARIANTS}
    /// event to customize the information returned by root/timestamp/info
    // - called by TSQLRestServer.InternalInfo method
    // - you can add some application-level information for monitoring
    OnInternalInfo: TOnInternalInfo;
    {$endif}
    /// event trigerred when URI() is called, and at least 128 ms is elapsed
    // - could be used to execute some additional process after a period of time
    // - note that if TSQLRestServer.URI is not called by any client, this
    // callback won't be executed either
    OnIdle: TNotifyEvent;
    /// this property can be used to specify the URI parmeters to be used
    // for query paging
    // - is set by default to PAGINGPARAMETERS_YAHOO constant by
    // TSQLRestServer.Create() constructor
    URIPagingParameters: TSQLRestServerURIPagingParameters;

    /// implement Server-Side TSQLRest deletion
    // - uses internally EngineDelete() function for calling the database engine
    // - call corresponding fStaticData[] if necessary
    // - this record is also erased in all available TRecordReference properties
    // in the database Model, for relational database coherency
    function Delete(Table: TSQLRecordClass; ID: TID): boolean; override;
    /// implement Server-Side TSQLRest deletion with a WHERE clause
    // - will process all ORM-level validation, coherency checking and
    // notifications together with a low-level SQL deletion work (if possible)
    function Delete(Table: TSQLRecordClass; const SQLWhere: RawUTF8): boolean; override;
    /// overridden method for direct static class call (if any)
    function TableRowCount(Table: TSQLRecordClass): Int64; override;
    /// overridden method for direct static class call (if any)
    function TableHasRows(Table: TSQLRecordClass): boolean; override;
    /// overridden method for direct static class call (if any)
    function MemberExists(Table: TSQLRecordClass; ID: TID): boolean; override;
    /// virtual method called when a record is updated
    // - default implementation will call the OnUpdateEvent/OnBlobUpdateEvent
    // methods, if defined
    // - will also handle TSQLRecordHistory tables, as defined by TrackChanges()
    // - returns true on success, false if an error occured (but action must continue)
    // - you can override this method to implement a server-wide notification,
    // but be aware it may be the first step to break the stateless architecture
    // of the framework
    function InternalUpdateEvent(aEvent: TSQLEvent; aTableIndex: integer; aID: TID;
      const aSentData: RawUTF8; aIsBlobFields: PSQLFieldBits): boolean; virtual;
    /// initialize change tracking for the given tables
    // - by default, it will use the TSQLRecordHistory table to store the
    // changes - you can specify a dedicated class as aTableHistory parameter
    // - if aTableHistory is not already part of the TSQLModel, it will be added
    // - note that this setting should be consistent in time: if you disable
    // tracking for a while, or did not enable tracking before adding a record,
    // then the content history won't be consistent (or disabled) for this record
    // - at every change, aTableHistory.SentDataJSON records will be added, up
    // to aMaxHistoryRowBeforeBlob items - then aTableHistory.History will store
    // a compressed version of all previous changes
    // - aMaxHistoryRowBeforeBlob is the maximum number of JSON rows per Table
    // before compression into BLOB is triggerred
    // - aMaxHistoryRowPerRecord is the maximum number of JSON rows per record,
    // above which the versions will be compressed as BLOB
    // - aMaxUncompressedBlobSize is the maximum BLOB size per record
    // - you can specify aMaxHistoryRowBeforeBlob=0 to disable change tracking
    // - you should call this method after the CreateMissingTables call
    // - note that change tracking may slow down the writing process, and
    // may increase storage space a lot (even if BLOB maximum size can be set),
    // so should be defined only when necessary
    procedure TrackChanges(const aTable: array of TSQLRecordClass;
      aTableHistory: TSQLRecordHistoryClass=nil; aMaxHistoryRowBeforeBlob: integer=1000;
      aMaxHistoryRowPerRecord: integer=10; aMaxUncompressedBlobSize: integer=64*1024); virtual;
    /// force compression of all aTableHistory.SentDataJson into History BLOB
    // - by default, this will take place in InternalUpdateEvent() when
    // aMaxHistoryRowBeforeBlob - as set by TrackChanges() method - is reached
    // - you can manually call this method to force History BLOB update, e.g.
    // when the server is in Idle state, and ready for process
    procedure TrackChangesFlush(aTableHistory: TSQLRecordHistoryClass); virtual;
    /// check if OnUpdateEvent or change tracked has been defined for this table
    // - is used internally e.g. by TSQLRestServerDB.MainEngineUpdateField to
    // ensure that the updated ID fields will be computed as expected
    function InternalUpdateEventNeeded(aTableIndex: integer): boolean;
    /// will compute the next monotonic value for a TRecordVersion field
    function RecordVersionCompute: TRecordVersion;
    /// read only access to the current monotonic value for a TRecordVersion field
    function RecordVersionCurrent: TRecordVersion;
    /// synchronous master/slave replication from a slave TSQLRest
    // - apply all the updates from another (distant) master TSQLRest for a given
    // TSQLRecord table, using its TRecordVersion field, to the calling slave
    // - both remote Master and local slave TSQLRestServer should have the supplied
    // Table class in their data model (maybe in diverse order)
    // - by default, all pending updates are retrieved, but you can define a value
    // to ChunkRowLimit, so that the updates will be retrieved by smaller chunks
    // - returns -1 on error, or the latest applied revision number (which may
    // be 0 if there is no data in the table)
    // - this method will use regular REST ORM commands, so will work with any
    // communication channels: for real-time push synchronization, consider using
    // RecordVersionSynchronizeMasterStart and RecordVersionSynchronizeSlaveStart
    // over a bidirectionnal communication channel like WebSockets
    // - you can use RecordVersionSynchronizeSlaveToBatch if your purpose is
    // to access the updates before applying to the current slave storage
    function RecordVersionSynchronizeSlave(Table: TSQLRecordClass;
      Master: TSQLRest; ChunkRowLimit: integer=0; OnWrite: TOnBatchWrite=nil): TRecordVersion;
    /// synchronous master/slave replication from a slave TSQLRest into a Batch
    // - will retrieve all the updates from a (distant) master TSQLRest for a
    // given TSQLRecord table, using its TRecordVersion field, and a supplied
    // TRecordVersion monotonic value, into a TSQLRestBatch instance
    // - both remote Source and local TSQLRestSever should have the supplied
    // Table class in each of their data model
    // - by default, all pending updates are retrieved, but you can define a value
    // to MaxRowLimit, so that the updates will be retrieved by smaller chunks
    // - returns nil if nothing new was found, or a TSQLRestBatch instance
    // containing all modifications since RecordVersion revision
    // - when executing the returned TSQLRestBatch on the database, you should
    // set TSQLRestServer.RecordVersionDeleteIgnore := true so that the
    // TRecordVersion fields will be forced from the supplied value
    // - usually, you should not need to use this method, but rather the more
    // straightforward RecordVersionSynchronizeSlave()
    function RecordVersionSynchronizeSlaveToBatch(Table: TSQLRecordClass;
      Master: TSQLRest; var RecordVersion: TRecordVersion;
      MaxRowLimit: integer=0; OnWrite: TOnBatchWrite=nil): TSQLRestBatch; virtual;
    /// initiate asynchronous master/slave replication on a master TSQLRest
    // - allow synchronization of a TSQLRecord table, using its TRecordVersion
    // field, for real-time master/slave replication on the master side
    // - this method will register the IServiceRecordVersion service on the
    // server side, so that RecordVersionSynchronizeStartSlave() will be able
    // to receive push notifications of any updates
    // - this method expects the communication channel to be bidirectional, e.g.
    // a mORMotHTTPServer's TSQLHttpServer in useBidirSocket mode
    function RecordVersionSynchronizeMasterStart(ByPassAuthentication: boolean=false): boolean;
    /// initiate asynchronous master/slave replication on a slave TSQLRest
    // - start synchronization of a TSQLRecord table, using its TRecordVersion
    // field, for real-time master/slave replication on the slave side
    // - this method will first retrieve any pending modification by regular
    // REST calls to RecordVersionSynchronizeSlave, then create and register a
    // callback instance using RecordVersionSynchronizeSubscribeMaster()
    // - this method expects the communication channel to be bidirectional, e.g.
    // a TSQLHttpClientWebsockets
    // - the modifications will be pushed by the master, then applied to the
    // slave storage, until RecordVersionSynchronizeSlaveStop method is called
    // - an optional OnNotify event may be defined, which will be triggered
    // for all incoming change, supllying the updated TSQLRecord instance
    function RecordVersionSynchronizeSlaveStart(Table: TSQLRecordClass;
      MasterRemoteAccess: TSQLRestClientURI; OnNotify: TOnBatchWrite=nil): boolean;
    /// finalize asynchronous master/slave replication on a slave TSQLRest
    // - stop synchronization of a TSQLRecord table, using its TRecordVersion
    // field, for real-time master/slave replication on the slave side
    // - expect a previous call to RecordVersionSynchronizeSlaveStart
    function RecordVersionSynchronizeSlaveStop(Table: TSQLRecordClass): boolean;
    /// low-level callback registration for asynchronous master/slave replication
    // - you should not have to use this method, but rather
    // RecordVersionSynchronizeMasterStart and RecordVersionSynchronizeSlaveStart
    // RecordVersionSynchronizeSlaveStop methods
    // - register a callback interface on the master side, which will be called
    // each time a write operation is performed on a given TSQLRecord with a
    // TRecordVersion field
    // - the callback parameter could be a TServiceRecordVersionCallback instance,
    // which will perform all update operations as expected
    // - the callback process will be blocking for the ORM write point of view:
    // so it should be as fast as possible, or asynchronous - note that regular
    // callbacks using WebSockets, as implemented by SynBidirSock.pas and
    // mORMotHTTPServer's TSQLHttpServer in useBidirSocket mode, are asynchronous
    // - if the supplied RecordVersion is not the latest on the server side,
    // this method will return FALSE and the caller should synchronize again via
    // RecordVersionSynchronize() to avoid any missing update
    // - if the supplied RecordVersion is the latest on the server side,
    // this method will return TRUE and put the Callback notification in place
    function RecordVersionSynchronizeSubscribeMaster(Table: TSQLRecordClass;
      RecordVersion: TRecordVersion; const SlaveCallback: IServiceRecordVersionCallback): boolean; overload;
    /// this method is called internally after any successfull deletion to
    // ensure relational database coherency
    // - reset all matching TRecordReference properties in the database Model,
    // for database coherency, into 0
    // - delete all records containing a matched TRecordReferenceToBeDeleted
    // property value in the database Model (e.g. TSQLRecordHistory)
    // - reset all matching TSQLRecord properties in the database Model,
    // for database coherency, into 0
    // - important notice: we don't use FOREIGN KEY constraints in this framework,
    // and handle all integrity check within this method (it's therefore less
    // error-prone, and more cross-database engine compatible)
    function AfterDeleteForceCoherency(aTableIndex: integer; aID: TID): boolean; virtual;
    /// update all BLOB fields of the supplied Value
    // - this overridden method will execute the direct static class, if any
    function UpdateBlobFields(Value: TSQLRecord): boolean; override;
    /// get all BLOB fields of the supplied value from the remote server
    // - this overridden method will execute the direct static class, if any
    function RetrieveBlobFields(Value: TSQLRecord): boolean; override;
    /// implement Server-Side TSQLRest unlocking
    // - to be called e.g. after a Retrieve() with forupdate=TRUE
    // - implements our custom UNLOCK REST-like verb
    // - locking is handled by TSQLServer.Model
    // - returns true on success
    function UnLock(Table: TSQLRecordClass; aID: TID): boolean; override;
    /// end a transaction
    // - implements REST END collection
    // - write all pending TSQLVirtualTableJSON data to the disk
    procedure Commit(SessionID: cardinal; RaiseException: boolean); override;

    /// grant access to this database content from a dll using the global
    // URIRequest() function
    // - returns true if the URIRequest() function is set to this TSQLRestServer
    // - returns false if a TSQLRestServer was already exported
    // - client must release all memory acquired by URIRequest() with GlobalFree()
    function ExportServer: boolean; overload;
    {$ifdef MSWINDOWS}
    /// declare the server on the local machine as a Named Pipe: allows
    // TSQLRestClientURINamedPipe local or remote client connection
    // - ServerApplicationName ('DBSERVER' e.g.) will be used to create a named
    // pipe server identifier, it is of UnicodeString type since Delphi 2009
    // (use of Unicode FileOpen() version)
    // - this server identifier is appended to '\\.\pipe\mORMot_' to obtain
    // the full pipe name to initiate ('\\.\pipe\mORMot_DBSERVER' e.g.)
    // - this server identifier may also contain a fully qualified path
    // ('\\.\pipe\ApplicationName' e.g.)
    // - allows only one ExportServer*() by running process
    // - returns true on success, false otherwise (ServerApplicationName already used?)
    function ExportServerNamedPipe(const ServerApplicationName: TFileName): boolean;
    /// end any currently initialized named pipe server
    function CloseServerNamedPipe: boolean;
    /// declare the server on the local machine to be accessible for local
    // client connection, by using Windows messages
    // - the data is sent and received by using the standard and fast WM_COPYDATA message
    // - Windows messages are very fast (faster than named pipe and much faster
    // than HTTP), but only work localy on the same computer
    // - create a new Window Class with the supplied class name (UnicodeString
    // since Delphi 2009 for direct use of Wide Win32 API), and instanciate
    // a window which will handle pending WM_COPYDATA messages
    // - the main server instance has to process the windows messages regularely
    // (e.g. with Application.ProcessMessages)
    // - ServerWindowName ('DBSERVER' e.g.) will be used to create a
    // Window name identifier
    // - allows only one ExportServer*() by running process
    // - returns true on success, false otherwise (ServerWindowName already used?)
    function ExportServerMessage(const ServerWindowName: string): boolean;
    /// implement a message-based server response
    // - this method is called automaticaly if ExportServerMessage() method
    // was initilialized
    // - you can also call this method from the WM_COPYDATA message handler
    // of your main form, and use the TSQLRestClientURIMessage class to access
    // the server instance from your clients
    // - it will answer to the Client with another WM_COPYDATA message
    // - message oriented architecture doesn't need any thread, but will use
    // the main thread of your application
    procedure AnswerToMessage(var Msg: TWMCopyData); message WM_COPYDATA;
    /// end any currently initialized message-oriented server
    function CloseServerMessage: boolean;
    /// returns TRUE if remote connection is possible via named pipes or Windows
    // messages
    function ExportedAsMessageOrNamedPipe: Boolean;
    {$endif}
    /// Server initialization with a specified Database Model
    // - if HandleUserAuthentication is false, will set URI access rights to
    // 'Supervisor' (i.e. all R/W access) by default
    // - if HandleUserAuthentication is true, will add TSQLAuthUser and
    // TSQLAuthGroup to the TSQLModel (if not already there)
    constructor Create(aModel: TSQLModel; aHandleUserAuthentication: boolean=false); reintroduce; virtual;
    /// Server initialization with a temporary Database Model
    // - a Model will be created with supplied tables, and owned by the server
    // - if you instantiate a TSQLRestServerFullMemory or TSQLRestServerDB
    // with this constructor, an in-memory engine will be created, with
    // enough abilities to run regression tests, for instance
    constructor CreateWithOwnModel(const Tables: array of TSQLRecordClass;
      aHandleUserAuthentication: boolean=false; const aRoot: RawUTF8='root');
    /// create a new minimal TSQLRestServer instance, to be used with
    // external SQL or NoSQL storage
    // - will try to instantiate an in-memory TSQLRestServerDB, and if
    // mORMotSQLite3.pas is not linked, fallback to a TSQLRestServerFullMemory
    // - used e.g. by TSQLRestMongoDBCreate() and TSQLRestExternalDBCreate()
    class function CreateInMemoryForAllVirtualTables(aModel: TSQLModel;
      aHandleUserAuthentication: boolean): TSQLRestServer;
    /// release memory and any existing pipe initialized by ExportServer()
    destructor Destroy; override;

    /// you can call this method to prepare the server for shutting down
    // - it will reject any incoming request from now on, and will wait until
    // all pending requests are finished, for proper server termination
    // - you could optionally save the current server state (e.g. user sessions)
    // into a file, ready to be retrieved later on using SessionsLoadFromFile -
    // note that this will work only for ORM sessions, NOT complex SOA state
    // - this method is called by Destroy itself
    procedure Shutdown(const aStateFileName: TFileName=''); virtual;
    /// wait for the specified number of milliseconds
    // - if Shutdown is called in-between, returns true
    // - if the thread waited the supplied time, returns false
    function SleepOrShutdown(MS: integer): boolean;

    /// Missing tables are created if they don't exist yet for every TSQLRecord
    // class of the Database Model
    // - you must call explicitely this before having called StaticDataCreate()
    // - all table description (even Unique feature) is retrieved from the Model
    // - this method should also create additional fields, if the TSQLRecord definition
    // has been modified; only field adding is mandatory, field renaming or
    // field deleting are not allowed in the FrameWork (in such cases, you must
    // create a new TSQLRecord type)
    // - this virtual method do nothing by default - overridden versions should
    // implement it as expected by the underlying storage engine (e.g. SQLite3
    // or TSQLRestServerFullInMemory)
    // - you can tune some options transmitted to the TSQLRecord.InitializeTable
    // virtual methods, e.g. to avoid the automatic create of indexes
    procedure CreateMissingTables(user_version: cardinal=0;
      options: TSQLInitializeTableOptions=[]); virtual;
    /// run the TSQLRecord.InitializeTable methods for all void tables of the model
    // - can be used instead of CreateMissingTables e.g. for MongoDB storage
    // - you can specify the creation options, e.g. INITIALIZETABLE_NOINDEX
    procedure InitializeTables(Options: TSQLInitializeTableOptions);
    /// create an external static in-memory database for a specific class
    // - call it just after Create, before TSQLRestServerDB.CreateMissingTables;
    // warning: if you don't call this method before CreateMissingTable method
    // is called, the table will be created as a regular table by the main
    // database engine, and won't be static
    // - can load the table content from a file if a file name is specified
    // (could be either JSON or compressed Binary format on disk)
    // - you can define a particular external engine by setting a custom class -
    // by default, it will create a TSQLRestStorageInMemory instance
    // - this data handles basic REST commands, since no complete SQL interpreter
    // can be implemented by TSQLRestStorage; to provide full SQL process,
    // you should better use a Virtual Table class, inheriting e.g. from
    // TSQLRecordVirtualTableAutoID associated with TSQLVirtualTableJSON/Binary
    // via a Model.VirtualTableRegister() call before TSQLRestServer.Create
    // - return nil on any error, or an EModelException if the class is not in
    // the database model
    function StaticDataCreate(aClass: TSQLRecordClass;
      const aFileName: TFileName = ''; aBinaryFile: boolean=false;
      aServerClass: TSQLRestStorageInMemoryClass=nil): TSQLRestStorage;
    /// register an external static storage for a given table
    // - will be added to StaticDataServer[] internal list
    // - called e.g. by StaticDataCreate(), RemoteDataCreate() or
    // StaticMongoDBRegister()
    function StaticDataAdd(aStaticData: TSQLRestStorage): boolean;
    /// create an external static redirection for a specific class
    // - call it just after Create, before TSQLRestServerDB.CreateMissingTables;
    // warning: if you don't call this method before CreateMissingTable method
    // is called, the table will be created as a regular table by the main
    // database engine, and won't be static
    // - the specified TSQLRecord will have all its CRUD / ORM methods be
    // redirected to aRemoteRest, which may be a TSQLRestClient or another
    // TSQLRestServer instance (e.g. a fast SQLITE_MEMORY_DATABASE_NAME)
    // - if aRemoteRest is a TSQLRestClient, it should have been authenticated
    // to the remote TSQLRestServer, so that CRUD / ORM operations will pass
    // - this will enable easy creation of proxies, or local servers, with they
    // own cache and data model - e.g. a branch office server which may serve
    // its local clients over Ethernet, but communicating to a main mORMot
    // server via Internet, storing the corporate data in the main office server
    // - you may also share some tables (e.g. TSQLAuthUser and TSQLAuthGroup)
    // between TSQLRestServer instances in a single service
    function RemoteDataCreate(aClass: TSQLRecordClass; aRemoteRest: TSQLRest): TSQLRestStorageRemote; virtual;
    /// call this method when the internal DB content is known to be invalid
    // - by default, all REST/CRUD requests and direct SQL statements are
    // scanned and identified as potentially able to change the internal SQL/JSON
    // cache used at SQLite3 database level; but some virtual tables (e.g.
    // TSQLRestStorageExternal classes defined in mORMotDB) could flush
    // the database content without proper notification
    // - this default implementation will just do nothing, but mORMotSQlite3
    // unit will call TSQLDataBase.CacheFlush method
    procedure FlushInternalDBCache; virtual;
    /// you can call this method in TThread.Execute to ensure that
    // the thread will be taken into account during process
    // - caller must specify the TThread instance running
    // - used e.g. for optExecInMainThread option in TServiceMethodExecute
    // - this default implementation will call the methods of all its internal
    // TSQLRestStorage instances
    // - this method shall be called from the thread just initiated: e.g.
    // if you call it from the main thread, it may fail to prepare resources
    procedure BeginCurrentThread(Sender: TThread); override;
    /// you can call this method just before a thread is finished to ensure
    // e.g. that the associated external DB connection will be released
    // - this default implementation will call the methods of all its internal
    // TSQLRestStorage instances, allowing e.g. TSQLRestStorageExternal
    // instances to clean their thread-specific connections
    // - this method shall be called from the thread about to be terminated: e.g.
    // if you call it from the main thread, it may fail to release resources
    // - it is set e.g. by TSQLite3HttpServer to be called from HTTP threads,
    // or by TSQLRestServerNamedPipeResponse for named-pipe server cleaning
    procedure EndCurrentThread(Sender: TThread); override;

    /// implement a generic local, piped or HTTP/1.1 provider
    // - this is the main entry point of the server, from the client side
    // - default implementation calls protected methods EngineList() Retrieve()
    // Add() Update() Delete() UnLock() EngineExecute() above, which must be overridden by
    // the TSQLRestServer child
    // - for 'GET ModelRoot/TableName', url parameters can be either "select" and
    // "where" (to specify a SQL Query, from the SQLFromSelectWhere function),
    // either "sort", "dir", "startIndex", "results", as expected by the YUI
    // DataSource Request Syntax for data pagination - see
    // http://developer.yahoo.com/yui/datatable/#data
    // - execution of this method could be monitored via OnBeforeURI and OnAfterURI
    // event handlers
    procedure URI(var Call: TSQLRestURIParams); virtual;

    /// create an index for the specific FieldName
    // - will call CreateSQLMultiIndex() internaly
    function CreateSQLIndex(Table: TSQLRecordClass; const FieldName: RawUTF8;
      Unique: boolean; const IndexName: RawUTF8=''): boolean; overload;
    /// create one or multiple index(es) for the specific FieldName(s)
    function CreateSQLIndex(Table: TSQLRecordClass; const FieldNames: array of RawUTF8;
      Unique: boolean): boolean; overload;
    /// create one index for all specific FieldNames at once
    // - will call any static engine for the index creation of such tables, or
    // execute a CREATE INDEX IF NOT EXISTS on the main engine
    // - note that with SQLite3, your database schema should never contain two
    // indices where one index is a prefix of the other, e.g. if you defined:
    // ! aServer.CreateSQLMultiIndex(TEmails, ['Email','GroupID'], True);
    // Then the following index is not mandatory for SQLite3:
    // ! aServer.CreateSQLIndex(TEmails, 'Email', False);
    // see "1.6 Multi-Column Indices" in @http://www.sqlite.org/queryplanner.html
    function CreateSQLMultiIndex(Table: TSQLRecordClass; const FieldNames: array of RawUTF8;
      Unique: boolean; IndexName: RawUTF8=''): boolean; virtual;

    /// call this method to add an authentication method to the server
    // - will return the just created TSQLRestServerAuthentication instance,
    // or the existing instance if it has already been registered
    // - you can use this method to tune the authentication, e.g. if you have
    // troubles with AJAX asynchronous callbacks:
    // ! (aServer.AuthenticationRegister(TSQLRestServerAuthenticationDefault) as
    // !   TSQLRestServerAuthenticationDefault).NoTimestampCoherencyCheck := true;
    // or if you want to customize the session_signature parameter algorithm:
    // ! (aServer.AuthenticationRegister(TSQLRestServerAuthenticationDefault) as
    // !   TSQLRestServerAuthenticationDefault).Algorithm := suaMD5;
    function AuthenticationRegister(
      aMethod: TSQLRestServerAuthenticationClass): TSQLRestServerAuthentication; overload;
    /// call this method to add several authentication methods to the server
    // - if TSQLRestServer.Create() constructor is called with aHandleUserAuthentication
    // set to TRUE, it will register the two following classes:
    // ! AuthenticationRegister([TSQLRestServerAuthenticationDefault,TSQLRestServerAuthenticationSSPI]);
    procedure AuthenticationRegister(const aMethods: array of TSQLRestServerAuthenticationClass); overload;
    /// call this method to remove an authentication method to the server
    procedure AuthenticationUnregister(aMethod: TSQLRestServerAuthenticationClass); overload;
    /// call this method to remove several authentication methods to the server
    procedure AuthenticationUnregister(const aMethods: array of TSQLRestServerAuthenticationClass); overload;
    /// call this method to remove all authentication methods to the server
    procedure AuthenticationUnregisterAll;
    /// (un)register a banned IPv4 value
    // - any connection attempt from this IP Address will be rejected by
    function BanIP(const aIP: RawUTF8; aRemoveBan: boolean=false): boolean;
    /// (un)register a an IPv4 value to the JWT white list
    // - by default, a JWT validated by JWTForUnauthenticatedRequest will be accepted
    // - to avoid MiM (Man-In-the-Middle) attacks, if a JWT white list is defined
    // using this method, any connection from a non registered IP will be rejected,
    // even with a valid JWT
    // - WebSockets connections are secure enough to bypass this list
    function JWTForUnauthenticatedRequestWhiteIP(const aIP: RawUTF8; aRemoveWhite: boolean=false): boolean;
    /// add all published methods of a given object instance to the method-based
    // list of services
    // - all those published method signature should match TSQLRestServerCallBack
    procedure ServiceMethodRegisterPublishedMethods(const aPrefix: RawUTF8;
      aInstance: TObject);
    /// direct registration of a method for a given low-level event handler
    procedure ServiceMethodRegister(aMethodName: RawUTF8;
      const aEvent: TSQLRestServerCallBack; aByPassAuthentication: boolean=false);
    /// call this method to disable Authentication method check for a given
    // published method-based service name
    // - by default, only Auth and Timestamp methods do not require the RESTful
    // authentication of the URI; you may call this method to add another method
    // to the list (e.g. for returning some HTML content from a public URI)
    // - if the supplied aMethodName='', all method-based services will
    // bypass the authenticaton process
    // - returns the method index number
    function ServiceMethodByPassAuthentication(const aMethodName: RawUTF8): integer;
    /// retrieve detailed statistics about a method-based service use
    // - will return a reference to the actual alive item: caller should
    // not free the returned instance
    property ServiceMethodStat[const aMethod: RawUTF8]: TSynMonitorInputOutput
      read GetServiceMethodStat;
    /// used e.g. by IAdministratedDaemon to implement "pseudo-SQL" commands
    procedure AdministrationExecute(const DatabaseName,SQL: RawUTF8;
      var result: TServiceCustomAnswer); override;
    /// compute a JSON description of all available services, and its public URI
    // - the JSON object matches the TServicesPublishedInterfaces record type
    // - used by TSQLRestClientURI.ServicePublishOwnInterfaces to register all
    // the services supported by the client itself
    // - warning: the public URI should have been set via SetPublicURI()
    function ServicesPublishedInterfaces: RawUTF8;
    /// the HTTP server should call this method so that ServicesPublishedInterfaces
    // registration will be able to work
    procedure SetPublicURI(const Address,Port: RawUTF8);
    /// a list of the services associated by all clients of this server instance
    // - when a client connects to this server, it will publish its own services
    // (when checking its interface contract), so that they may be identified
    property AssociatedServices: TServicesPublishedInterfacesList read fAssociatedServices;
    /// returns a copy of the user associated to a session ID
    // - returns nil if the session does not exist (e.g. if authentication is
    // disabled)
    // - caller MUST release the TSQLAuthUser instance returned (if not nil)
    // - this method IS thread-safe, and calls internaly Sessions.Lock
    // (the returned TSQLAuthUser is a private copy from Sessions[].User instance,
    // in order to be really thread-safe)
    // - the returned TSQLAuthUser instance will have GroupRights=nil but will
    // have ID, LogonName, DisplayName, PasswordHashHexa and Data fields available
    function SessionGetUser(aSessionID: Cardinal): TSQLAuthUser;
    /// persist all in-memory sessions into a compressed binary file
    // - you should not call this method it directly, but rather use Shutdown()
    // with a StateFileName parameter - to be used e.g. for a short maintainance
    // server shutdown, without loosing the current logged user sessions
    // - this method IS thread-safe, and call internaly Sessions.Lock
    procedure SessionsSaveToFile(const aFileName: TFileName);
    /// re-create all in-memory sessions from a compressed binary file
    // - typical use is after a server restart, with the file supplied to the
    // Shutdown() method: it could be used e.g. for a short maintainance server
    // shutdown, without loosing the current logged user sessions
    // - WARNING: this method will restore authentication sessions for the ORM,
    // but not any complex state information used by interface-based services,
    // like sicClientDriven class instances - DO NOT use this feature with SOA
    // - this method IS thread-safe, and call internaly Sessions.Lock
    procedure SessionsLoadFromFile(const aFileName: TFileName;
      andDeleteExistingFileAfterRead: boolean);
    /// retrieve all current session information as a JSON array
    function SessionsAsJson: RawJSON;

    /// register a Service class on the server side
    // - this methods expects a class to be supplied, and the exact list of
    // interfaces to be registered to the server (e.g. [TypeInfo(IMyInterface)])
    // and implemented by this class
    // - class can be any TInterfacedObject, but TInterfacedObjectWithCustomCreate
    // can be used if you need an overridden constructor
    // - instance implementation pattern will be set by the appropriate parameter
    // - will return the first of the registered TServiceFactoryServer created
    // on success (i.e. the one corresponding to the first item of the aInterfaces
    // array), or nil if registration failed (e.g. if any of the supplied interfaces
    // is not implemented by the given class)
    // - you can use the returned TServiceFactoryServer instance to set the
    // expected security parameters associated with this interface
    // - the same implementation class can be used to handle several interfaces
    // (just as Delphi allows to do natively)
    function ServiceRegister(aImplementationClass: TInterfacedClass;
      const aInterfaces: array of PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''): TServiceFactoryServer; overload; virtual;
    /// register a Service instance on the server side
    // - this methods expects a class instance to be supplied, and the exact list
    // of interfaces to be registered to the server (e.g. [TypeInfo(IMyInterface)])
    // and implemented by this shared instance
    // - as a consequence, instance implementation pattern will always be sicShared
    // - will return the first of the registered TServiceFactoryServer created
    // on success (i.e. the one corresponding to the first item of the aInterfaces
    // array), or nil if registration failed (e.g. if any of the supplied interfaces
    // is not implemented by the given class)
    // - you can use the returned TServiceFactoryServer instance to set the
    // expected security parameters associated with this interface
    // - the same implementation class can be used to handle several interfaces
    // (just as Delphi allows to do natively)
    function ServiceRegister(aSharedImplementation: TInterfacedObject;
      const aInterfaces: array of PTypeInfo; const aContractExpected: RawUTF8=''): TServiceFactoryServer; overload; virtual;
    /// register a remote Service via its interface
    // - this overloaded method will register a remote Service, accessed via the
    // supplied TSQLRest(ClientURI) instance: it can be available in the main
    // TSQLRestServer.Services property, but execution will take place on a
    // remote server - may be used e.g. for dedicated hosting of services (in
    // a DMZ for instance)
    // - this methods expects a list of interfaces to be registered to the client
    // (e.g. [TypeInfo(IMyInterface)])
    // - instance implementation pattern will be set by the appropriate parameter
    // - will return true on success, false if registration failed (e.g. if any of
    // the supplied interfaces is not correct or is not available on the server)
    // - that is, server side will be called to check for the availability of
    // each interface
    // - you can specify an optional custom contract for the first interface
    function ServiceRegister(aClient: TSQLRest; const aInterfaces: array of PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''): boolean; overload; virtual;
    /// register a Service class on the server side
    // - this method expects the interface(s) to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    function ServiceDefine(aImplementationClass: TInterfacedClass;
      const aInterfaces: array of TGUID;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''): TServiceFactoryServer; overload;
    /// register a Service instance on the server side
    // - this method expects the interface(s) to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    // - the supplied aSharedImplementation will be owned by this Server instance
    function ServiceDefine(aSharedImplementation: TInterfacedObject;
      const aInterfaces: array of TGUID; const aContractExpected: RawUTF8=''): TServiceFactoryServer; overload;
    /// register a remote Service via its interface
    // - this method expects the interface(s) to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    function ServiceDefine(aClient: TSQLRest; const aInterfaces: array of TGUID;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''): boolean; overload;
    /// access or initialize the internal IoC resolver, used for interface-based
    // remote services, and more generaly any Services.Resolve() call
    // - create and initialize the internal TServiceContainerServer if no
    // service interface has been registered yet
    // - may be used to inject some dependencies, which are not interface-based
    // remote services, but internal IoC, without the ServiceRegister()
    // or ServiceDefine() methods - e.g.
    // ! aRest.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(aRest)],true);
    // - this overriden method will return a TServiceContainerServer instance
    // - you may enable SOA audit trail for all methods execution:
    // ! (aRestSOAServer.ServiceContainer as TServiceContainerServer).SetServiceLog(
    // !   aRestLogServer,TSQLRecordServiceLog);
    function ServiceContainer: TServiceContainer; override;

    /// compute the statistics about this server, as JSON
    // - is a wrapper around the Stats() method-based service
    function StatsAsJson(Flags: TSQLRestServerAddStats=[withTables..withSessions]): RawUTF8; virtual;
    /// compute the statistics about this server, as a TDocVariant document
    // - is a wrapper around the Stats() method-based service
    function StatsAsDocVariant(Flags: TSQLRestServerAddStats=[withTables..withSessions]): variant;

    /// read-only access to the internal list of sessions
    // - ensure you protect its access calling Sessions.Lock/Sessions.Unlock
    property Sessions: TSynObjectListLocked read fSessions;
    /// read-only access to the list of registered server-side authentication
    // methods, used for session creation
    // - note that the exact number or registered services in this list is
    // stored in the AuthenticationSchemesCount property
    property AuthenticationSchemes: TSQLRestServerAuthenticationDynArray
      read fSessionAuthentication;
    /// how many authentication methods are registered in AuthenticationSchemes
    property AuthenticationSchemesCount: integer
      read GetAuthenticationSchemesCount;
    /// define if unsecure connections (i.e. not in-process or encrypted
    // WebSockets) with no session can be authenticated via JWT
    // - once set, this instance will be owned by the TSQLRestServer
    // - by definition, such JWT authentication won't identify any mORMot user
    // nor session (it just has to be valid), so only sicSingle, sicShared or
    // sicPerThread interface-based services execution are possible
    // - typical usage is for a public API, in conjunction with
    // ServiceDefine(...).ResultAsJSONObjectWithoutResult := true on the server
    // side and TSQLRestClientURI.ServiceDefineSharedAPI() method for the client
    // - see also JWTForUnauthenticatedRequestWhiteIP() for additional security
    property JWTForUnauthenticatedRequest: TJWTAbstract
      read fJWTForUnauthenticatedRequest write fJWTForUnauthenticatedRequest;
    /// retrieve the TSQLRestStorage instance used to store and manage
    // a specified TSQLRecordClass in memory
    // - has been associated by the StaticDataCreate method
    property StaticDataServer[aClass: TSQLRecordClass]: TSQLRest
      read GetStaticDataServer;
    /// retrieve a running TSQLRestStorage virtual table
    // - associated e.g. to a 'JSON' or 'Binary' virtual table module, or may
    // return a TSQLRestStorageExternal instance (as defined in mORMotDB)
    // - this property will return nil if there is no Virtual Table associated
    // or if the corresponding module is not a TSQLVirtualTable
    // (e.g. "pure" static tables registered by StaticDataCreate will be
    // accessible only via StaticDataServer[], not via StaticVirtualTable[])
    // - has been associated by the TSQLModel.VirtualTableRegister method or
    // the VirtualTableExternalRegister() global function
    property StaticVirtualTable[aClass: TSQLRecordClass]: TSQLRest
      read GetVirtualTable;
    /// fast get the associated static server or virtual table, if any
    // - same as a dual call to StaticDataServer[aClass] + StaticVirtualTable[aClass]
    property StaticTable[aClass: TSQLRecordClass]: TSQLRest read GetStaticTable;
    /// the options specified to TSQLRestServer.CreateMissingTables
    // - as expected by TSQLRecord.InitializeTable methods
    property CreateMissingTablesOptions: TSQLInitializeTableOptions
      read fCreateMissingTablesOptions;
    /// the URI to redirect any plain GET on root URI, without any method
    // - could be used to ease access from web browsers URI
    property RootRedirectGet: RawUTF8 read fRootRedirectGet write fRootRedirectGet;
    /// you can force this property to TRUE so that any Delete() will not
    // write to the TSQLRecordTableDelete table for TRecordVersion tables
    // - to be used when applying a TSQLRestBatch instance as returned by
    // RecordVersionSynchronizeToBatch()
    property RecordVersionDeleteIgnore: boolean
      read fRecordVersionDeleteIgnore write fRecordVersionDeleteIgnore;
  published
    /// set this property to true to transmit the JSON data in a "not expanded" format
    // - not directly compatible with Javascript object list decode: not to be
    // used in AJAX environnement (like in TSQLite3HttpServer)
    // - but transmitted JSON data is much smaller if set it's set to FALSE, and
    // if you use a Delphi Client, parsing will be also faster and memory usage
    // will be lower
    // - By default, the NoAJAXJSON property is set to TRUE in
    // TSQLRestServer.ExportServerNamedPipe: if you use named pipes for communication,
    // you probably won't use javascript because browser communicates via HTTP!
    // - But otherwise, NoAJAXJSON property is set to FALSE. You could force its
    // value to TRUE and you'd save some bandwidth if you don't use javascript:
    // even the parsing of the JSON Content will be faster with Delphi client
    // if JSON content is not expanded
    // - the "expanded" or standard/AJAX layout allows you to create pure JavaScript
    // objects from the JSON content, because the field name / JavaScript object
    // property name is supplied for every value
    // - the "not expanded" layout, NoAJAXJSON property is set to TRUE,
    // reflects exactly the layout of the SQL request - first line contains the
    // field names, then all next lines are the field content
    // - is in fact stored in rsoNoAJAXJSON item in Options property
    property NoAJAXJSON: boolean read GetNoAJAXJSON write SetNoAJAXJSON;
    /// allow to customize how TSQLRestServer.URI process the requests
    // - e.g. if HTTP_SUCCESS with no body should be translated into HTTP_NOCONTENT
    property Options: TSQLRestServerOptions read fOptions write fOptions;
    /// set to true if the server will handle per-user authentication and
    // access right management
    // - i.e. if the associated TSQLModel contains TSQLAuthUser and
    // TSQLAuthGroup tables (set by constructor)
    property HandleAuthentication: boolean read fHandleAuthentication;
    /// allow to by-pass Authentication for a given set of HTTP verbs
    // - by default, RESTful access to the ORM will follow HandleAuthentication
    /// setting: but you could define some HTTP verb to this property, which
    // will by-pass the authentication - may be used e.g. for public GET
    // of the content by an AJAX client
    property BypassORMAuthentication: TSQLURIMethods read fBypassORMAuthentication write fBypassORMAuthentication;
    /// read-only access to the high-level Server statistics
    // - see ServiceMethodStat[] for information about method-based services,
    // or TServiceFactoryServer.Stats / Stat[] for interface-based services
    // - statistics are available remotely as JSON from the Stat() method
    property Stats: TSQLRestServerMonitor read fStats;
    /// which level of detailed information is gathered
    // - by default, contains SERVERDEFAULTMONITORLEVELS, i.e.
    // ! [mlTables,mlMethods,mlInterfaces,mlSQLite3]
    // - you can add mlSessions to maintain per-session statistics: this will
    // lead into a slightly higher memory consumption, for each session
    property StatLevels: TSQLRestServerMonitorLevels read fStatLevels write fStatLevels;
    /// could be set to track statistic from Stats information
    // - it may be e.g. a TSynMonitorUsageRest instance for REST storage
    property StatUsage: TSynMonitorUsage read fStatUsage write SetStatUsage;
    /// this property can be left to its TRUE default value, to handle any
    // TSQLVirtualTableJSON static tables (module JSON or BINARY) with direct
    // calls to the storage instance
    // - is set to TRUE by default to enable faster Direct mode
    // - in Direct mode, GET/POST/PUT/DELETE of individual records (or BLOB fields)
    // from URI() will call directly the corresponding TSQLRestStorage
    // instance, for better speed for most used RESTful operations; but complex
    // SQL requests (e.g. joined SELECT) will rely on the main SQL engine
    // - if set to false, will use the main SQLite3 engine for all statements
    // (should not to be used normally, because it will add unnecessary overhead)
    property StaticVirtualTableDirect: boolean read fVirtualTableDirect
      write fVirtualTableDirect;
    /// the class inheriting from TSQLRecordTableDeleted, as defined in the model
    // - during authentication, this class will be used for storing a trace of
    // every deletion of table rows containing a TRecordVersion published field
    property SQLRecordVersionDeleteTable: TSQLRecordTableDeletedClass
      read fSQLRecordVersionDeleteTable;
    /// the class inheriting from TAuthSession to handle in-memory sessions
    // - since all sessions data remain in memory, ensure they are not taking
    // too much resource (memory or process time)
    property SessionClass: TAuthSessionClass read fSessionClass write fSessionClass;
    /// the class inheriting from TSQLAuthUser, as defined in the model
    // - during authentication, this class will be used for every TSQLAuthUser
    // table access
    // - see also the OnAuthenticationUserRetrieve optional event handler
    property SQLAuthUserClass: TSQLAuthUserClass read fSQLAuthUserClass;
    /// the class inheriting from TSQLAuthGroup, as defined in the model
    // - during authentication, this class will be used for every TSQLAuthGroup
    // table access
    property SQLAuthGroupClass: TSQLAuthGroupClass read fSQLAuthGroupClass;
  published { standard method-based services }
    /// REST service accessible from ModelRoot/Stat URI to gather detailed information
    // - returns the current execution statistics of this server, as a JSON object
    // - this method will require an authenticated client, for safety
    // - by default, will return the high-level information of this server
    // - will return human-readable JSON layout if ModelRoot/Stat/json is used, or
    // the corresponding XML content if ModelRoot/Stat/xml is used
    // - you can define withtables, withmethods, withinterfaces, withsessions or
    // withsqlite3 additional parameters to return detailed information about
    // method-based services, interface-based services, per session statistics,
    // or prepared SQLite3 SQL statement timing (for a TSQLRestServerDB instance)
    // ! Client.CallBackGet('stat',['withtables',true,'withmethods',true,
    // !   'withinterfaces',true,'withsessions',true,'withsqlite3',true],stats);
    // - defining a 'withall' parameter will retrieve all available statistics
    // - note that TSQLRestServer.StatLevels property will enable statistics
    // gathering for tables, methods, interfaces, sqlite3 or sessions
    // - a specific findservice=ServiceName parameter will not return any
    // statistics, but matching URIs from the server AssociatedServices list
    procedure Stat(Ctxt: TSQLRestServerURIContext);
    /// REST service accessible from ModelRoot/Auth URI
    // - called by the clients for authentication and session management
    // - this method won't require an authenticated client, since it is used to
    // initiate authentication
    // - this global callback method is thread-safe
    procedure Auth(Ctxt: TSQLRestServerURIContext);
    /// REST service accessible from the ModelRoot/Timestamp URI
    // - returns the server time stamp TTimeLog/Int64 value as UTF-8 text
    // - this method will not require an authenticated client
    // - hidden ModelRoot/Timestamp/info command will return basic execution
    // information, less verbose (and sensitive) than Stat(), calling virtual
    // InternalInfo() protected method
    procedure Timestamp(Ctxt: TSQLRestServerURIContext);
    /// REST service accessible from the ModelRoot/CacheFlush URI
    // - it will flush the server result cache
    // - this method shall be called by the clients when the Server cache may be
    // not consistent any more (e.g. after a direct write to an external database)
    // - this method will require an authenticated client, for safety
    // - GET ModelRoot/CacheFlush URI will flush the whole Server cache,
    // for all tables
    // - GET ModelRoot/CacheFlush/TableName URI will flush the specified
    // table cache
    // - GET ModelRoot/CacheFlush/TableName/TableID URI will flush the content
    // of the specified record
    // - POST ModelRoot/CacheFlush/_callback_ URI will be called by the client
    // to notify the server that an interface callback instance has been released
    // - POST ModelRoot/CacheFlush/_ping_ URI will be called by the client after
    // every half session timeout (or at least every hour) to notify the server
    // that the connection is still alive
    procedure CacheFlush(Ctxt: TSQLRestServerURIContext);
    /// REST service accessible from the ModelRoot/Batch URI
    // - will execute a set of RESTful commands, in a single step, with optional
    // automatic SQL transaction generation
    // - this method will require an authenticated client, for safety
    // - expect input as JSON commands:
    // & '{"Table":["cmd":values,...]}'
    // or for multiple tables:
    // & '["cmd@Table":values,...]'
    // with cmd in POST/PUT with {object} as value or DELETE with ID
    // - returns an array of integers: '[200,200,...]' or '["OK"]' if all
    // returned status codes are 200 (HTTP_SUCCESS)
    // - URI are either 'ModelRoot/TableName/Batch' or 'ModelRoot/Batch'
    procedure Batch(Ctxt: TSQLRestServerURIContext);
  end;

  /// REST class with direct access to an external database engine
  // - you can set an alternate per-table database engine by using this class
  // - this abstract class is to be overridden with a proper implementation
  // (e.g. TSQLRestStorageInMemory in this unit, or TSQLRestStorageExternal
  // from mORMotDB unit, or TSQLRestStorageMongoDB from mORMotMongoDB unit)
  TSQLRestStorage = class(TSQLRest)
  protected
    fStoredClass: TSQLRecordClass;
    fStoredClassProps: TSQLModelRecordProperties;
    fStoredClassRecordProps: TSQLRecordProperties;
    fStoredClassMapping: PSQLRecordPropertiesMapping;
    fStorageLockShouldIncreaseOwnerInternalState: boolean;
    fStorageLockLogTrace: boolean;
    fModified: boolean;
    fOwner: TSQLRestServer;
    fStorageCriticalSection: TRTLCriticalSection;
    fStorageCriticalSectionCount: integer;
    fBasicSQLCount: RawUTF8;
    fBasicSQLHasRows: array[boolean] of RawUTF8;
    fStorageVirtual: TSQLVirtualTable;
    /// any set bit in this field indicates UNIQUE field value
    fIsUnique: TSQLFieldBits;
    /// allow to force refresh for a given Static table
    // - default FALSE means to return the main TSQLRestServer.InternalState
    // - TRUE indicates that OutInternalState := cardinal(-1) will be returned
    fOutInternalStateForcedRefresh: boolean;
    procedure RecordVersionFieldHandle(Occasion: TSQLOccasion;
      var Decoder: TJSONObjectDecoder);
    /// override this method if you want to update the refresh state
    // - returns FALSE if the static table content was not modified (default
    // method implementation is to always return FALSE)
    // - returns TRUE if the table has been refreshed and its content was modified:
    // therefore the client will know he'll need to refresh some content
    function RefreshedAndModified: boolean; virtual;
    /// TSQLRestServer.URI use it for Static.EngineList to by-pass virtual table
    // - this default implementation will return TRUE and replace SQL with
    // SQLSelectAll[true] if it SQL equals SQLSelectAll[false] (i.e. 'SELECT *')
    // - this method is called only if the WHERE clause of SQL refers to the
    // static table name only (not needed to check it twice)
    function AdaptSQLForEngineList(var SQL: RawUTF8): boolean; virtual;
    function GetStoredClassName: RawUTF8;
    function GetCurrentSessionUserID: TID; override;
  public
    /// initialize the abstract storage data
    constructor Create(aClass: TSQLRecordClass; aServer: TSQLRestServer); reintroduce; virtual;
    /// finalize the storage instance
    destructor Destroy; override;
    /// should be called before any access to the storage content
    // - and protected with a try ... finally StorageUnLock; end section
    procedure StorageLock(WillModifyContent: boolean; const msg: RawUTF8); virtual;
    /// should be called after any StorageLock-protected access to the content
    // - e.g. protected with a try ... finally StorageUnLock; end section
    procedure StorageUnLock; virtual;
    /// you can call this method in TThread.Execute to ensure that
    // the thread will be taken into account during process
    // - this overridden method will do nothing (should have been already made
    // at TSQLRestServer caller level)
    // - children classes may inherit from this method to notify e.g.
    // a third party process (like proper OLE initialization)
    procedure BeginCurrentThread(Sender: TThread); override;
    /// you can call this method just before a thread is finished to ensure
    // e.g. that the associated external DB connection will be released
    // - this overridden method will do nothing (should have been already made
    // at TSQLRestServer caller level)
    // - children classes may inherit from this method to notify e.g.
    // a third party process (like proper OLE initialization)
    procedure EndCurrentThread(Sender: TThread); override;

    /// implement TSQLRest unlocking (UNLOCK verb)
    // - to be called e.g. after a Retrieve() with forupdate=TRUE
    // - locking is handled at (Owner.)Model level
    // - returns true on success
    function UnLock(Table: TSQLRecordClass; aID: TID): boolean; override;
    /// overridden method calling the owner (if any) to guess if this record
    // can be updated or deleted
    function RecordCanBeUpdated(Table: TSQLRecordClass; ID: TID; Action: TSQLEvent;
      ErrorMsg: PRawUTF8 = nil): boolean; override;
    /// create one index for all specific FieldNames at once
    // - do nothing method: will return FALSE (aka error)
    function CreateSQLMultiIndex(Table: TSQLRecordClass; const FieldNames: array of RawUTF8;
      Unique: boolean; IndexName: RawUTF8=''): boolean; virtual;
    /// search for a numerical field value
    // - return true on success (i.e. if some values have been added to ResultID)
    // - store the results into the ResultID dynamic array
    // - faster than OneFieldValues method, which creates a temporary JSON content
    // - this default implementation will call the overloaded SearchField()
    // value after conversion of the FieldValue into RawUTF8
    function SearchField(const FieldName: RawUTF8; FieldValue: Int64;
      out ResultID: TIDDynArray): boolean; overload; virtual;
    /// search for a field value, according to its SQL content representation
    // - return true on success (i.e. if some values have been added to ResultID)
    // - store the results into the ResultID dynamic array
    // - faster than OneFieldValues method, which creates a temporary JSON content
    function SearchField(const FieldName, FieldValue: RawUTF8;
      out ResultID: TIDDynArray): boolean; overload; virtual; abstract;
    /// access or initialize the internal IoC resolver
    // - this overriden method will return always nil, since IoC only makes
    // sense at TSQLRestClient and TSQLRestServer level
    function ServiceContainer: TServiceContainer; override;

    /// read only access to a boolean value set to true if table data was modified
    property Modified: boolean read fModified write fModified;
    /// read only access to the ORM properties of the associated record type
    // - may be nil if this instance is not associated with a TSQLModel
    property StoredClassProps: TSQLModelRecordProperties read fStoredClassProps;
    /// read only access to the RTTI properties of the associated record type
    property StoredClassRecordProps: TSQLRecordProperties read fStoredClassRecordProps;
    /// read only access to the TSQLRestServer using this storage engine
    property Owner: TSQLRestServer read fOwner;
    /// enable low-level trace of StorageLock/StorageUnlock methods
    // - may be used to resolve low-level race conditions
    property StorageLockLogTrace: boolean read fStorageLockLogTrace write fStorageLockLogTrace;
    /// read only access to the class defining the record type stored in this
    // REST storage
    property StoredClass: TSQLRecordClass read fStoredClass;
  published
    /// name of the class defining the record type stored in this REST storage
    property StoredClassName: RawUTF8 read GetStoredClassName;
  end;

  /// event prototype called by TSQLRestStorageInMemory.FindWhereEqual() or
  // TSQLRestStorageInMemory.ForEach() methods
  // - aDest is an opaque pointer, as supplied to FindWhereEqual(), which may
  // point e.g. to a result list, or a shared variable to apply the process
  // - aRec will point to the corresponding item
  // - aIndex will identify the item index in the internal list
  TFindWhereEqualEvent = procedure(aDest: pointer; aRec: TSQLRecord; aIndex: integer) of object;

  /// abstract REST storage exposing some internal TSQLRecord-based methods
  TSQLRestStorageRecordBased = class(TSQLRestStorage)
  protected
    function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override;
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override;
  public
    /// manual Add of a TSQLRecord
    // - returns the ID created on success
    // - returns -1 on failure (not UNIQUE field value e.g.)
    // - on success, the Rec instance is added to the Values[] list: caller
    // doesn't need to Free it
    function AddOne(Rec: TSQLRecord; ForceID: boolean; const SentData: RawUTF8): TID; virtual; abstract;
    /// manual Retrieval of a TSQLRecord field values
    // - an instance of the associated static class is created
    // - and all its properties are filled from the Items[] values
    // - caller can modify these properties, then use UpdateOne() if the changes
    // have to be stored inside the Items[] list
    // - calller must always free the returned instance
    // - returns NIL if any error occured, e.g. if the supplied aID was incorrect
    // - method available since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    function GetOne(aID: TID): TSQLRecord; virtual; abstract;
    /// manual Update of a TSQLRecord field values
    // - Rec.ID specifies which record is to be updated
    // - will update all properties, including BLOB fields and such
    // - returns TRUE on success, FALSE on any error (e.g. invalid Rec.ID)
    // - method available since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    function UpdateOne(Rec: TSQLRecord; const SentData: RawUTF8): boolean; overload; virtual; abstract;
    /// manual Update of a TSQLRecord field values from an array of TSQLVar
    // - will update all properties, including BLOB fields and such
    // - returns TRUE on success, FALSE on any error (e.g. invalid Rec.ID)
    // - method available since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    // - this default implementation will create a temporary TSQLRecord instance
    // with the supplied Values[], and will call overloaded UpdateOne() method
    function UpdateOne(ID: TID; const Values: TSQLVarDynArray): boolean; overload; virtual;
  end;

  /// class able to handle a O(1) hashed-based search of a property
  // - used e.g. to hash TSQLRestStorageInMemory field values
  TSQLRestStorageInMemoryUnique = class
  protected
    fHasher: TDynArrayHasher;
    fOwner: TSQLRestStorageInMemory;
    fPropInfo: TSQLPropInfo;
    fCaseInsensitive: boolean;
    fLastFindHashCode: cardinal;
    function EventCompare(const A,B): integer; // match TEventDynArraySortCompare
    function EventHash(const Elem): cardinal;  // match TEventDynArrayHashOne
  public
    /// initialize a hash for a record array field
    // - aField maps the "stored AS_UNIQUE" published property
    constructor Create(aOwner: TSQLRestStorageInMemory; aField: TSQLPropInfo);
    /// fast search using O(1) internal hash table
    // - returns -1 if not found or not indexed (self=nil)
    function Find(Rec: TSQLRecord): integer;
    /// called by TSQLRestStorageInMemory.AddOne after a precious Find()
    function AddedAfterFind(Rec: TSQLRecord): boolean;
    /// the corresponding field RTTI
    property PropInfo: TSQLPropInfo read fPropInfo;
    /// if the string comparison shall be case-insensitive
    property CaseInsensitive: boolean read fCaseInsensitive;
    /// access to the internal hash table
    property Hasher: TDynArrayHasher read fHasher;
  end;

  /// REST storage with direct access to a TObjectList memory-stored table
  // - store the associated TSQLRecord values in memory
  // - handle one TSQLRecord per TSQLRestStorageInMemory instance
  // - must be registered individualy in a TSQLRestServer to access data from a
  // common client, by using the TSQLRestServer.StaticDataCreate method:
  // it allows an unique access for both SQLite3 and Static databases
  // - handle basic REST commands, no SQL interpreter is implemented: only
  // valid SQL command is "SELECT Field1,Field2 FROM Table WHERE ID=120;", i.e
  // a one Table SELECT with one optional "WHERE fieldname = value" statement;
  // if used within a TSQLVirtualTableJSON, you'll be able to handle any kind of
  // SQL statement (even joined SELECT or such) with this memory-stored database
  // - our TSQLRestStorage database engine is very optimized and is a lot
  // faster than SQLite3 for such queries - but its values remain in RAM,
  // therefore it is not meant to deal with more than 100,000 rows
  // - data can be stored and retrieved from a file (JSON format is used by
  // default, if BinaryFile parameter is left to false; a proprietary compressed
  // binary format can be used instead) if a file name is supplied at creating
  // the TSQLRestStorageInMemory instance
  TSQLRestStorageInMemory = class(TSQLRestStorageRecordBased)
  protected
    fValue: TSQLRecordObjArray;
    fCount: integer;
    fFileName: TFileName;
    fCommitShouldNotUpdateFile: boolean;
    fBinaryFile: boolean;
    fExpandedJSON: boolean;
    fUnSortedID: boolean;
    fSearchRec: TSQLRecord; // temporary record to store the searched value
    fBasicUpperSQLSelect: array[boolean] of RawUTF8;
    fUnique: array of TSQLRestStorageInMemoryUnique;
    fMaxID: TID;
    fValues: TDynArrayHashed; // hashed by ID
    function UniqueFieldsUpdateOK(aRec: TSQLRecord; aUpdateIndex: integer): boolean;
    function GetItem(Index: integer): TSQLRecord; {$ifdef HASINLINE}inline;{$endif}
    function GetID(Index: integer): TID;
    procedure SetFileName(const aFileName: TFileName);
    procedure ComputeStateAfterLoad(var loaded: TPrecisionTimer; binary: boolean);
    procedure SetBinaryFile(aBinary: boolean);
    procedure GetJSONValuesEvent(aDest: pointer; aRec: TSQLRecord; aIndex: integer);
    /// used to create the JSON content from a SELECT parsed command
    // - WhereField index follows FindWhereEqual / TSynTableStatement.WhereField
    // - returns the number of data row added (excluding field names)
    // - this method is very fast and optimized (for search and JSON serializing)
    function GetJSONValues(Stream: TStream; Expand: boolean; Stmt: TSynTableStatement): PtrInt;
    /// TSQLRestServer.URI use it for Static.EngineList to by-pass virtual table
    // - overridden method to handle basic queries as handled by EngineList()
    function AdaptSQLForEngineList(var SQL: RawUTF8): boolean; override;
    /// overridden methods for direct in-memory database engine thread-safe process
    function EngineRetrieve(TableModelIndex: Integer; ID: TID): RawUTF8; override;
    function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawUTF8; override;
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override;
    function EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override;
    function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; override;
    function EngineExecute(const aSQL: RawUTF8): boolean; override;
  public
    /// initialize the table storage data, reading it from a file if necessary
    // - data encoding on file is UTF-8 JSON format by default, or
    // should be some binary format if aBinaryFile is set to true
    constructor Create(aClass: TSQLRecordClass; aServer: TSQLRestServer;
      const aFileName: TFileName = ''; aBinaryFile: boolean=false); reintroduce; virtual;
    /// free used memory
    // - especially release all fValue[] instances
    destructor Destroy; override;
    /// clear all the values of this table
    // - will reset the associated database file, if any
    procedure DropValues(andUpdateFile: boolean=true);
    /// load the values from JSON data
    // - a temporary copy of aJSON is made to ensure it won't be modified in-place
    // - consider using the overlaoded PUTF8Char/len method if you don't need this copy
    procedure LoadFromJSON(const aJSON: RawUTF8); overload;
    /// load the values from JSON data
    procedure LoadFromJSON(JSONBuffer: PUTF8Char; JSONBufferLen: integer); overload;
    /// save the values into JSON data
    function SaveToJSON(Expand: Boolean): RawUTF8; overload;
    /// save the values into JSON data
    procedure SaveToJSON(Stream: TStream; Expand: Boolean); overload;
    /// load the values from binary file/stream
    // - the binary format is a custom compressed format (using our SynLZ fast
    // compression algorithm), with variable-length record storage
    // - the binary content is first checked for consistency, before loading
    // - warning: the field layout should be the same at SaveToBinary call;
    // for instance, it won't be able to read a file content with a renamed
    // or modified field type
    // - will return false if the binary content is invalid
    function LoadFromBinary(Stream: TStream): boolean; overload;
    /// load the values from binary data
    // - uses the same compressed format as the overloaded stream/file method
    // - will return false if the binary content is invalid
    function LoadFromBinary(const Buffer: RawByteString): boolean; overload;
    /// load the values from binary resource
    // - the resource name is expected to be the TSQLRecord class name,
    // with a resource type of 10
    // - uses the same compressed format as the overloaded stream/file method
    // - you can specify a library (dll) resource instance handle, if needed
    procedure LoadFromResource(ResourceName: string=''; Instance: THandle=0);
    /// save the values into a binary file/stream
    // - the binary format is a custom compressed format (using our SynLZ fast
    // compression algorithm), with variable-length record storage: e.g. a 27 KB
    // Dali1.json content is stored into a 6 KB Dali2.data file
    // (this data has a text redundant field content in its FirstName field);
    // 502 KB People.json content is stored into a 92 KB People.data file
    // - returns the number of bytes written into Stream
    function SaveToBinary(Stream: TStream): integer; overload;
    /// save the values into a binary buffer
    // - uses the same compressed format as the overloaded stream/file method
    function SaveToBinary: RawByteString; overload;
    /// if file was modified, the file is updated on disk
    // - this method is called automaticaly when the TSQLRestStorage
    // instance is destroyed: should should want to call in in some cases,
    // in order to force the data to be saved regularly
    // - do nothing if the table content was not modified
    // - will write JSON content by default, or binary content if BinaryFile
    // property was set to true
    procedure UpdateFile;
    /// will reload all content from the current disk file
    // - any not saved modification will be lost (e.g. if Updatefile has not
    // been called since)
    procedure ReloadFromFile;
    /// retrieve the index in Items[] of a particular ID
    // - return -1 if this ID was not found
    // - use internally fast O(1) hashed search algorithm
    // - warning: this method should be protected via StorageLock/StorageUnlock
    function IDToIndex(ID: TID): PtrInt;
    /// retrieve all IDs stored at once
    // - will make a thread-safe copy, for unlocked use
    procedure GetAllIDs(out ID: TIDDynArray);
    /// low-level Add of a TSQLRecord instance
    // - returns the ID created on success
    // - returns -1 on failure (not UNIQUE field value e.g.)
    // - on success, the Rec instance is added to the Values[] list: caller
    // doesn't need to Free it, since it will be owned by the storage
    // - in practice, SentData is used only for OnUpdateEvent/OnBlobUpdateEvent
    // and the history feature
    // - warning: this method should be protected via StorageLock/StorageUnlock
    function AddOne(Rec: TSQLRecord; ForceID: boolean; const SentData: RawUTF8): TID; override;
    /// manual Retrieval of a TSQLRecord field values
    // - an instance of the associated static class is created, and filled with
    // the actual properties values
    // - and all its properties are filled from the Items[] values
    // - caller can modify these properties, then use UpdateOne() if the changes
    // have to be stored inside the Items[] list
    // - calller must always free the returned instance
    // - returns NIL if any error occured, e.g. if the supplied aID was incorrect
    // - method available since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    function GetOne(aID: TID): TSQLRecord; override;
    /// manual Update of a TSQLRecord field values
    // - Rec.ID specifies which record is to be updated
    // - will update all properties, including BLOB fields and such
    // - returns TRUE on success, FALSE on any error (e.g. invalid Rec.ID)
    // - method available since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    function UpdateOne(Rec: TSQLRecord; const SentData: RawUTF8): boolean; override;
    /// manual Update of a TSQLRecord field values from a TSQLVar array
    // - will update all properties, including BLOB fields and such
    // - returns TRUE on success, FALSE on any error (e.g. invalid Rec.ID)
    // - method available since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    function UpdateOne(ID: TID; const Values: TSQLVarDynArray): boolean; override;
    /// direct deletion of a TSQLRecord, from its index in Values[]
    // - warning: this method should be protected via StorageLock/StorageUnlock
    function DeleteOne(aIndex: integer): boolean; virtual;
    /// overridden method for direct in-memory database engine call
    // - made public since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    function EngineDelete(TableModelIndex: integer; ID: TID): boolean; override;
    /// overridden method for direct in-memory database engine call
    // - made public since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    function EngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override;
    /// overridden method for direct in-memory database engine call
    // - made public since a TSQLRestStorage instance may be created
    // stand-alone, i.e. without any associated Model/TSQLRestServer
    function EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; override;
    /// overridden method for direct in-memory database engine call
    function UpdateBlobFields(Value: TSQLRecord): boolean; override;
    /// overridden method for direct in-memory database engine call
    function RetrieveBlobFields(Value: TSQLRecord): boolean; override;
    /// overridden method for direct in-memory database engine call
    function TableRowCount(Table: TSQLRecordClass): Int64; override;
    /// overridden method for direct in-memory database engine call
    function TableHasRows(Table: TSQLRecordClass): boolean; override;
    /// overridden method for direct in-memory database engine call
    function MemberExists(Table: TSQLRecordClass; ID: TID): boolean; override;
    /// search for a field value, according to its SQL content representation
    // - return true on success (i.e. if some values have been added to ResultID)
    // - store the results into the ResultID dynamic array
    // - faster than OneFieldValues method, which creates a temporary JSON content
    function SearchField(const FieldName, FieldValue: RawUTF8;
      out ResultID: TIDDynArray): boolean; override;
    /// search for a field value, according to its SQL content representation
    // - return the found TSQLRecord on success, nil if none did match
    // - warning: it returns a reference to one item of the unlocked internal
    // list, so you should NOT use this on a read/write table, but rather
    // use the slightly slower but safer SearchCopy() method or make explicit
    // ! StorageLock ... try ... SearchInstance ... finally StorageUnlock end
    function SearchInstance(const FieldName, FieldValue: RawUTF8): pointer;
    /// search for a field value, according to its SQL content representation
    // - return the found TSQLRecord index on success, -1 if none did match
    // - warning: it returns a reference to the current index of the unlocked
    // internal list, so you should NOT use without StorageLock/StorageUnlock
    function SearchIndex(const FieldName, FieldValue: RawUTF8): integer;
    /// search for a field value, according to its SQL content representation
    // - return a copy of the found TSQLRecord on success, nil if no match
    // - you should use SearchCopy() instead of SearchInstance(), unless you
    // are sure that the internal TSQLRecord list won't change
    function SearchCopy(const FieldName, FieldValue: RawUTF8): pointer;
    /// search and count for a field value, according to its SQL content representation
    // - return the number of found entries on success, 0 if it was not found
    function SearchCount(const FieldName, FieldValue: RawUTF8): integer;
    /// search for a field value, according to its SQL content representation
    // - call the supplied OnFind event on match
    // - returns the number of found entries
    // - is just a wrapper around FindWhereEqual() with StorageLock protection
    function SearchEvent(const FieldName, FieldValue: RawUTF8;
      OnFind: TFindWhereEqualEvent; Dest: pointer; FoundLimit,FoundOffset: PtrInt): integer;
    /// optimized search of WhereValue in WhereField (0=RowID,1..=RTTI)
    // - will use fast O(1) hash for fUnique[] fields
    // - will use SYSTEMNOCASE case-insensitive search for text values, unless
    // CaseInsensitive is set to FALSE
    // - warning: this method should be protected via StorageLock/StorageUnlock
    function FindWhereEqual(WhereField: integer; const WhereValue: RawUTF8;
      OnFind: TFindWhereEqualEvent; Dest: pointer; FoundLimit,FoundOffset: PtrInt;
      CaseInsensitive: boolean=true): PtrInt; overload;
    /// optimized search of WhereValue in a field, specified by name
    // - will use fast O(1) hash for fUnique[] fields
    // - will use SYSTEMNOCASE case-insensitive search for text values, unless
    // CaseInsensitive is set to FALSE
    // - warning: this method should be protected via StorageLock/StorageUnlock
    function FindWhereEqual(const WhereFieldName, WhereValue: RawUTF8;
      OnFind: TFindWhereEqualEvent; Dest: pointer; FoundLimit,FoundOffset: integer;
      CaseInsensitive: boolean=true): PtrInt; overload;
    /// search the maximum value of a given column
    // - will only handle integer/Int64 kind of column
    function FindMax(WhereField: integer; out max: Int64): boolean;
    /// execute a method on every TSQLRecord item
    // - the loop execution will be protected via StorageLock/StorageUnlock
    procedure ForEach(WillModifyContent: boolean;
      OnEachProcess: TFindWhereEqualEvent; Dest: pointer);
    /// low-level TFindWhereEqualEvent callback doing nothing
    class procedure DoNothingEvent(aDest: pointer; aRec: TSQLRecord; aIndex: integer);
    /// low-level TFindWhereEqualEvent callback setting PPointer(aDest)^ := aRec
    class procedure DoInstanceEvent(aDest: pointer; aRec: TSQLRecord; aIndex: integer);
    /// low-level TFindWhereEqualEvent callback setting PInteger(aDest)^ := aIndex
    class procedure DoIndexEvent(aDest: pointer; aRec: TSQLRecord; aIndex: integer);
    /// low-level TFindWhereEqualEvent callback setting PPointer(aDest)^ := aRec.CreateCopy
    class procedure DoCopyEvent(aDest: pointer; aRec: TSQLRecord; aIndex: integer);
    /// low-level TFindWhereEqualEvent callback calling TSynList(aDest).Add(aRec)
    class procedure DoAddToListEvent(aDest: pointer; aRec: TSQLRecord; aIndex: integer);
    /// read-only access to the TSQLRecord values, storing the data
    // - this returns directly the item class instance stored in memory: if you
    // change the content, it will affect the internal data - so for instance
    // DO NOT change the ID values, unless you may have unexpected behavior
    // - warning: this method should be protected via StorageLock/StorageUnlock
    property Items[Index: integer]: TSQLRecord read GetItem; default;
    /// direct access to the memory of the internal dynamic array storage
    // - Items[] is preferred, since it will check the index, but is slightly
    // slower, e.g. in a loop or after a IDToIndex() call
    // - warning: this method should be protected via StorageLock/StorageUnlock
    property Value: TSQLRecordObjArray read fValue;
    /// read-only access to the ID of a TSQLRecord values
    // - warning: this method should be protected via StorageLock/StorageUnlock
    property ID[Index: integer]: TID read GetID;
  published
    /// read only access to the file name specified by constructor
    // - you can call the TSQLRestServer.StaticDataCreate method to
    // update the file name of an already instanciated static table
    // - if you change manually the file name from this property, the storage
    // will be marked as "modified" so that UpdateFile will save the content
    property FileName: TFileName read fFileName write SetFileName;
    /// if set to true, file content on disk will expect binary format
    // - default format on disk is JSON but can be overridden at constructor call
    // - binary format should be more efficient in term of speed and disk usage,
    // but can be proprietary
    // - if you change manually the file format from this property, the storage
    // will be marked as "modified" so that UpdateFile will save the content
    property BinaryFile: boolean read fBinaryFile write SetBinaryFile;
    // JSON writing, can set if the format should be expanded or not
    // - by default, the JSON will be in the custom non-expanded format,
    // to save disk space and time
    // - you can force the JSON to be emitted as an array of objects,
    // e.g. for better human friendliness (reading and modification)
    property ExpandedJSON: boolean read fExpandedJSON write fExpandedJSON;
    /// set this property to TRUE if you want the COMMIT statement not to
    // update the associated TSQLVirtualTableJSON
    property CommitShouldNotUpdateFile: boolean read fCommitShouldNotUpdateFile
      write fCommitShouldNotUpdateFile;
    /// read-only access to the number of TSQLRecord values
    property Count: integer read fCount;
  end;

  /// a dynamic array of TSQLRestStorageInMemory instances
  // - used e.g. by TSQLRestServerFullMemory
  TSQLRestStorageInMemoryDynArray = array of TSQLRestStorageInMemory;

  /// REST storage with direct access to a memory database, to be used as
  // an external SQLite3 Virtual table
  // - this is the kind of in-memory table expected by TSQLVirtualTableJSON,
  // in order to be consistent with the internal DB cache
  TSQLRestStorageInMemoryExternal = class(TSQLRestStorageInMemory)
  public
    /// initialize the table storage data, reading it from a file if necessary
    // - data encoding on file is UTF-8 JSON format by default, or
    // should be some binary format if aBinaryFile is set to true
    constructor Create(aClass: TSQLRecordClass; aServer: TSQLRestServer;
      const aFileName: TFileName = ''; aBinaryFile: boolean=false); override;
    /// this overridden method will notify the Owner when the internal DB content
    // is known to be invalid
    // - by default, all REST/CRUD requests and direct SQL statements are
    // scanned and identified as potentially able to change the internal SQL/JSON
    // cache used at SQLite3 database level; but TSQLVirtualTableJSON virtual
    // tables could flush the database content without proper notification
    // - this overridden implementation will call Owner.FlushInternalDBCache
    procedure StorageLock(WillModifyContent: boolean; const msg: RawUTF8); override;
  end;

  /// REST storage with redirection to another REST instance
  // - allows redirection of all CRUD operations for a table to another
  // TSQLRest instance, may be a remote TSQLRestClient or a TSQLRestServer
  // - will be used by TSQLRestServer.RemoteDataCreate() method
  TSQLRestStorageRemote = class(TSQLRestStorage)
  protected
    fRemoteRest: TSQLRest;
    fRemoteTableIndex: integer;
    function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override;
    function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawUTF8; override;
    function EngineExecute(const aSQL: RawUTF8): boolean; override;
    function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override;
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override;
    function EngineDelete(TableModelIndex: integer; ID: TID): boolean; override;
    function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; override;
    function EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override;
    function EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; override;
  public
    /// initialize the table storage redirection
    // - you should not have to use this constructor, but rather the
    // TSQLRestServer.RemoteDataCreate() method which will create and register
    // one TSQLRestStorageRemote instance
    constructor Create(aClass: TSQLRecordClass; aServer: TSQLRestServer;
      aRemoteRest: TSQLRest); reintroduce; virtual;
  published
    /// the remote ORM instance used for data persistence
    // - may be a TSQLRestClient or a TSQLRestServer instance
    property RemoteRest: TSQLRest read fRemoteRest;
  end;

  /// defines how TSQLRestStorageShard will handle its partioned process
  TSQLRestStorageShardOption = (ssoNoUpdate, ssoNoUpdateButLastShard,
    ssoNoDelete, ssoNoDeleteButLastShard, ssoNoBatch,
    ssoNoList, ssoNoExecute, ssoNoUpdateField, ssoNoConsolidateAtDestroy);
  /// how TSQLRestStorageShard will handle its partioned process
  TSQLRestStorageShardOptions = set of TSQLRestStorageShardOption;

  /// abstract REST storage with redirection to several REST instances, implementing
  // range ID partitioning for horizontal scaling
  // - such database shards will allow to scale with typical BigData storage
  // - this storage will add items on a server, initializing a new server
  // when the ID reached a defined range
  // - it will maintain a list of previous storages, then redirect reading and
  // updates to the server managing this ID (if possible - older shards may
  // be deleted/ignored to release resources)
  // - inherited class should override InitShards/InitNewShard to customize the
  // kind of TSQLRest instances to be used for each shard (which may be local
  // or remote, a SQLite3 engine or an external SQL/NoSQL database)
  // - see inherited TSQLRestStorageShardDB as defined in mORMotSQLite3.pas
  TSQLRestStorageShard = class(TSQLRestStorage)
  protected
    fShardRange: TID;
    fShardOffset: integer;
    fMaxShardCount: integer;
    fLastID: TID;
    fOptions: TSQLRestStorageShardOptions;
    fShards: array of TSQLRest;
    fShardLast: integer;
    fShardLastID: TID;
    fShardNextID: TID;
    fShardTableIndex: TIntegerDynArray;
    fShardBatch: array of TSQLRestBatch;
    // will set Shards[],fShardLast,fShardLastID,fShardOffset
    procedure InitShards; virtual; abstract;
    // should always return non nil shard to contain new added IDs
    function InitNewShard: TSQLRest; virtual; abstract;
    procedure InternalAddNewShard;
    function InternalShardBatch(ShardIndex: integer): TSQLRestBatch;
    // overriden methods which will handle all ORM process
    function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override;
    function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawUTF8; override;
    function EngineExecute(const aSQL: RawUTF8): boolean; override;
    function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override;
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override;
    function EngineDelete(TableModelIndex: integer; ID: TID): boolean; override;
    function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; override;
    function EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override;
    function EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; override;
    function InternalBatchStart(Method: TSQLURIMethod;
      BatchOptions: TSQLRestBatchOptions): boolean; override;
    procedure InternalBatchStop; override;
  public
    /// initialize the table storage redirection for sharding
    // - you should not have to use this constructor, but e.g.
    // TSQLRestStorageShardDB.Create on a main TSQLRestServer.StaticDataAdd()
    // - the supplied aShardRange should be < 1000 - and once set, you should NOT
    // change this value on an existing shard, unless process will be broken
    constructor Create(aClass: TSQLRecordClass; aServer: TSQLRestServer;
      aShardRange: TID; aOptions: TSQLRestStorageShardOptions;
      aMaxShardCount: integer); reintroduce; virtual;
    /// finalize the table storage, including Shards[] instances
    destructor Destroy; override;
    /// you may call this method sometimes to consolidate the sharded data
    // - may e.g. merge/compact shards, depending on scaling expectations
    // - also called by Destroy - do nothing by default
    procedure ConsolidateShards; virtual;
    /// remove a shard database from the current set
    // - it will allow e.g. to delete a *.dbs file at runtime, without
    // restarting the server
    // - this default implementation will free and nil fShard[aShardIndex],
    // which is enough for most implementations (e.g. TSQLRestStorageShardDB)
    procedure RemoveShard(aShardIndex: integer); virtual;
    /// retrieve the ORM shard instance corresponding to an ID
    // - may return false if the correspondig shard is not available any more
    // - may return true, and a TSQLRestHookClient or a TSQLRestHookServer instance
    // with its associated index in TSQLRest.Model.Tables[]
    // - warning: this method should be protected via StorageLock/StorageUnlock
    function ShardFromID(aID: TID; out aShardTableIndex: integer;
      out aShard: TSQLRest; aOccasion: TSQLOccasion=soSelect;
      aShardIndex: PInteger=nil): boolean; virtual;
    /// get the row count of a specified table
    function TableRowCount(Table: TSQLRecordClass): Int64; override;
    /// check if there is some data rows in a specified table
    function TableHasRows(Table: TSQLRecordClass): boolean; override;
  published
    /// how much IDs should store each ORM shard instance
    // - once set, you should NEVER change this value on an existing shard,
    // otherwise the whole ID partition will fail
    // - each shard will hold [ShardIndex*ShardRange..(ShardIndex+1)*ShardRange-1] IDs
    property ShardRange: TID read fShardRange;
    /// how many shards should be maintained at most
    // - if some older shards are available on disk, they won't be loaded by
    // InitShards, and newly added shard via InitNewShard will trigger
    // RemoveShard if the total number of shards
    property MaxShardCount: integer read fMaxShardCount;
    /// defines how this instance will handle its sharding process
    // - by default, update/delete operations or per ID retrieval will take
    // place on all shards, whereas EngineList and EngineExecute will only run
    // only on the latest shard (to save resources)
    property Options: TSQLRestStorageShardOptions read fOptions write fOptions;
  end;

  /// class metadata of a Sharding storage engine
  TSQLRestStorageShardClass = class of TSQLRestStorageShard;

  /// a REST server using only in-memory tables
  // - this server will use TSQLRestStorageInMemory instances to handle
  // the data in memory, and optionally persist the data on disk as JSON or
  // binary files
  // - so it will not handle all SQL requests, just basic CRUD commands on
  // separated tables
  // - at least, it will compile as a TSQLRestServer without complaining for
  // pure abstract methods; it can be used to host some services if database
  // and ORM needs are basic (e.g. if only authentication and CRUD are needed),
  // without the need to link the SQLite3 engine
  TSQLRestServerFullMemory = class(TSQLRestServer)
  protected
    fFileName: TFileName;
    fBinaryFile: Boolean;
    fStaticDataCount: cardinal;
    fStorage: TSQLRestStorageInMemoryDynArray;
    function GetStorage(aTable: TSQLRecordClass): TSQLRestStorageInMemory;
    /// overridden methods which will call fStorage[TableModelIndex] directly
    function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override;
    function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override;
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override;
    function EngineDelete(TableModelIndex: integer; ID: TID): boolean; override;
    function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; override;
    function EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override;
    function EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; override;
    /// overridden methods which will return error (no main DB here)
    function MainEngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override;
    function MainEngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override;
    function MainEngineList(const SQL: RawUTF8; ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8; override;
    function MainEngineUpdate(TableModelIndex: integer; aID: TID; const SentData: RawUTF8): boolean; override;
    function MainEngineDelete(TableModelIndex: integer; ID: TID): boolean; override;
    function MainEngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; override;
    function MainEngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override;
    function MainEngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override;
    function MainEngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override;
    function MainEngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; override;
    // method not implemented: always return false
    function EngineExecute(const aSQL: RawUTF8): boolean; override;
    constructor RegisteredClassCreateFrom(aModel: TSQLModel;
      aServerHandleAuthentication: boolean; aDefinition: TSynConnectionDefinition); override;
  public
    /// initialize an in-memory REST server with no database file
    constructor Create(aModel: TSQLModel; aHandleUserAuthentication: boolean=false); overload; override;
    /// initialize an in-memory REST server with a database file
    // - all classes of the model will be created as TSQLRestStorageInMemory
    // - then data persistence will be initialized using aFileName, but no
    // file will be written to disk, unless you call explicitly UpdateToFile
    // - if aFileName is left void (''), data will not be persistent
    constructor Create(aModel: TSQLModel; const aFileName: TFileName;
      aBinaryFile: boolean=false; aHandleUserAuthentication: boolean=false); reintroduce; overload; virtual;
    /// initialize an in-memory REST server with a temporary Database Model,
    // and optional authentication by a single user
    // - a Model will be created with supplied tables, and owned by the server
    // - if aUserName is set, authentication will be enabled, and the supplied
    // credentials will be used to authenticate a single user, member of the
    // 'Supervisor' group - in this case, aHashedPassword value should match
    // TSQLAuthUser.PasswordHashHexa expectations
    constructor CreateWithOwnedAuthenticatedModel(
      const Tables: array of TSQLRecordClass; const aUserName, aHashedPassword: RawUTF8;
      aRoot: RawUTF8='root');
    /// finalize the REST server
    // - this overridden destructor will write any modification on file (if
    // needed), and release all used memory
    destructor Destroy; override;
    /// save the TSQLRestFullMemory properties into a persistent storage object
    // - CreateFrom() will expect Definition.ServerName to store the FileName,
    // and use binary storage if Definition.DatabaseName is not void
    procedure DefinitionTo(Definition: TSynConnectionDefinition); override;
    /// Missing tables are created if they don't exist yet for every TSQLRecord
    // class of the Database Model
    // - you must call explicitely this before having called StaticDataCreate()
    // - all table description (even Unique feature) is retrieved from the Model
    // - this method also create additional fields, if the TSQLRecord definition
    // has been modified; only field adding is available, field renaming or
    // field deleting are not allowed in the FrameWork (in such cases, you must
    // create a new TSQLRecord type)
    procedure CreateMissingTables(user_version: cardinal=0;
      Options: TSQLInitializeTableOptions=[]); override;
    /// load the content from the specified file name
    // - do nothing if file name was not assigned
    procedure LoadFromFile; virtual;
    /// load the content from the supplied resource
    procedure LoadFromStream(aStream: TStream); virtual;
    /// write any modification into file
    // - do nothing if file name was not assigned
    procedure UpdateToFile; virtual;
    /// clear all internal storage content
    procedure DropDatabase; virtual;
    /// direct access to the storage instances
    // - you can then access to Storage[Table].Count and Storage[Table].Items[]
    property Storage[aTable: TSQLRecordClass]: TSQLRestStorageInMemory read GetStorage;
    /// direct access to the storage instances
    // - you can then access via Storage[TableIndex].Count and Items[]
    property Storages: TSQLRestStorageInMemoryDynArray read fStorage;
  published
    /// the file name used for data persistence
    property FileName: TFileName read fFileName write fFileName;
    /// set if the file content is to be compressed binary, or standard JSON
    // - it will use TSQLRestStorageInMemory LoadFromJSON/LoadFromBinary
    // SaveToJSON/SaveToBinary methods for optimized storage
    property BinaryFile: Boolean read fBinaryFile write fBinaryFile;
  published
    /// this method-base service will be accessible from ModelRoot/Flush URI,
    // and will write any modification into file
    // - method parameters signature matches TSQLRestServerCallBack type
    // - do nothing if file name was not assigned
    // - can be used from a remote client to ensure that any Add/Update/Delete
    // will be stored to disk, via
    // ! aClient.CallBackPut('Flush','',dummy)
    procedure Flush(Ctxt: TSQLRestServerURIContext);
  end;

  /// a REST server using another TSQLRest instance for all its ORM process
  // - this server will use an internal TSQLRest instance to handle all ORM
  // operations (i.e. access to objects) - e.g. TSQLRestClient for remote access
  // - it can be used e.g. to host some services on a stand-alone server, with
  // all ORM and data access retrieved from another server: it will allow to
  // easily implement a proxy architecture (for instance, as a DMZ for
  // publishing services, but letting ORM process stay out of scope)
  // - for per-table redirection, consider using the TSQLRestStorageRemote class
  // via a call to the TSQLRestServer.RemoteDataCreate() method
  TSQLRestServerRemoteDB = class(TSQLRestServer)
  protected
    fRemoteRest: TSQLRest;
    fRemoteTableIndex: TIntegerDynArray;
    function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override;
    function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawUTF8; override;
    function EngineExecute(const aSQL: RawUTF8): boolean; override;
    function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override;
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override;
    function EngineDelete(TableModelIndex: integer; ID: TID): boolean; override;
    function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; override;
    function EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override;
    function EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID;
      const FieldName: RawUTF8; Increment: Int64): boolean; override;
  public
    /// initialize a REST server associated to a given TSQLRest instance
    // - the specified TSQLRest will be used for all ORM and data process
    // - you could use a TSQLRestClient or a TSQLRestServer instance
    // - the supplied TSQLRest.Model will be used for TSQLRestServerRemoteDB
    // - note that the TSQLRest instance won't be freed - caller shall ensure
    // that it will stay available at least until TSQLRestServerRemoteDB.Free
    constructor Create(aRemoteRest: TSQLRest;
      aHandleUserAuthentication: boolean=false); reintroduce; virtual;
    /// this method is called internally after any successfull deletion to
    // ensure relational database coherency
    // - this overridden method will just return TRUE: in this remote access,
    // true coherency will be performed on the ORM server side
    function AfterDeleteForceCoherency(TableIndex: integer; aID: TID): boolean; override;
  published
    /// the remote ORM instance used for data persistence
    // - may be a TSQLRestClient or a TSQLRestServer instance
    property RemoteRest: TSQLRest read fRemoteRest;
  end;


  /// possible call parameters for TOnTableUpdate Event
  TOnTableUpdateState = (tusPrepare, tusChanged, tusNoChange);

  /// used by TSQLRestClientURI.UpdateFromServer() to let the client
  // perform the rows update (for Marked[] e.g.)
  TOnTableUpdate = procedure(aTable: TSQLTableJSON; State: TOnTableUpdateState) of object;

  /// used by TSQLRestClientURI.Update() to let the client
  // perform the record update (refresh associated report e.g.)
  TOnRecordUpdate = procedure(Value: TSQLRecord) of object;

  /// a generic REpresentational State Transfer (REST) client
  // - is RESTful (i.e. URI) remotely implemented (TSQLRestClientURI e.g.)
  // - is implemented for direct access to a database (TSQLRestClientDB e.g.)
  TSQLRestClient = class(TSQLRest)
  protected
    fForceBlobTransfert: array of boolean;
    fOnTableUpdate: TOnTableUpdate;
    fOnRecordUpdate: TOnRecordUpdate;
    function GetForceBlobTransfert: Boolean;
    procedure SetForceBlobTransfert(Value: boolean);
    function GetForceBlobTransfertTable(aTable: TSQLRecordClass): Boolean;
    procedure SetForceBlobTransfertTable(aTable: TSQLRecordClass; aValue: Boolean);
    /// get a member from its ID
    // - implements REST GET collection
    // - returns the data of this object as JSON
    // - override this method for proper data retrieval from the database engine
    // - this method must be implemented in a thread-safe manner
    function ClientRetrieve(TableModelIndex: integer; ID: TID;
      ForUpdate: boolean; var InternalState: cardinal; var Resp: RawUTF8): boolean; virtual; abstract;
    /// this method is called before updating any record
    // - should return FALSE to force no update
    // - can be use to update some field values just before saving to the database
    // (e.g. for digital signing purpose)
    // - this default method just return TRUE (i.e. OK to update)
    function BeforeUpdateEvent(Value: TSQLRecord): Boolean; virtual;
    /// overridden method which will call ClientRetrieve()
    function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override;
    /// create a new member
    // - implements REST POST collection
    // - URI is 'ModelRoot/TableName' with POST method
    // - if SendData is true, content of Value is sent to the server as JSON
    // - if ForceID is true, client sends the Value.ID field to use this ID
    // - server must return Status 201/HTTP_CREATED on success
    // - server must send on success an header entry with
    // $ Location: ModelRoot/TableName/TableID
    // - on success, returns the new RowID value; on error, returns 0
    // - on success, Value.ID is updated with the new RowID
    // - if aValue is TSQLRecordFTS3, Value.ID is stored to the virtual table
    // - this overridden method will send BLOB fields, if ForceBlobTransfert is set
    function InternalAdd(Value: TSQLRecord; SendData: boolean; CustomFields: PSQLFieldBits;
      ForceID, DoNotAutoComputeFields: boolean): TID; override;
  public
    /// update a member
    // - implements REST PUT collection
    // - URI is 'ModelRoot/TableName/TableID' with PUT method
    // - server must return Status 200/HTTP_SUCCESS OK on success
    // - this overridden method will call BeforeUpdateEvent and also update BLOB
    // fields, if any ForceBlobTransfert is set and CustomFields=[]
    function Update(Value: TSQLRecord; const CustomFields: TSQLFieldBits=[];
      DoNotAutoComputeFields: boolean=false): boolean; override;
    /// get a member from its ID
    // - implements REST GET collection
    // - URI is 'ModelRoot/TableName/TableID' with GET method
    // - server must return Status 200/HTTP_SUCCESS OK on success
    // - if ForUpdate is true, the REST method is LOCK and not GET: it tries to lock
    // the corresponding record, then retrieve its content; caller has to call
    // UnLock() method after Value usage, to release the record
    function Retrieve(aID: TID; Value: TSQLRecord; ForUpdate: boolean=false): boolean; override;
    /// get a member from its ID
    // - implements REST GET collection
    // - URI is 'ModelRoot/TableName/TableID' with GET method
    // - returns true on server returned 200/HTTP_SUCCESS OK success, false on error
    // - set Refreshed to true if the content changed
    function Refresh(aID: TID; Value: TSQLRecord; var Refreshed: boolean): boolean;

    /// retrieve a list of members as a TSQLTable
    // - implements REST GET collection
    // - default SQL statement is 'SELECT ID FROM TableName;' (i.e. retrieve
    // the list of all ID of this collection members)
    // - optional SQLSelect parameter to change the returned fields
    // as in 'SELECT SQLSelect FROM TableName;'
    // - optional SQLWhere parameter to change the search range or ORDER
    // as in 'SELECT SQLSelect FROM TableName WHERE SQLWhere;'
    // - using inlined parameters via :(...): in SQLWhere is always a good idea
    // - for one TClass, you should better use TSQLRest.MultiFieldValues()
    function List(const Tables: array of TSQLRecordClass; const SQLSelect: RawUTF8 = 'RowID';
      const SQLWhere: RawUTF8 = ''): TSQLTableJSON; virtual; abstract;
    /// retrieve a list of members as a TSQLTable
    // - implements REST GET collection
    // - in this version, the WHERE clause can be created with the same format
    // as FormatUTF8() function, replacing all '%' chars with Args[] values
    // - using inlined parameters via :(...): in SQLWhereFormat is always a good idea
    // - for one TClass, you should better use TSQLRest.MultiFieldValues()
    // - will call the List virtual method internaly
    function ListFmt(const Tables: array of TSQLRecordClass;
      const SQLSelect, SQLWhereFormat: RawUTF8; const Args: array of const): TSQLTableJSON; overload;
    /// retrieve a list of members as a TSQLTable
    // - implements REST GET collection
    // - in this version, the WHERE clause can be created with the same format
    // as FormatUTF8() function, replacing all '%' chars with Args[], and all '?'
    // chars with Bounds[] (inlining them with :(...): and auto-quoting strings)
    // - example of use:
    // ! Table := ListFmt([TSQLRecord],'Name','ID=?',[],[aID]);
    // - for one TClass, you should better use TSQLRest.MultiFieldValues()
    // - will call the List virtual method internaly
    function ListFmt(const Tables: array of TSQLRecordClass;
      const SQLSelect, SQLWhereFormat: RawUTF8; const Args, Bounds: array of const): TSQLTableJSON; overload;
    /// begin a transaction (calls REST BEGIN Member)
    // - by default, Client transaction will use here a pseudo session
    // - in aClient-Server environment with multiple Clients connected at the
    // same time, you should better use BATCH process, specifying a positive
    // AutomaticTransactionPerRow parameter to BatchStart()
    function TransactionBegin(aTable: TSQLRecordClass;
  	  SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED): boolean; override;
    /// end a transaction (calls REST END Member)
    // - by default, Client transaction will use here a pseudo session
    procedure Commit(SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED;
      RaiseException: boolean=false); override;
    /// abort a transaction (calls REST ABORT Member)
    // - by default, Client transaction will use here a pseudo session
    procedure RollBack(SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED); override;
    /// access or initialize the internal IoC resolver, used for interface-based
    // remote services, and more generaly any Services.Resolve() call
    // - create and initialize the internal TServiceContainerClient if no
    // service interface has been registered yet
    // - may be used to inject some dependencies, which are not interface-based
    // remote services, but internal IoC, without the ServiceRegister()
    // or ServiceDefine() methods - e.g.
    // ! aRest.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(aRest)],true);
    function ServiceContainer: TServiceContainer; override;

    /// if set to TRUE, all BLOB fields of all tables will be transferred
    // between the Client and the remote Server
    // - i.e. Add() Update() will use Blob-related RESTful PUT/POST request
    // - i.e. Retrieve() will use Blob-related RESTful GET request
    // - note that the Refresh method won't handle BLOB fields, even if this
    // property setting is set to TRUE
    // - by default, this property is set to FALSE, which setting will spare
    // bandwidth and CPU
    // - this property is global to all tables of the model - you can also use
    // ForceBlobTransfertTable[] to force it for a particular table
    property ForceBlobTransfert: boolean read GetForceBlobTransfert write SetForceBlobTransfert;
    /// if set to TRUE for a specified table of the model, all BLOB fields of
    // this tables will be transferred between the Client and the remote Server
    // - i.e. Add() Update() will use BLOB-related RESTful PUT/POST request for
    // this table
    // - i.e. Retrieve() will use BLOB-related RESTful GET request for
    // this table
    // - note that the Refresh method won't handle BLOB fields, even if this
    // property setting is set to TRUE
    // - by default, all items of this property are set to FALSE, which
    // setting will spare bandwidth and CPU
    // - this property is particular to a given tables of the model - you can
    // also use ForceBlobTransfert to force it for a all tables of this model
    property ForceBlobTransfertTable[aTable: TSQLRecordClass]: Boolean
      read GetForceBlobTransfertTable write SetForceBlobTransfertTable;
    /// this Event is called by UpdateFromServer() to let the Client adapt to
    // some rows update (for Marked[] e.g.)
    property OnTableUpdate: TOnTableUpdate read fOnTableUpdate write fOnTableUpdate;
    /// this Event is called by Update() to let the client
    // perform the record update (refresh associated report e.g.)
    property OnRecordUpdate: TOnRecordUpdate read fOnRecordUpdate write fOnRecordUpdate;
  end;

  /// used by TSQLRestClientURI.URI() to let the client ask for an User name
  // and password, in order to retry authentication to the server
  // - should return TRUE if aUserName and aPassword both contain some entered
  // values to be sent for remote secure authentication
  // - should return FALSE if the user pressed cancel or the number of Retry
  // reached a defined limit
  // - here input/output parameters are defined as plain string, to match the
  // type expected by the client's User Interface, via VCL properties, or
  // e.g. from TLoginForm as defined in mORMotUILogin.pas unit
  TOnAuthentificationFailed = function(Retry: integer;
    var aUserName, aPassword: string; out aPasswordHashed: boolean): boolean of object;
  /// called by TSQLRestClientURI.URI() when an error occurred
  // - so that you may have a single entry point for all client-side issues
  // - information will be available in Sender's LastErrorCode and
  // LastErrorMessage properties
  // - if the error comes from an Exception, it will be supplied as parameter
  // - the REST context (if any) will be supplied within the Call parameter,
  // and in this case Call^.OutStatus=HTTP_NOTIMPLEMENTED indicates a broken
  // connection
  TOnClientFailed = procedure(Sender: TSQLRestClientURI; E: Exception;
    Call: PSQLRestURIParams) of object;

  /// store information about registered interface callbacks
  TSQLRestClientCallbackItem = record
    /// the identifier of the callback, as sent to the server side
    // - computed from TSQLRestClientURICallbacks.fCurrentID counter
    ID: integer;
    /// weak pointer typecast to the associated IInvokable variable
    Instance: pointer;
    //// information about the associated IInvokable
    Factory: TInterfaceFactory;
    /// set to TRUE if the instance was released from the server
    ReleasedFromServer: boolean;
  end;
  /// points to information about registered interface callbacks
  PSQLRestClientCallbackItem = ^TSQLRestClientCallbackItem;

  /// store the references to active interface callbacks on a REST Client
  TSQLRestClientCallbacks = class(TSynPersistentLock)
  protected
    fCurrentID: integer;
    function UnRegisterByIndex(index: integer): boolean;
  public
    /// the associated REST instance
    Owner: TSQLRestClientURI;
    /// how many callbacks are registered
    Count: integer;
    /// list of registered interface callbacks
    List: array of TSQLRestClientCallbackItem;
    /// initialize the storage list
    constructor Create(aOwner: TSQLRestClientURI); reintroduce;
    /// register a callback event interface instance from a new computed ID
    function DoRegister(aInstance: pointer; aFactory: TInterfaceFactory): integer; overload;
    /// register a callback event interface instance from its supplied ID
    procedure DoRegister(aID: Integer; aInstance: pointer; aFactory: TInterfaceFactory); overload;
    /// delete all callback events from the internal list, as specified by its instance
    // - note that the same IInvokable instance may be registered for several IDs
    function UnRegister(aInstance: pointer): boolean; overload;
    /// find the index of the ID in the internal list
    // - warning: this method should be called within Safe.Lock/Safe.Unlock
    function FindIndex(aID: integer): integer;
    /// find a matching callback
    // - will call FindIndex(aItem.ID) within Safe.Lock/Safe.Unlock
    // - returns TRUE if aItem.ID was found and aItem filled, FALSE otherwise
    function FindEntry(var aItem: TSQLRestClientCallbackItem): boolean;
    /// find a matching entry
    // - will call FindIndex(aID) within Safe.Lock/Safe.Unlock
    // - returns TRUE if aID was found and aInstance/aFactory set, FALSE otherwise
    function FindAndRelease(aID: integer): boolean;
  end;

  /// signature e.g. of the TSQLRestClientURI.OnSetUser event handler
  TOnRestClientNotify = procedure(Sender: TSQLRestClientURI) of object;

  /// a generic REpresentational State Transfer (REST) client with URI
  // - URI are standard Collection/Member implemented as ModelRoot/TableName/TableID
  // - handle RESTful commands GET POST PUT DELETE LOCK UNLOCK
  TSQLRestClientURI = class(TSQLRestClient)
  protected
    fComputeSignature: TSQLRestServerAuthenticationSignedURIComputeSignature;
    fOnAuthentificationFailed: TOnAuthentificationFailed;
    fOnSetUser: TOnRestClientNotify;
    fMaximumAuthentificationRetry: Integer;
    fRetryOnceOnTimeout: boolean;
    fLastErrorCode: integer;
    fLastErrorMessage: RawUTF8;
    fLastErrorException: ExceptClass;
    fBatchCurrent: TSQLRestBatch;
    /// private values created by sucessfull SetUser() method
    fSessionUser: TSQLAuthUser;
    fSessionID: cardinal;
    fSessionIDHexa8: RawUTF8;
    fSessionPrivateKey: cardinal;
    fSessionLastTick64: Int64;
    fSessionAuthentication: TSQLRestServerAuthenticationClass;
    fSessionHttpHeader: RawUTF8; // e.g. for TSQLRestServerAuthenticationHttpBasic
    fSessionServer: RawUTF8;
    fSessionVersion: RawUTF8;
    fSessionData: RawByteString;
    fSessionServerTimeout: integer;
    fSessionHeartbeatSeconds: integer;
    /// used to make the internal client-side process reintrant
    fSafe: IAutoLocker;
    fRemoteLogClass: TSynLog;
    fRemoteLogOwnedByFamily: boolean;
    fServicePublishOwnInterfaces: RawUTF8;
    {$ifdef MSWINDOWS}
    fServiceNotificationMethodViaMessages: record
      Wnd: HWND;
      Msg: UINT;
    end;
    {$endif}
    {$ifndef LVCL} // SyncObjs.TEvent not available in LVCL yet
    fBackgroundThread: TSynBackgroundThreadEvent;
    fOnIdle: TOnIdleSynBackgroundThread;
    fOnFailed: TOnClientFailed;
    fInternalState: set of (isOpened, isDestroying, isInAuth);
    fRemoteLogThread: TObject; // private TRemoteLogThread
    fFakeCallbacks: TSQLRestClientCallbacks;
    function FakeCallbackRegister(Sender: TServiceFactoryClient;
      const Method: TServiceMethod; const ParamInfo: TServiceMethodArgument;
      ParamValue: Pointer): integer; virtual;
    function FakeCallbackUnregister(Factory: TInterfaceFactory;
      FakeCallbackID: integer; Instance: pointer): boolean; virtual;
    procedure OnBackgroundProcess(Sender: TSynBackgroundThreadEvent;
      ProcessOpaqueParam: pointer);
    function GetOnIdleBackgroundThreadActive: boolean;
    {$endif}
    constructor RegisteredClassCreateFrom(aModel: TSQLModel;
      aDefinition: TSynConnectionDefinition); override;
    function GetCurrentSessionUserID: TID; override;
    procedure SetSessionHeartbeatSeconds(timeout: integer);
    function InternalRemoteLogSend(const aText: RawUTF8): boolean;
    procedure InternalNotificationMethodExecute(var Ctxt: TSQLRestURIParams); virtual;
    procedure SetLastException(E: Exception=nil; ErrorCode: integer=HTTP_BADREQUEST;
      Call: PSQLRestURIParams=nil);
    /// will call timestamp/info if the session has currently not been retrieved
    function GetSessionVersion: RawUTF8;
    // register the user session to the TSQLRestClientURI instance
    function SessionCreate(aAuth: TSQLRestServerAuthenticationClass;
      var aUser: TSQLAuthUser; const aSessionKey: RawUTF8): boolean;
    procedure SessionRenewEvent(Sender: TSynBackgroundTimer; Event: TWaitResult;
      const Msg: RawUTF8);
    /// abstract method to be implemented with a local, piped or HTTP/1.1 provider
    // - you can specify some POST/PUT data in Call.OutBody (leave '' otherwise)
    // - return the execution result in Call.OutStatus
    // - for clients, RestAccessRights is never used
    procedure InternalURI(var Call: TSQLRestURIParams); virtual; abstract;
    /// overridden protected method shall check if not connected to reopen it
    // - shall return TRUE on success, FALSE on any connection error
    function InternalCheckOpen: boolean; virtual; abstract;
    /// overridden protected method shall force the connection to be closed,
    // - a next call to InternalCheckOpen method shall re-open the connection
    procedure InternalClose; virtual; abstract;
    /// calls 'ModelRoot/TableName/TableID' with appropriate REST method
    // - uses GET method if ForUpdate is false
    // - uses LOCK method if ForUpdate is true
    function URIGet(Table: TSQLRecordClass; ID: TID; var Resp: RawUTF8;
      ForUpdate: boolean=false): Int64Rec;
    // overridden methods
    function ClientRetrieve(TableModelIndex: integer; ID: TID; ForUpdate: boolean;
      var InternalState: cardinal; var Resp: RawUTF8): boolean; override;
    function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawUTF8; override;
    function EngineExecute(const SQL: RawUTF8): boolean; override;
    function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override;
    function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override;
    function EngineDelete(TableModelIndex: integer; ID: TID): boolean; override;
    function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8;
      const IDs: TIDDynArray): boolean; override;
    function EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateBlob(TableModelIndex: integer; aID: TID;
      BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override;
    function EngineUpdateField(TableModelIndex: integer;
      const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override;
    function EngineBatchSend(Table: TSQLRecordClass; var Data: RawUTF8;
       var Results: TIDDynArray; ExpectedResultsCount: integer): integer; override;
  public
    /// initialize REST client instance
    constructor Create(aModel: TSQLModel); override;
    /// release memory and close client connection
    // - also unlock all still locked records by this client
    destructor Destroy; override;
    /// authenticate an User to the current connected Server
    // - will call the ModelRoot/Auth service, i.e. call TSQLRestServer.Auth()
    // published method to create a session for this user, with our secure
    // TSQLRestServerAuthenticationDefault authentication scheme
    // - returns true on success
    // - calling this method is optional, depending on your user right policy:
    // your Server need to handle authentication
    // - if saoUserByLogonOrID is defined in the server Options, aUserName may
    // be a TSQLAuthUser.ID integer value and not a TSQLAuthUser.LogonName
    // - on success, the SessionUser property map the logged user session on the
    // server side
    // - if aHashedPassword is TRUE, the aPassword parameter is expected to
    // contain the already-hashed value, just as stored in PasswordHashHexa
    // (i.e. SHA256('salt'+Value) as in TSQLAuthUser.SetPasswordPlain method)
    // - if SSPIAUTH conditional is defined, and aUserName='', a Windows
    // authentication will be performed via TSQLRestServerAuthenticationSSPI -
    // in this case, aPassword will contain the SPN domain for Kerberos
    // (otherwise NTLM will be used), and table TSQLAuthUser shall contain
    // an entry for the logged Windows user, with the LoginName in form
    // 'DomainName\UserName'
    // - you can directly create the class method ClientSetUser() of a given
    // TSQLRestServerAuthentication inherited class, if neither
    // TSQLRestServerAuthenticationDefault nor TSQLRestServerAuthenticationSSPI
    // match your need
    function SetUser(const aUserName, aPassword: RawUTF8;
      aHashedPassword: Boolean=false): boolean;
    /// customize the session_signature signing algorithm with a specific function
    // - will be used by TSQLRestServerAuthenticationSignedURI classes,
    // e.g. TSQLRestServerAuthenticationDefault instead of the algorithm
    // specified by the server at session handshake
    property ComputeSignature: TSQLRestServerAuthenticationSignedURIComputeSignature
      read fComputeSignature write fComputeSignature;
    /// save the TSQLRestClientURI properties into a persistent storage object
    // - CreateFrom() will expect Definition.UserName/Password to store the
    // credentials which will be used by SetUser()
    procedure DefinitionTo(Definition: TSynConnectionDefinition); override;
    /// clear session and call the /auth service on the server to notify shutdown
    // - is called by Destroy and SetUser/ClientSetUser methods, so you should
    // not have usually to call this method directly
    procedure SessionClose;
    /// method calling the remote Server via a RESTful command
    // - calls the InternalURI abstract method, which should be overridden with a
    // local, piped or HTTP/1.1 provider
    // - this method will add sign the url with the appropriate digital signature
    // according to the current SessionUser property
    // - this method will retry the connection in case of authentication failure
    // (i.e. if the session was closed by the remote server, for any reason -
    // mostly a time out) if the OnAuthentificationFailed event handler is set
    function URI(const url, method: RawUTF8; Resp: PRawUTF8=nil;
      Head: PRawUTF8=nil; SendData: PRawUTF8=nil): Int64Rec;
    /// retrieve a list of members as a TSQLTable
    // - implements REST GET collection
    // - URI is 'ModelRoot/TableName' with GET method
    // - SQLSelect and SQLWhere are encoded as 'select=' and 'where=' URL parameters
    // (using inlined parameters via :(...): in SQLWhere is always a good idea)
    // - server must return Status 200/HTTP_SUCCESS OK on success
    function List(const Tables: array of TSQLRecordClass; const SQLSelect: RawUTF8 = 'RowID';
      const SQLWhere: RawUTF8 = ''): TSQLTableJSON; override;
    /// unlock the corresponding record
    // - URI is 'ModelRoot/TableName/TableID' with UNLOCK method
    // - returns true on success
    function UnLock(Table: TSQLRecordClass; aID: TID): boolean; override;
    /// Execute directly a SQL statement, expecting a list of resutls
    // - URI is 'ModelRoot' with GET method, and SQL statement sent as UTF-8
    // - return a result table on success, nil on failure
    function ExecuteList(const Tables: array of TSQLRecordClass;
      const SQL: RawUTF8): TSQLTableJSON; override;
    /// ask the server for its current internal state revision counter
    // - this counter is incremented every time the database is modified
    // - the returned value is 0 if the database doesn't support this feature
    // - TSQLTable does compare this value with its internal one to check if
    // its content must be updated
    function ServerInternalState: cardinal;
    /// check if the data may have changed of the server for this objects, and
    // update it if possible
    // - only working types are TSQLTableJSON and TSQLRecord descendants
    // - make use of the InternalState function to check the data content revision
    // - return true if Data is updated successfully, or false on any error
    // during data retrieval from server (e.g. if the TSQLRecord has been deleted)
    // - if Data contains only one TSQLTableJSON, PCurrentRow can point to the
    // current selected row of this table, in order to refresh its value
    // - use this method to refresh the client UI, e.g. via a timer
    function UpdateFromServer(const Data: array of TObject; out Refreshed: boolean;
      PCurrentRow: PInteger=nil): boolean; virtual;
    /// send a flush command to the remote Server cache
    // - this method will remotely call the Cache.Flush() methods of the server
    // instance, to force cohesion of the data
    // - ServerCacheFlush() with no parameter will flush all stored JSON content
    // - ServerCacheFlush(aTable) will flush the cache for a given table
    // - ServerCacheFlush(aTable,aID) will flush the cache for a given record
    function ServerCacheFlush(aTable: TSQLRecordClass=nil; aID: TID=0): boolean; virtual;
    /// you can call this method to call the remote URI root/Timestamp
    // - this can be an handy way of testing the connection, since this method
    // is always available, even without authentication
    // - returns TRUE if the client time correction has been retrieved
    // - returns FALSE on any connection error - check LastErrorMessage and
    // LastErrorException to find out the exact connection error
    function ServerTimestampSynchronize: boolean;
    /// asynchronous call a 'RemoteLog' remote logging method on the server
    // - as implemented by mORMot's LogView tool in server mode
    // - to be used via ServerRemoteLogStart/ServerRemoteLogStop methods
    // - a dedicated background thread will run the transmission process without
    // blocking the main program execution, gathering log rows in chunks in case
    // of high activity
    // - map TOnTextWriterEcho signature, so that you will be able to set e.g.:
    // ! TSQLLog.Family.EchoCustom := aClient.ServerRemoteLog;
    function ServerRemoteLog(Sender: TTextWriter; Level: TSynLogInfo;
      const Text: RawUTF8): boolean; overload; virtual;
    /// internal method able to emulate a call to TSynLog.Add.Log()
    // - will compute timestamp and event text, than call the overloaded
    // ServerRemoteLog() method
    function ServerRemoteLog(Level: TSynLogInfo; FormatMsg: PUTF8Char;
      const Args: array of const): boolean; overload;
    /// start to send all logs to the server 'RemoteLog' method-based service
    // - will associate the EchoCustom callback of the running log class to the
    // ServerRemoteLog() method
    // - if aClientOwnedByFamily is TRUE, this TSQLRestClientURI instance
    // lifetime will be managed by TSynLogFamily - which is mostly wished
    // - if aClientOwnedByFamily is FALSE, you should manage this instance
    // life time, and may call ServerRemoteLogStop to stop remote logging
    // - warning: current implementation will disable all logging for this
    // TSQLRestClientURI instance, to avoid any potential concern (e.g. for
    // multi-threaded process, or in case of communication error): you should
    // therefore use this TSQLRestClientURI connection only for the remote log
    // server, e.g. via TSQLHttpClientGeneric.CreateForRemoteLogging() - do
    // not call ServerRemoteLogStart() from a high-level business client!
    procedure ServerRemoteLogStart(aLogClass: TSynLogClass;
      aClientOwnedByFamily: boolean);
    /// stop sending all logs to the server 'RemoteLog' method-based service
    // - do nothing if aClientOwnedByFamily was TRUE for ServerRemoteLogStart
    procedure ServerRemoteLogStop;

    /// begin a transaction
    // - implements REST BEGIN collection
    // - in aClient-Server environment with multiple Clients connected at the
    // same time, you should better use BATCH process, specifying a positive
    // AutomaticTransactionPerRow parameter to BatchStart()
    // - may be used to speed up some SQL statements as Add/Update/Delete methods
    // - must be ended with Commit on success
    // - in the current implementation, the aTable parameter is not used yet
    // - must be aborted with Rollback if any SQL statement failed
    // - return true if no transaction is active, false otherwise
    // !if Client.TransactionBegin(TSQLRecordPeopleObject) then
    // !try
    // !  // .... modify the database content, raise exceptions on error
    // !  Client.Commit;
    // !except
    // !  Client.RollBack; //  in case of error
    // !end;
    // - you may use the dedicated TransactionBeginRetry() method in case of
    // potential Client concurrent access
    function TransactionBegin(aTable: TSQLRecordClass; SessionID: cardinal=1): boolean; override;
    /// begin a transaction
    // - implements REST BEGIN collection
    // - in aClient-Server environment with multiple Clients connected at the
    // same time, you should better use BATCH process, specifying a positive
    // AutomaticTransactionPerRow parameter to BatchStart()
    // - this version retries a TranslationBegin() to be successfull within
    // a supplied number of times
    // - will retry every 100 ms for "Retries" times (excluding the connection
    // time in this 100 ms time period
    // - default is to retry 10 times, i.e. within 2 second timeout
    // - in the current implementation, the aTable parameter is not used yet
    // - typical usage should be for instance:
    // !if Client.TransactionBeginRetry(TSQLRecordPeopleObject,20) then
    // !try
    // !  // .... modify the database content, raise exceptions on error
    // !  Client.Commit;
    // !except
    // !  Client.RollBack; //  in case of error
    // !end;
    function TransactionBeginRetry(aTable: TSQLRecordClass; Retries: integer=10): boolean;
    /// end a transaction
    // - implements REST END collection
    // - write all pending SQL statements to the disk }
    procedure Commit(SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED;
      RaiseException: boolean=false); override;
    /// abort a transaction
    // - implements REST ABORT collection
    // - restore the previous state of the database, before the call to TransactionBegin }
    procedure RollBack(SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED); override;

    /// begin a BATCH sequence to speed up huge database change for a given table
    // - is a wrapper around TSQLRestBatch.Create() which will be stored in this
    // TSQLRestClientURI instance - be aware that this won't be thread-safe
    // - if you need a thread-safe "Unit Of Work" process, please use a private
    // TSQLRestBatch instance and the overloaded TSQLRest.BatchSend() method
    // - call BatchStartAny() or set the aTable parameter to nil if you want to
    // use any kind of TSQLRecord objects within the process, not a single one
    function BatchStart(aTable: TSQLRecordClass;
      AutomaticTransactionPerRow: cardinal=0; Options: TSQLRestBatchOptions=[]): boolean; virtual;
    /// begin a BATCH sequence to speed up huge database change for any table
    // - will call the BatchStart() method with aTable = nil so that you may be
    // able to use any kind of TSQLRecord class within the process
    // - is a wrapper around TSQLRestBatch.Create() which will be stored in this
    // TSQLRestClientURI instance - be aware that this won't be thread-safe
    function BatchStartAny(AutomaticTransactionPerRow: cardinal;
      Options: TSQLRestBatchOptions=[]): boolean;
    /// create a new member in current BATCH sequence
    // - is a wrapper around TSQLRestBatch.Add() which will be stored in this
    // TSQLRestClientURI instance - be aware that this won't be thread safe
    function BatchAdd(Value: TSQLRecord; SendData: boolean; ForceID: boolean=false;
      const CustomFields: TSQLFieldBits=[]): integer;
    /// update a member in current BATCH sequence
    // - is a wrapper around TSQLRestBatch.Update() which will be stored in this
    // TSQLRestClientURI instance - be aware that this won't be thread safe
    // - this method will call BeforeUpdateEvent before TSQLRestBatch.Update
    function BatchUpdate(Value: TSQLRecord; const CustomFields: TSQLFieldBits=[];
      DoNotAutoComputeFields: boolean=false): integer;
    /// delete a member in current BATCH sequence
    // - is a wrapper around TSQLRestBatch.Delete() which will be stored in this
    // TSQLRestClientURI instance - be aware that this won't be thread safe
    function BatchDelete(ID: TID): integer; overload;
    /// delete a member in current BATCH sequence
    // - is a wrapper around TSQLRestBatch.Delete() which will be stored in this
    // TSQLRestClientURI instance - be aware that this won't be thread safe
    function BatchDelete(Table: TSQLRecordClass; ID: TID): integer; overload;
    /// retrieve the current number of pending transactions in the BATCH sequence
    // - every call to BatchAdd/Update/Delete methods increases this count
    function BatchCount: integer;
    /// execute a BATCH sequence started by BatchStart method
    // - send all pending BatchAdd/Update/Delete statements to the remote server
    // - URI is 'ModelRoot/TableName/0' with POST (or PUT) method
    // - will return the URI Status value, i.e. 200/HTTP_SUCCESS OK on success
    // - a dynamic array of integers will be created in Results,
    // containing all ROWDID created for each BatchAdd call, 200 (=HTTP_SUCCESS)
    // for all successfull BatchUpdate/BatchDelete, or 0 on error
    // - any error during server-side process MUST be checked against Results[]
    // (the main URI Status is 200 if about communication success, and won't
    // imply that all statements in the BATCH sequence were successfull
    function BatchSend(var Results: TIDDynArray): integer; overload;
    /// abort a BATCH sequence started by BatchStart method
    // - in short, nothing is sent to the remote server, and current BATCH
    // sequence is closed
    // - will Free the TSQLRestBatch stored in this TSQLRestClientURI instance
    procedure BatchAbort;

    /// wrapper to the protected URI method to call a method on the server, using
    // a ModelRoot/[TableName/[ID/]]MethodName RESTful GET request
    // - returns the HTTP error code (e.g. 200/HTTP_SUCCESS on success)
    // - this version will use a GET with supplied parameters (which will be encoded
    // with the URL)
    function CallBackGet(const aMethodName: RawUTF8;
      const aNameValueParameters: array of const;
      out aResponse: RawUTF8; aTable: TSQLRecordClass=nil; aID: TID=0;
      aResponseHead: PRawUTF8=nil): integer;
    /// wrapper to the protected URI method to call a method on the server, using
    // a ModelRoot/[TableName/[ID/]]MethodName RESTful GET request
    // - returns the UTF-8 decoded JSON result (server must reply with one
    // "result":"value" JSON object)
    // - this version will use a GET with supplied parameters (which will be encoded
    // with the URL)
    function CallBackGetResult(const aMethodName: RawUTF8;
      const aNameValueParameters: array of const;
      aTable: TSQLRecordClass=nil; aID: TID=0): RawUTF8;
    /// wrapper to the protected URI method to call a method on the server, using
    //  a ModelRoot/[TableName/[ID/]]MethodName RESTful PUT request
    // - returns the HTTP error code (e.g. 200/HTTP_SUCCESS on success)
    // - this version will use a PUT with the supplied raw UTF-8 data
    function CallBackPut(const aMethodName, aSentData: RawUTF8;
      out aResponse: RawUTF8; aTable: TSQLRecordClass=nil; aID: TID=0;
      aResponseHead: PRawUTF8=nil): integer;
    /// wrapper to the protected URI method to call a method on the server, using
    //  a ModelRoot/[TableName/[ID/]]MethodName RESTful with any kind of request
    // - returns the HTTP error code (e.g. 200/HTTP_SUCCESS on success)
    // - for GET/PUT methods, you should better use CallBackGet/CallBackPut
    function CallBack(method: TSQLURIMethod; const aMethodName,aSentData: RawUTF8;
      out aResponse: RawUTF8; aTable: TSQLRecordClass=nil; aID: TID=0;
      aResponseHead: PRawUTF8=nil): integer;
    /// to be called before CallBack() if the client could ignore the answer
    // - do nothing by default, but overriden e.g. in TSQLHttpClientWebsockets
    procedure CallbackNonBlockingSetHeader(out Header: RawUTF8); virtual;
    /// register one or several Services on the client side via their interfaces
    // - this methods expects a list of interfaces to be registered to the client
    // (e.g. [TypeInfo(IMyInterface)])
    // - instance implementation pattern will be set by the appropriate parameter
    // - will return true on success, false if registration failed (e.g. if any of
    // the supplied interfaces is not correct or is not available on the server)
    // - that is, server side will be called to check for the availability of
    // each interface
    // - you can specify an optional custom contract for the first interface
    function ServiceRegister(const aInterfaces: array of PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''): boolean; overload; virtual;
    /// register a Service on the client side via its interface
    // - this methods expects one interface to be registered to the client, as
    // ! Client.ServiceRegister(TypeInfo(IMyInterface),sicShared);
    // - instance implementation pattern will be set by the appropriate parameter
    // - will return the corresponding fake class factory on success, nil if
    // registration failed (e.g. if any of supplied interfaces is not correct or
    // is not available on the server)
    // - that is, server side will be called to check for the availability of
    // each interface
    // - you can specify an optional custom contract for the first interface
    function ServiceRegister(aInterface: PTypeInfo;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''; aIgnoreAnyException: boolean=true): TServiceFactory; overload;
    /// register and retrieve the sicClientDriven Service instance
    // - will return TRUE on success, filling Obj output variable with the
    // corresponding interface instance
    // - will return FALSE on error
    function ServiceRegisterClientDriven(aInterface: PTypeInfo; out Obj;
      const aContractExpected: RawUTF8=''): boolean; overload;
    /// register one or several Services on the client side via their interfaces
    // - this method expects the interface(s) to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    function ServiceDefine(const aInterfaces: array of TGUID;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''): boolean; overload;
    /// register a Service on the client side via its interface
    // - this method expects the interface to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    function ServiceDefine(const aInterface: TGUID;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''; aIgnoreAnyException: boolean=true): TServiceFactoryClient; overload;
    /// register and retrieve the sicClientDriven Service instance
    // - this method expects the interface to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    function ServiceDefineClientDriven(const aInterface: TGUID; out Obj;
      const aContractExpected: RawUTF8=''): boolean;
    /// register a sicShared Service instance communicating via JSON objects
    // - will force SERVICE_CONTRACT_NONE_EXPECTED, ParamsAsJSONObject=true and
    // ResultAsJSONObjectWithoutResult=true
    // - may be used e.g. for accessing a sessionless public REST/JSON API, i.e.
    // ! TSQLRestServer.ServiceDefine(...).ResultAsJSONObjectWithoutResult := true
    // - this method expects the interface to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    // - aIgnoreAnyException may be set to TRUE if the server is likely
    // to not propose this service, and any exception is to be catched
    function ServiceDefineSharedAPI(const aInterface: TGUID;
      const aContractExpected: RawUTF8=SERVICE_CONTRACT_NONE_EXPECTED;
      aIgnoreAnyException: boolean=false): TServiceFactoryClient;
    /// allow to notify a server the services this client may be actually capable
    // - when this client will connect to a remote server to access its services,
    // it will register its own services, supplying its TSQLRestServer instance,
    // and its corresponding public URI, within its '_contract_' internal call
    // - it will allow automatic service discovery of Peer To Peer Servers,
    // without the need of an actual centralized SOA catalog service: any
    // client could retrieve an associated REST server for a given service,
    // via the ServiceRetrieveAssociated method
    procedure ServicePublishOwnInterfaces(OwnServer: TSQLRestServer);
    /// return all REST server URI associated to this client, for a given
    // service name, the latest registered in first position
    // - will lookup for the Interface name without the initial 'I', e.g.
    // 'Calculator' for ICalculator - warning: research is case-sensitive
    // - this methods is the reverse from ServicePublishOwnInterfaces: it allows
    // to guess an associated REST server which may implement a given service
    function ServiceRetrieveAssociated(const aServiceName: RawUTF8;
      out URI: TSQLRestServerURIDynArray): boolean; overload;
    /// return all REST server URI associated to this client, for a given service
    // - here the service is specified as its TGUID, e.g. IMyInterface
    // - this method expects the interface to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    // - the URI[] output array contains the matching server URIs, the latest
    // registered in first position
    // - this methods is the reverse from ServicePublishOwnInterfaces: it allows
    // to guess an associated REST server which may implement a given service
    function ServiceRetrieveAssociated(const aInterface: TGUID;
      out URI: TSQLRestServerURIDynArray): boolean; overload;
    {$ifdef MSWINDOWS}
    /// set a HWND/WM_* pair to let interface-based services notification
    // callbacks be processed safely in the main UI thread, via Windows messages
    // - by default callbacks are executed in the transmission thread, e.g.
    // the WebSockets client thread: using VCL Synchronize() method may
    // trigger some unexpected race conditions, e.g. when asynchronous
    // notifications are received during a blocking REST command - this
    // message-based mechanism will allow safe and easy notification for
    // any VCL client application
    // - the associated ServiceNotificationMethodExecute() method shall be
    // called in the client HWND TForm for the defined WM_* message
    procedure ServiceNotificationMethodViaMessages(hWnd: HWND; Msg: UINT);
    /// event to be triggered when a WM_* message is received from
    // the internal asynchronous notification system, to run the callback
    // in the main UI thread
    // - WM_* message identifier should have been set e.g. via the associated
    // ServiceNotificationMethodViaMessages(Form.Handle,WM_USER)
    // - message will be sent for any interface-based service method callback
    // which expects no result (i.e. no out parameter nor function result),
    // so is safely handled as asynchronous notification
    // - is defines as a class procedure, since the underlying TSQLRestClientURI
    // instance has no impact here: a single WM_* handler is enough for
    // several TSQLRestClientURI instances
    class procedure ServiceNotificationMethodExecute(var Msg : TMessage);
    {$endif MSWINDOWS}
  published
    /// low-level error code, as returned by server
    // - check this value about HTTP_* constants
    // - HTTP_SUCCESS or HTTP_CREATED mean no error
    // - otherwise, check LastErrorMessage property for additional information
    // - this property value will record status codes returned by URI() method
    property LastErrorCode: integer read fLastErrorCode;
    /// low-level error message, as returned by server
    // - this property value will record content returned by URI() method in
    // case of an error, or '' if LastErrorCode is HTTP_SUCCESS or HTTP_CREATED
    property LastErrorMessage: RawUTF8 read fLastErrorMessage;
    /// low-level exception class, if any
    // - will record any Exception class raised within URI() method
    // - contains nil if URI() execution did not raise any exception (which
    // is the most expected behavior, since server-side errors are trapped
    // into LastErrorCode/LastErrorMessage properties
    property LastErrorException: ExceptClass read fLastErrorException;

    /// maximum additional retry occurence
    // - defaut is 1, i.e. will retry once
    // - set OnAuthentificationFailed to nil in order to avoid any retry
    property MaximumAuthentificationRetry: Integer
      read fMaximumAuthentificationRetry write fMaximumAuthentificationRetry;
    /// if the client shall retry once in case of "408 REQUEST TIMEOUT" error
    property RetryOnceOnTimeout: Boolean
      read fRetryOnceOnTimeout write fRetryOnceOnTimeout;
    /// the current session ID as set after a successfull SetUser() method call
    // - equals 0 (CONST_AUTHENTICATION_SESSION_NOT_STARTED) if the session
    // is not started yet - i.e. if SetUser() call failed
    // - equals 1 (CONST_AUTHENTICATION_NOT_USED) if authentication mode
    // is not enabled - i.e. after a fresh Create() without SetUser() call
    property SessionID: cardinal read fSessionID;
    /// the remote server executable name, as retrieved after a SetUser() success
    property SessionServer: RawUTF8 read fSessionServer;
    /// the remote server version, as retrieved after a SetUser() success
    property SessionVersion: RawUTF8 read fSessionVersion;
    /// the remote server session tiemout in minutes, as retrieved after
    // a SetUser() success
    // - will be used to set SessionHeartbeatSeconds default
    property SessionServerTimeout: integer read fSessionServerTimeout;
    /// frequency of Callback/_ping_ calls to maintain session and services
    // - will be used to call SessionRenewEvent at the specified period, so that
    // the session and all sicClientDriven instances will be maintained on the
    // server side as long as the client connection stands
    // - equals half SessionServerTimeout or 25 minutes (if lower) by default -
    // 25 minutes matches the default service timeout of 30 minutes
    // - you may set 0 to disable this SOA-level heartbeat feature
    property SessionHeartbeatSeconds: integer read fSessionHeartbeatSeconds
      write SetSessionHeartbeatSeconds;
  public
    /// the current user as set by SetUser() method
    // - contans nil if no User is currently authenticated
    // - once authenticated, a TSQLAuthUser instance is set, with its ID,
    // LogonName, DisplayName, PasswordHashHexa and GroupRights (filled with a
    // TSQLAuthGroup ID casted as a pointer) properties - you can retrieve any
    // optional binary data associated with this user via RetrieveBlobFields()
    property SessionUser: TSQLAuthUser read fSessionUser;
    /// access to the low-level HTTP header used for authentication
    // - you can force here your own header, e.g. a JWT as authentication bearer
    // or as in TSQLRestServerAuthenticationHttpAbstract.ClientSetUserHttpOnlyUser
    property SessionHttpHeader: RawUTF8 read fSessionHttpHeader write fSessionHttpHeader;
    {$ifndef LVCL}
    /// set a callback event to be executed in loop during remote blocking
    // process, e.g. to refresh the UI during a somewhat long request
    // - if not set, the request will be executed in the current thread,
    // so may block the User Interface
    // - you can assign a callback to this property, calling for instance
    // Application.ProcessMessages, to execute the remote request in a
    // background thread, but let the UI still be reactive: the
    // TLoginForm.OnIdleProcess and OnIdleProcessForm methods of
    // mORMotUILogin.pas will match this property expectations
    property OnIdle: TOnIdleSynBackgroundThread read fOnIdle write fOnIdle;
    /// TRUE if the background thread is active, and OnIdle event is called
    // during process
    // - to be used e.g. to ensure no re-entrance from User Interface messages
    property OnIdleBackgroundThreadActive: Boolean read GetOnIdleBackgroundThreadActive;
    {$endif}
    /// this Event is called in case of remote authentication failure
    // - client software can ask the user to enter a password and user name
    // - if no event is specified, the URI() method will return directly
    // an HTTP_FORBIDDEN "403 Forbidden" error code
    property OnAuthentificationFailed: TOnAuthentificationFailed
      read fOnAuthentificationFailed write fOnAuthentificationFailed;
    /// this Event is called if URI() was not successfull
    // - the callback will have all needed information
    // - e.g. Call^.OutStatus=HTTP_NOTIMPLEMENTED indicates a broken connection
    property OnFailed: TOnClientFailed read fOnFailed write fOnFailed;
    /// this Event is called when a user is authenticated
    // - is called always, on each TSQLRestClientURI.SetUser call
    // - you can check the Sender.SessionUser property pointing to the current
    // authenticated user, or nil if authentication failed
    // - could be used to refresh the User Interface layout according to
    // current authenticated user rights, or to subscribe to some services
    // via callbacks
    property OnSetUser: TOnRestClientNotify read fOnSetUser write fOnSetUser;
  end;

  /// Rest client with remote access to a server through a dll
  // - use only one TURIMapRequest function for the whole communication
  // - the data is stored in Global system memory, and freed by GlobalFree()
  TSQLRestClientURIDll = class(TSQLRestClientURI)
  private
    /// used by Create(from dll) constructor
    fLibraryHandle: cardinal;
  protected
    Func: TURIMapRequest;
    /// method calling the RESTful server through a DLL or executable, using
    // direct memory
    procedure InternalURI(var Call: TSQLRestURIParams); override;
    /// overridden protected method do nothing (direct DLL access has no connection)
    function InternalCheckOpen: boolean; override;
    /// overridden protected method do nothing (direct DLL access has no connection)
    procedure InternalClose; override;
  public
    /// connect to a server from a remote function
    constructor Create(aModel: TSQLModel; aRequest: TURIMapRequest); reintroduce; overload;
    /// connect to a server contained in a shared library
    // - this dll must contain at least a URIRequest entry
    // - raise an exception if the shared library is not found or invalid
    constructor Create(aModel: TSQLModel; const DllName: TFileName); reintroduce; overload;
    /// release memory and handles
    destructor Destroy; override;
  end;

  /// Rest client with redirection to another TSQLRest instance
  TSQLRestClientRedirect = class(TSQLRestClientURI)
  protected
    fRedirectedServer: TSQLRestServer;
    fRedirectedClient: TSQLRestClientURI;
    /// method calling the associated RESTful instance
    procedure InternalURI(var Call: TSQLRestURIParams); override;
    /// overridden protected method which returns TRUE if redirection is enabled
    function InternalCheckOpen: boolean; override;
    /// this overridden protected method does nothing
    procedure InternalClose; override;
  public
    /// prepare the redirection, to be enabled later via RedirectTo()
    // - the supplied aModel instance will be owned by this class
    constructor Create(aModel: TSQLModel); overload; override;
    /// will pass all client commands to the supplied TSQLRest instance
    // - aRedirected is expected to be either a TSQLRestClientURI or
    // a TSQLRestServer
    // - will make a copy of the aRedirected.Model, and own it
    constructor Create(aRedirected: TSQLRest); reintroduce; overload;
    /// will pass all client commands to the supplied TSQLRestServer instance
    // - aRedirected will be owned by this TSQLRestClientRedirect
    constructor CreateOwned(aRedirected: TSQLRestServer); reintroduce;
    /// allows to change redirection to a client on the fly
    // - if aRedirected is nil, redirection will be disabled and any URI() call
    // will return an HTTP_GATEWAYTIMEOUT 504 error status
    procedure RedirectTo(aRedirected: TSQLRest);
  end;

  {$ifdef MSWINDOWS}

  /// Rest client with remote access to a server through Windows messages
  // - use only one TURIMapRequest function for the whole communication
  // - the data is sent and received by using the standard and fast WM_COPYDATA message
  // - named pipes seems to be somewhat better for bigger messages under XP
  // - this class is thread-safe, since its URI() method is protected by a lock
  TSQLRestClientURIMessage = class(TSQLRestClientURI)
  protected
    /// the HWND of the server process, retrieved by InternalCheckOpen() method
    fServerWindow: HWND;
    /// the Window name used of the server process
    fServerWindowName: string;
    /// the HWND of the client process, as set by Create() method
    fClientWindow: HWND;
    /// the Window name used, if created internaly
    fClientWindowName: string;
    /// the time out to be used, in mili seconds
    fTimeOutMS: cardinal;
    /// if InternalURI will process the Windows Messages loop
    fDoNotProcessMessages: boolean;
    /// the expected current response
    // - this value is set from the incoming WM_COPYDATA
    // - this value is set to #0 (i.e. string of one #0 char) while waiting
    // for a WM_COPYDATA message in URI() method
    fCurrentResponse: RawUTF8;
    constructor RegisteredClassCreateFrom(aModel: TSQLModel;
      aDefinition: TSynConnectionDefinition); override;
    /// method calling the RESTful server by using Windows WM_COPYDATA messages
    procedure InternalURI(var Call: TSQLRestURIParams); override;
    /// overridden protected method to handle Windows Message loop connection
    function InternalCheckOpen: boolean; override;
    /// overridden protected method to close Windows Message
    procedure InternalClose; override;
  public
    /// connect to a server from its window name
    // - ServerWindowName is of UnicodeString type since Delphi 2009
    // (direct use of FindWindow()=FindWindowW() Win32 API)
    // - this version must supply a Client Window handle
    constructor Create(aModel: TSQLModel; const ServerWindowName: string;
      ClientWindow: HWND; TimeOutMS: cardinal); reintroduce; overload;
    /// connect to a server from its window name
    // - ServerWindowName is of UnicodeString type since Delphi 2009
    // (direct use of FindWindow()=FindWindowW() Win32 API)
    // - this version will instanciante and create a Client Window from
    // a Window Name, by using low level Win32 API: therefore, the Forms unit
    // is not needed with this constructor (save some KB)
    constructor Create(aModel: TSQLModel; const ServerWindowName,
      ClientWindowName: string; TimeOutMS: cardinal); reintroduce; overload;
    /// release the internal Window class created, if any
    destructor Destroy; override;
    /// save the TSQLRestClientURIMessage properties into a persistent storage object
    // - CreateFrom() will expect Definition.ServerName to store the
    // ServerWindowName, and Definition.DatabaseName to be the ClientWindowName
    procedure DefinitionTo(Definition: TSynConnectionDefinition); override;
    /// event to be triggered when a WM_COPYDATA message is received from the server
    // - to be called by the corresponding "message WM_COPYDATA;" method in the
    // client TForm instance
    procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA;
    /// define if the client will process the Windows Messages loop
    // - set to TRUE if the client is used outside the main GUI application thread
    property DoNotProcessMessages: boolean read fDoNotProcessMessages write fDoNotProcessMessages;
  end;

  /// Rest client with remote access to a server through a Named Pipe
  // - named pipe is fast and optimized under Windows
  // - can be accessed localy or remotely
  // - this class is thread-safe, since its URI() method is protected by a lock
  TSQLRestClientURINamedPipe = class(TSQLRestClientURI)
  private
    /// handle for '\\.\pipe\mORMot_TEST' e.g.
    fServerPipe: THandle;
    /// the pipe name
    fPipeName: TFileName;
{$ifndef ANONYMOUSNAMEDPIPE}
  {$ifndef NOSECURITYFORNAMEDPIPECLIENTS}
    fPipeSecurityAttributes: TSecurityAttributes;
    fPipeSecurityDescriptor: array[0..SECURITY_DESCRIPTOR_MIN_LENGTH] of byte;
  {$endif}
{$endif}
  protected
    constructor RegisteredClassCreateFrom(aModel: TSQLModel;
      aDefinition: TSynConnectionDefinition); override;
    /// method calling the RESTful server through a DLL or executable, by using
    // a named pipe (faster than TCP/IP or HTTP connection)
    // - return status code in result.Lo
    // - return database internal state in result.Hi
    // - status code 501 HTTP_NOTIMPLEMENTED if no server is available
    procedure InternalURI(var Call: TSQLRestURIParams); override;
    /// overridden protected method to handle named-pipe connection
    function InternalCheckOpen: boolean; override;
    /// overridden protected method to close named-pipe connection
    procedure InternalClose; override;
  public
    /// connect to a server contained in a running application
    // - the server must have been declared by a previous
    // TSQLRestServer.ExportServer(ApplicationName) call
    // with ApplicationName as user-defined server identifier ('DBSERVER' e.g.)
    // - ApplicationName is of UnicodeString type since Delphi 2009
    // (direct use of Wide Win32 API version)
    // - this server identifier is appended to '\\.\pipe\mORMot_' to obtain
    // the full pipe name to connect to ('\\.\pipe\mORMot__DBSERVER' e.g.)
    // - this server identifier may also contain a remote computer name, and
    // must be fully qualified ('\\ServerName\pipe\ApplicationName' e.g.)
    // - raise an exception if the server is not running or invalid
    constructor Create(aModel: TSQLModel; const ApplicationName: TFileName); reintroduce;
    /// save the TSQLRestClientURIMessage properties into a persistent storage object
    // - CreateFrom() will expect Definition.ServerName to store the
    // expected ApplicationName
    procedure DefinitionTo(Definition: TSynConnectionDefinition); override;
  end;
{$endif MSWINDOWS}

  /// will define a validation to be applied to a TSQLRecord field, using
  // if necessary an associated TSQLRest instance and a TSQLRecord class
  // - a typical usage is to validate a value to be unique in the table
  // (implemented in the TSynValidateUniqueField class)
  // - the optional associated parameters are to be supplied JSON-encoded
  // - ProcessRest and ProcessRec properties will be filled before Validate
  // method call by TSQLRecord.Validate()
  TSynValidateRest = class(TSynValidate)
  protected
    fProcessRest: TSQLRest;
    fProcessRec: TSQLRecord;
    function DoValidate(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string; aProcessRest: TSQLRest; aProcessRec: TSQLRecord): boolean; virtual; abstract;
  public
    function Process(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string): boolean; override;
    function Validate(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string; aProcessRest: TSQLRest; aProcessRec: TSQLRecord): boolean;
    /// the associated TSQLRest instance
    // - this value is updated by Validate with the current
    // TSQLRest used for the validation
    // - it can be used in the overridden DoValidate method
    property ProcessRest: TSQLRest read fProcessRest;
    /// the associated TSQLRecord instance
    // - this value is updated by Validate with the current
    // TSQLRecord instance to be validated
    // - it can be used in the overridden DoValidate method
    property ProcessRec: TSQLRecord read fProcessRec;
  end;

  /// will define a validation for a TSQLRecord Unique text field
  // - this class will handle only textual fields, not numeric values
  // - it will check that the field value is not void
  // - it will check that the field value is not a duplicate
  TSynValidateUniqueField = class(TSynValidateRest)
  protected
    /// perform the unique field validation action to the specified value
    function DoValidate(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string; aProcessRest: TSQLRest; aProcessRec: TSQLRecord): boolean; override;
  end;

  /// will define an unicity validation for a set of TSQLRecord text fields
  // - field names should be specified as CSV in the JSON "FieldNames" property
  // in the constructor, or the Parameters field, e.g. like
  // ! TSQLSampleRecord.AddFilterOrValidate('propA',
  // !   TSynValidateUniqueFields.Create('{"FieldNames":"propA,propB"}'));
  // - this class will handle only textual fields, not numeric values
  // - it will check that the field values are not a duplicate
  TSynValidateUniqueFields = class(TSynValidateRest)
  protected
    fFieldNames: TRawUTF8DynArray;
    procedure SetParameters(const Value: RawUTF8); override;
    /// perform the unique fields validation action to the specified value
    function DoValidate(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string; aProcessRest: TSQLRest; aProcessRec: TSQLRecord): boolean; override;
  public
    /// the validated field names
    property FieldNames: TRawUTF8DynArray read fFieldNames;
  end;


  /// a WHERE constraint as set by the TSQLVirtualTable.Prepare() method
  TSQLVirtualTablePreparedConstraint = packed record
    /// Column on left-hand side of constraint
    // - The first column of the virtual table is column 0
    // - The RowID of the virtual table is column -1
    // - Hidden columns are counted when determining the column index
    // - if this field contains VIRTUAL_TABLE_IGNORE_COLUMN (-2), TSQLVirtualTable.
    // Prepare() should ignore this entry
    Column: integer;
    /// The associated expression
    // - TSQLVirtualTable.Prepare() must set Value.VType to not svtUnknown
    // (e.g. to svtNull), if an expression is expected at vt_BestIndex() call
    // - TSQLVirtualTableCursor.Search() will receive an expression value,
    // to be retrieved e.g. via sqlite3_value_*() functions
    Value: TSQLVar;
    /// Constraint operator
    // - MATCH keyword is parsed into soBeginWith, and should be handled as
    // soBeginWith, soContains or soSoundsLike* according to the effective
    // expression text value ('text*', '%text'...)
    Operation: TCompareOperator;
    /// If true, the constraint is assumed to be fully handled
    // by the virtual table and is not checked again by SQLite
    // - By default (OmitCheck=false), the SQLite core double checks all
    // constraints on each row of the virtual table that it receives
    // - TSQLVirtualTable.Prepare() can set this property to true
    OmitCheck: boolean;
  end;
  PSQLVirtualTablePreparedConstraint = ^TSQLVirtualTablePreparedConstraint;

  /// an ORDER BY clause as set by the TSQLVirtualTable.Prepare() method
  // - warning: this structure should match exactly TSQLite3IndexOrderBy as
  // defined in SynSQLite3
  TSQLVirtualTablePreparedOrderBy = record
    /// Column number
    // - The first column of the virtual table is column 0
    // - The RowID of the virtual table is column -1
    // - Hidden columns are counted when determining the column index.
    Column: Integer;
    /// True for DESCending order, false for ASCending order.
    Desc: boolean;
  end;

  /// abstract planning execution of a query, as set by TSQLVirtualTable.Prepare
  TSQLVirtualTablePreparedCost = (
    costFullScan, costScanWhere, costSecondaryIndex, costPrimaryIndex);

  /// the WHERE and ORDER BY statements as set by TSQLVirtualTable.Prepare
  // - Where[] and OrderBy[] are fixed sized arrays, for fast and easy code
  {$ifdef USERECORDWITHMETHODS}TSQLVirtualTablePrepared = record
    {$else}TSQLVirtualTablePrepared = object{$endif}
  public
    /// number of WHERE statement parameters in Where[] array
    WhereCount: integer;
    /// numver of ORDER BY statement parameters in OrderBy[]
    OrderByCount: integer;
    /// if true, the ORDER BY statement is assumed to be fully handled
    // by the virtual table and is not checked again by SQLite
    // - By default (OmitOrderBy=false), the SQLite core sort all rows of the
    // virtual table that it receives according in order
    OmitOrderBy: boolean;
    ///  Estimated cost of using this prepared index
    // - SQLite uses this value to make a choice between several calls to
    // the TSQLVirtualTable.Prepare() method with several expressions
    EstimatedCost: TSQLVirtualTablePreparedCost;
    ///  Estimated number of rows of using this prepared index
    // - does make sense only if EstimatedCost=costFullScan
    // - SQLite uses this value to make a choice between several calls to
    // the TSQLVirtualTable.Prepare() method with several expressions
    // - is used only starting with SQLite 3.8.2
    EstimatedRows: Int64;
    /// WHERE statement parameters, in TSQLVirtualTableCursor.Search() order
    Where: array[0..MAX_SQLFIELDS-1] of TSQLVirtualTablePreparedConstraint;
    /// ORDER BY statement parameters
    OrderBy: array[0..MAX_SQLFIELDS-1] of TSQLVirtualTablePreparedOrderBy;
    /// returns TRUE if there is only one ID=? statement in this search
    function IsWhereIDEquals(CalledFromPrepare: Boolean): boolean;
       {$ifdef HASINLINE}inline;{$endif}
    /// returns TRUE if there is only one FieldName=? statement in this search
    function IsWhereOneFieldEquals: boolean;
       {$ifdef HASINLINE}inline;{$endif}
  end;

  PSQLVirtualTablePrepared = ^TSQLVirtualTablePrepared;

  TSQLVirtualTableCursor = class;

  /// class-reference type (metaclass) of a cursor on an abstract Virtual Table
  TSQLVirtualTableCursorClass = class of TSQLVirtualTableCursor;

  /// the possible features of a Virtual Table
  // - vtWrite is to be set if the table is not Read/Only
  // - vtTransaction if handles vttBegin, vttSync, vttCommit, vttRollBack
  // - vtSavePoint if handles vttSavePoint, vttRelease, vttRollBackTo
  // - vtWhereIDPrepared if the ID=? WHERE statement will be handled in
  // TSQLVirtualTableCursor.Search()
  TSQLVirtualTableFeature = (vtWrite, vtTransaction, vtSavePoint,
    vtWhereIDPrepared);

  /// a set of features of a Virtual Table
  TSQLVirtualTableFeatures = set of TSQLVirtualTableFeature;

  /// used to store and handle the main specifications of a TSQLVirtualTableModule
  TVirtualTableModuleProperties = record
    /// a set of features of a Virtual Table
    Features: TSQLVirtualTableFeatures;
    /// the associated cursor class
    CursorClass: TSQLVirtualTableCursorClass;
    /// the associated TSQLRecord class
    // - used to retrieve the field structure with all collations
    RecordClass: TSQLRecordClass;
    /// the associated TSQLRestStorage class used for storage
    // - is e.g. TSQLRestStorageInMemory for TSQLVirtualTableJSON,
    // TSQLRestStorageExternal for TSQLVirtualTableExternal, or nil for
    // TSQLVirtualTableLog
    StaticClass: TSQLRestStorageClass;
    /// can be used to customize the extension of the filename
    // - the '.' is not to be included
    FileExtension: TFileName;
  end;

  /// parent class able to define a Virtual Table module
  // - in order to implement a new Virtual Table type, you'll have to define a so
  // called "Module" to handle the fields and data access and an associated
  // TSQLVirtualTableCursorClass for handling the SELECT statements
  // - for our framework, the SQLite3 unit will inherit from this class to define
  // a TSQLVirtualTableModuleSQLite3 class, which will register the associated
  // virtual table definition into a SQLite3 connection, on the server side
  // - children should override abstract methods in order to implement the
  // association with the database engine itself
  TSQLVirtualTableModule = class
  protected
    fModuleName: RawUTF8;
    fTableClass: TSQLVirtualTableClass;
    fServer: TSQLRestServer;
    fFeatures: TVirtualTableModuleProperties;
    fFilePath: TFileName;
  public
    /// create the Virtual Table instance according to the supplied class
    // - inherited constructors may register the Virtual Table to the specified
    // database connection
    constructor Create(aTableClass: TSQLVirtualTableClass;
      aServer: TSQLRestServer); virtual;
    /// retrieve the file name to be used for a specific Virtual Table
    // - returns by default a file located in the executable folder, with the
    // table name as file name, and module name as extension
    function FileName(const aTableName: RawUTF8): TFileName; virtual;
    /// the Virtual Table module features
    property Features: TSQLVirtualTableFeatures read fFeatures.Features;
    /// the associated virtual table class
    property TableClass: TSQLVirtualTableClass read fTableClass;
    /// the associated virtual table cursor class
    property CursorClass: TSQLVirtualTableCursorClass read fFeatures.CursorClass;
    /// the associated TSQLRestStorage class used for storage
    // - e.g. returns TSQLRestStorageInMemory for TSQLVirtualTableJSON,
    // or TSQLRestStorageExternal for TSQLVirtualTableExternal, or
    // either nil for TSQLVirtualTableLog
    property StaticClass: TSQLRestStorageClass read fFeatures.StaticClass;
    /// the associated TSQLRecord class
    // - is mostly nil, e.g. for TSQLVirtualTableJSON
    // - used to retrieve the field structure for TSQLVirtualTableLog e.g.
    property RecordClass: TSQLRecordClass read fFeatures.RecordClass;
    /// the extension of the filename (without any left '.')
    property FileExtension: TFileName read fFeatures.FileExtension;
    /// the full path to be used for the filename
    // - is '' by default, i.e. will use the executable path
    // - you can specify here a custom path, which will be used by the FileName
    // method to retrieve the .json/.data full file
    property FilePath: TFileName read fFilePath write fFilePath;
    /// the associated Server instance
    // - may be nil, in case of direct access to the virtual table
    property Server: TSQLRestServer read fServer;
    /// the corresponding module name
    property ModuleName: RawUTF8 read fModuleName;
  end;

  /// the available transaction levels
  TSQLVirtualTableTransaction = (
    vttBegin, vttSync, vttCommit, vttRollBack,
    vttSavePoint, vttRelease, vttRollBackTo);

  /// abstract class able to access a Virtual Table content
  // - override the Prepare/Structure abstract virtual methods for reading
  // access to the virtual table content
  // - you can optionaly override Drop/Delete/Insert/Update/Rename/Transaction
  // virtual methods to allow content writing to the virtual table
  // - the same virtual table mechanism can be used with several database module,
  // with diverse database engines
  TSQLVirtualTable = class
  protected
    fModule: TSQLVirtualTableModule;
    fTableName: RawUTF8;
    fStatic: TSQLRest;
    fStaticStorage: TSQLRestStorage;
    fStaticTable: TSQLRecordClass;
    fStaticTableIndex: integer;
  public
    /// create the virtual table access instance
    // - the created instance will be released when the virtual table will be
    // disconnected from the DB connection (e.g. xDisconnect method for SQLite3)
    // - shall raise an exception in case of invalid parameters (e.g. if the
    // supplied module is not associated to a TSQLRestServer instance)
    // - aTableName will be checked against the current aModule.Server.Model
    // to retrieve the corresponding TSQLRecordVirtualTableAutoID class and
    // create any associated Static: TSQLRestStorage instance
    constructor Create(aModule: TSQLVirtualTableModule; const aTableName: RawUTF8;
      FieldCount: integer; Fields: PPUTF8CharArray); virtual;
    /// release the associated memory, especially the Static instance
    destructor Destroy; override;
    /// retrieve the corresponding module name
    // - will use the class name, triming any T/TSQL/TSQLVirtual/TSQLVirtualTable*
    // - when the class is instanciated, it will be faster to retrieve the same
    // value via Module.ModuleName
    class function ModuleName: RawUTF8;
    /// a generic method to get a 'CREATE TABLE' structure from a supplied
    // TSQLRecord class
    // - is called e.g. by the Structure method
    class function StructureFromClass(aClass: TSQLRecordClass;
      const aTableName: RawUTF8): RawUTF8;
    /// the associated Virtual Table module
    property Module: TSQLVirtualTableModule read fModule;
    /// the name of the Virtual Table, as specified following the TABLE keyword
    // in the CREATE VIRTUAL TABLE statement
    property TableName: RawUTF8 read fTableName;
  public { virtual methods to be overridden }
    /// should return the main specifications of the associated TSQLVirtualTableModule
    class procedure GetTableModuleProperties(
      var aProperties: TVirtualTableModuleProperties); virtual; abstract;
    /// called to determine the best way to access the virtual table
    // - will prepare the request for TSQLVirtualTableCursor.Search()
    // - in Where[], Expr must be set to not 0 if needed for Search method,
    // and OmitCheck to true if double check is not necessary
    // - OmitOrderBy must be set to true if double sort is not necessary
    // - EstimatedCost and EstimatedRows should receive the estimated cost
    // - default implementation will let the DB engine perform the search,
    // and prepare for ID=? statement if vtWhereIDPrepared was set
    function Prepare(var Prepared: TSQLVirtualTablePrepared): boolean; virtual;
    /// should retrieve the format (the names and datatypes of the columns) of
    // the virtual table, as expected by sqlite3_declare_vtab()
    // - default implementation is to retrieve the structure for the associated
    // Module.RecordClass property (as set by GetTableModuleProperties) or
    // the Static.StoredClass: in both cases, column numbering will follow
    // the TSQLRecord published field order (TSQLRecord.RecordProps.Fields[])
    function Structure: RawUTF8; virtual;
    /// called when a DROP TABLE statement is executed against the virtual table
    // - should return true on success, false otherwise
    // - does nothing by default, and returns false, i.e. always fails
    function Drop: boolean; virtual;
    /// called to delete a virtual table row
    // - should return true on success, false otherwise
    // - does nothing by default, and returns false, i.e. always fails
    function Delete(aRowID: Int64): boolean; virtual;
    /// called to insert a virtual table row content from an array of TSQLVar
    // - should return true on success, false otherwise
    // - should return the just created row ID in insertedRowID on success
    // - does nothing by default, and returns false, i.e. always fails
    function Insert(aRowID: Int64; var Values: TSQLVarDynArray;
      out insertedRowID: Int64): boolean; virtual;
    /// called to update a virtual table row content from an array of TSQLVar
    // - should return true on success, false otherwise
    // - does nothing by default, and returns false, i.e. always fails
    function Update(oldRowID, newRowID: Int64; var Values: TSQLVarDynArray): boolean; virtual;
    /// called to begin a transaction to the virtual table row
    // - do nothing by default, and returns false in case of RollBack/RollBackto
    // - aSavePoint is used for vttSavePoint, vttRelease and vttRollBackTo only
    // - note that if you don't nest your writing within a transaction, SQLite
    // will call vttCommit for each INSERT/UPDATE/DELETE, just like a regular
    // SQLite database - it could make bad written code slow even with Virtual
    // Tables
    function Transaction(aState: TSQLVirtualTableTransaction; aSavePoint: integer): boolean; virtual;
    /// called to rename the virtual table
    // - by default, returns false, i.e. always fails
    function Rename(const NewName: RawUTF8): boolean; virtual;
    /// the associated virtual table storage instance
    // - can be e.g. a TSQLRestStorageInMemory for TSQLVirtualTableJSON,
    // or a TSQLRestStorageExternal for TSQLVirtualTableExternal, or nil
    // for TSQLVirtualTableLog
    property Static: TSQLRest read fStatic;
    /// the associated virtual table storage instance, if is a TSQLRestStorage
    property StaticStorage: TSQLRestStorage read fStaticStorage;
    /// the associated virtual table storage table
    property StaticTable: TSQLRecordClass read fStaticTable;
    /// the associated virtual table storage index in its Model.Tables[] array
    property StaticTableIndex: integer read fStaticTableIndex;
  end;

  /// abstract class able to define a Virtual Table cursor
  // - override the Search/HasData/Column/Next abstract virtual methods to
  // implement the search process
  TSQLVirtualTableCursor = class
  protected
    fTable: TSQLVirtualTable;
    /// used internaly between two Column() method calls for GetFieldSQLVar()
    fColumnTemp: RawByteString;
    /// easy set a TSQLVar content for the Column() method
    procedure SetColumn(var aResult: TSQLVar; aValue: Int64); overload;
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetColumn(var aResult: TSQLVar; const aValue: double); overload;
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetColumn(var aResult: TSQLVar; const aValue: RawUTF8); overload;
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetColumn(var aResult: TSQLVar; aValue: PUTF8Char; aValueLength: integer); overload;
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetColumnBlob(var aResult: TSQLVar; aValue: pointer; aValueLength: integer);
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetColumnDate(var aResult: TSQLVar; const aValue: TDateTime;
      aWithMS: boolean); {$ifdef HASINLINE}inline;{$endif}
    procedure SetColumnCurr64(var aResult: TSQLVar; aValue64: PInt64);
      {$ifdef HASINLINE}inline;{$endif}
  public
    /// create the cursor instance
    // - it will be destroyed when by the DB engine (e.g. via xClose in SQLite3)
    constructor Create(aTable: TSQLVirtualTable); virtual;
    /// the associated Virtual Table class instance
    property Table: TSQLVirtualTable read fTable;
  public { abstract methods to be overridden }
    /// called to begin a search in the virtual table
    // - the TSQLVirtualTablePrepared parameters were set by
    // TSQLVirtualTable.Prepare and will contain both WHERE and ORDER BY statements
    // (retrieved e.g. by x_BestIndex() from a TSQLite3IndexInfo structure)
    // - Prepared will contain all prepared constraints and the corresponding
    // expressions in the Where[].Value field
    // - should move cursor to first row of matching data
    // - should return false on low-level database error (but true in case of a
    // valid call, even if HasData will return false, i.e. no data match)
    function Search(const Prepared: TSQLVirtualTablePrepared): boolean; virtual; abstract;
    /// called after Search() to check if there is data to be retrieved
    // - should return false if reached the end of matching data
    function HasData: boolean; virtual; abstract;
    /// called to retrieve a column value of the current data row into a TSQLVar
    // - if aColumn=-1, should return the row ID as varInt64 into aResult
    // - should return false in case of an error, true on success
    function Column(aColumn: integer; var aResult: TSQLVar): boolean; virtual; abstract;
    /// called to go to the next row of matching data
    // - should return false on low-level database error (but true in case of a
    // valid call, even if HasData will return false, i.e. no data match)
    function Next: boolean; virtual; abstract;
  end;

  /// A generic Virtual Table cursor associated to Current/Max index properties
  TSQLVirtualTableCursorIndex = class(TSQLVirtualTableCursor)
  protected
    fCurrent: integer;
    fMax: integer;
  public
    /// called after Search() to check if there is data to be retrieved
    // - will return false if reached the end of matching data, according to
    // the fCurrent/fMax protected properties values
    function HasData: boolean; override;
    /// called to go to the next row of matching data
    // - will return false on low-level database error (but true in case of a
    // valid call, even if HasData will return false, i.e. no data match)
    // - will check the fCurrent/fMax protected properties values
    function Next: boolean; override;
    /// called to begin a search in the virtual table
    // - this no-op version will mark EOF, i.e. fCurrent=0 and fMax=-1
    function Search(const Prepared: TSQLVirtualTablePrepared): boolean; override;
  end;

  /// A Virtual Table cursor for reading a TSQLRestStorageInMemory content
  // - this is the cursor class associated to TSQLVirtualTableJSON
  TSQLVirtualTableCursorJSON = class(TSQLVirtualTableCursorIndex)
  public
    /// called to begin a search in the virtual table
    // - the TSQLVirtualTablePrepared parameters were set by
    // TSQLVirtualTable.Prepare and will contain both WHERE and ORDER BY statements
    // (retrieved by x_BestIndex from a TSQLite3IndexInfo structure)
    // - Prepared will contain all prepared constraints and the corresponding
    // expressions in the Where[].Value field
    // - will move cursor to first row of matching data
    // - will return false on low-level database error (but true in case of a
    // valid call, even if HasData will return false, i.e. no data match)
    // - only handled WHERE clause is for "ID = value" - other request will
    // return all records in ID order, and let the database engine handle it
    function Search(const Prepared: TSQLVirtualTablePrepared): boolean; override;
    /// called to retrieve a column value of the current data row into a TSQLVar
    // - if aColumn=-1, will return the row ID as varInt64 into aResult
    // - will return false in case of an error, true on success
    function Column(aColumn: integer; var aResult: TSQLVar): boolean; override;
  end;

  /// A TSQLRestStorageInMemory-based virtual table using JSON storage
  // - for ORM access, you should use TSQLModel.VirtualTableRegister method to
  // associated this virtual table module to a TSQLRecordVirtualTableAutoID class
  // - transactions are not handled by this module
  // - by default, no data is written on disk: you will need to call explicitly
  // aServer.StaticVirtualTable[aClass].UpdateToFile for file creation or refresh
  // - file extension is set to '.json'
  TSQLVirtualTableJSON = class(TSQLVirtualTable)
  protected
    fStaticInMemory: TSQLRestStorageInMemory;
  public { overridden methods }
    /// create the virtual table access instance
    // - the created instance will be released when the virtual table will be
    // disconnected from the DB connection (e.g. xDisconnect method for SQLite3)
    // - shall raise an exception in case of invalid parameters (e.g. if the
    // supplied module is not associated to a TSQLRestServer instance)
    // - aTableName will be checked against the current aModule.Server.Model
    // to retrieve the corresponding TSQLRecordVirtualTableAutoID class and
    // create any associated Static: TSQLRestStorage instance
    constructor Create(aModule: TSQLVirtualTableModule; const aTableName: RawUTF8;
      FieldCount: integer; Fields: PPUTF8CharArray); override;
    /// returns the main specifications of the associated TSQLVirtualTableModule
    // - this is a read/write table, without transaction, associated to the
    // TSQLVirtualTableCursorJSON cursor type, with 'JSON' as module name
    // - no particular class is supplied here, since it will depend on the
    // associated Static instance
    class procedure GetTableModuleProperties(
      var aProperties: TVirtualTableModuleProperties); override;
    /// called to determine the best way to access the virtual table
    // - will prepare the request for TSQLVirtualTableCursor.Search()
    // - only prepared WHERE statement is for "ID = value"
    // - only prepared ORDER BY statement is for ascending IDs
    function Prepare(var Prepared: TSQLVirtualTablePrepared): boolean; override;
    /// called when a DROP TABLE statement is executed against the virtual table
    // - returns true on success, false otherwise
    function Drop: boolean; override;
    /// called to delete a virtual table row
    // - returns true on success, false otherwise
    function Delete(aRowID: Int64): boolean; override;
    /// called to insert a virtual table row content from a TSQLVar array
    // - column order follows the Structure method, i.e.
    // StoredClassRecordProps.Fields[] order
    // - returns true on success, false otherwise
    // - returns the just created row ID in insertedRowID on success
    // - does nothing by default, and returns false, i.e. always fails
    function Insert(aRowID: Int64; var Values: TSQLVarDynArray;
      out insertedRowID: Int64): boolean; override;
    /// called to update a virtual table row content from a TSQLVar array
    // - column order follows the Structure method, i.e.
    // StoredClassRecordProps.Fields[] order
    // - returns true on success, false otherwise
    // - does nothing by default, and returns false, i.e. always fails
    function Update(oldRowID, newRowID: Int64; var Values: TSQLVarDynArray): boolean; override;
  end;

  /// A TSQLRestStorageInMemory-based virtual table using Binary storage
  // - for ORM access, you should use TSQLModel.VirtualTableRegister method to
  // associated this virtual table module to a TSQLRecordVirtualTableAutoID class
  // - transactions are not handled by this module
  // - by default, no data is written on disk: you will need to call explicitly
  // aServer.StaticVirtualTable[aClass].UpdateToFile for file creation or refresh
  // - binary format is more efficient in term of speed and disk usage than
  // the JSON format implemented by TSQLVirtualTableJSON
  // - binary format will be set by TSQLVirtualTableJSON.CreateTableInstance
  // - file extension is set to '.data'
  TSQLVirtualTableBinary = class(TSQLVirtualTableJSON);

  /// Implements a read/only virtual table able to access a .log file, as created
  // by TSynLog
  // - to be used e.g. by a TSQLRecordLog_Log ('Log_' will identify this 'Log' module)
  // - the .log file name will be specified by the Table Name, to which a '.log'
  // file extension will be appended before loading it from the current directory
  TSQLVirtualTableLog = class(TSQLVirtualTable)
  protected
    fLogFile: TSynLogFile;
  public
    /// returns the main specifications of the associated TSQLVirtualTableModule
    // - this is a read only table, with transaction, associated to the
    // TSQLVirtualTableCursorLog cursor type, with 'Log' as module name,
    // and associated to TSQLRecordLog_Log table field layout
    class procedure GetTableModuleProperties(
      var aProperties: TVirtualTableModuleProperties); override;
    /// creates the TSQLVirtualTable according to the supplied parameters
    // - aTableName will be checked against the current aModule.Server.Model
    // to retrieve the corresponding TSQLRecordVirtualTableAutoID class
    constructor Create(aModule: TSQLVirtualTableModule; const aTableName: RawUTF8;
      FieldCount: integer; Fields: PPUTF8CharArray); override;
    /// release the associated .log file mapping and all internal structures
    destructor Destroy; override;
  end;

  /// A Virtual Table cursor for reading a TSynLogFile content
  // - this is the cursor class associated to TSQLVirtualTableLog
  TSQLVirtualTableCursorLog = class(TSQLVirtualTableCursorIndex)
  public
    /// called to begin a search in the virtual table
    function Search(const Prepared: TSQLVirtualTablePrepared): boolean; override;
    /// called to retrieve a column value of the current data row as TSQLVar
    function Column(aColumn: integer; var aResult: TSQLVar): boolean; override;
  end;

  /// Record associated to a Virtual Table implemented in Delphi, with ID
  // forced at INSERT
  // - will use TSQLVirtualTableModule / TSQLVirtualTable / TSQLVirtualTableCursor
  // classes for a generic Virtual table mechanism on the Server side
  // - call Model.VirtualTableRegister() before TSQLRestServer.Create on the
  // Server side (not needed for Client) to associate such a record with a
  // particular Virtual Table module, otherwise an exception will be raised:
  // ! Model.VirtualTableRegister(TSQLRecordDali1,TSQLVirtualTableJSON);
  TSQLRecordVirtualTableForcedID = class(TSQLRecordVirtual);

  /// Record associated to Virtual Table implemented in Delphi, with ID
  // generated automatically at INSERT
  // - will use TSQLVirtualTableModule / TSQLVirtualTable / TSQLVirtualTableCursor
  // classes for a generic Virtual table mechanism
  // - call Model.VirtualTableRegister() before TSQLRestServer.Create on the
  // Server side (not needed for Client) to associate such a record with a
  // particular Virtual Table module, otherwise an exception will be raised:
  // ! Model.VirtualTableRegister(TSQLRecordDali1,TSQLVirtualTableJSON);
  TSQLRecordVirtualTableAutoID = class(TSQLRecordVirtual);

/// special comparison function for sorting ftRecord (TRecordReference/RecordRef)
// UTF-8 encoded values in the SQLite3 database or JSON content
function UTF8CompareRecord(P1,P2: PUTF8Char): PtrInt;

/// special comparison function for sorting sftBoolean
// UTF-8 encoded values in the SQLite3 database or JSON content
function UTF8CompareBoolean(P1,P2: PUTF8Char): PtrInt;

/// special comparison function for sorting sftEnumerate, sftSet or sftID
// UTF-8 encoded values in the SQLite3 database or JSON content
function UTF8CompareUInt32(P1,P2: PUTF8Char): PtrInt;

/// special comparison function for sorting sftInteger, sftTID, sftRecordVersion
// sftTimeLog/sftModTime/sftCreateTime or sftUnixTime/sftUnixMSTime UTF-8 encoded
// values in the SQLite3 database or JSON content
function UTF8CompareInt64(P1,P2: PUTF8Char): PtrInt;

/// special comparison function for sorting sftCurrency
// UTF-8 encoded values in the SQLite3 database or JSON content
function UTF8CompareCurr64(P1,P2: PUTF8Char): PtrInt;

/// special comparison function for sorting sftFloat
// UTF-8 encoded values in the SQLite3 database or JSON content
function UTF8CompareDouble(P1,P2: PUTF8Char): PtrInt;

/// special comparison function for sorting sftDateTime or sftDateTimeMS
// UTF-8 encoded values in the SQLite3 database or JSON content
function UTF8CompareISO8601(P1,P2: PUTF8Char): PtrInt;

{$ifndef NOVARIANTS}
/// low-level function used to convert a JSON Value into a variant,
// according to the property type
// - for sftObject, sftVariant, sftBlobDynArray and sftUTF8Custom, the
// JSON buffer may be an array or an object, so createValueTempCopy can
// create a temporary copy before parsing it in-place, to preserve the buffer
// - sftUnknown and sftMany will set a varEmpty (Unassigned) value
// - typeInfo may be used for sftBlobDynArray conversion to a TDocVariant array
procedure ValueVarToVariant(Value: PUTF8Char; ValueLen: integer; fieldType: TSQLFieldType;
  var result: TVarData; createValueTempCopy: boolean; typeInfo: pointer;
  options: TDocVariantOptions=JSON_OPTIONS_FAST);

/// read an object properties from a TDocVariant object document
// - ObjectInstance must be an existing TObject instance
// - will return TRUE on success, or FALSE if the supplied aDocVariant was
// not a TDocVariant object
function ObjectLoadVariant(var ObjectInstance; const aDocVariant: variant;
  TObjectListItemClass: TClass=nil; Options: TJSONToObjectOptions=[]): boolean;
{$endif NOVARIANTS}

/// may be used by DatabaseExecute/AdministrationExecute methods to serve
// a folder content for remote administration
procedure AdministrationExecuteGetFiles(const Folder, Mask: TFileName; const Param: RawUTF8;
  var Answer: TServiceCustomAnswer);

const
  /// if a TSQLVirtualTablePreparedConstraint.Column is to be ignored
  VIRTUAL_TABLE_IGNORE_COLUMN = -2;
  /// if a TSQLVirtualTablePreparedConstraint.Column points to the RowID
  VIRTUAL_TABLE_ROWID_COLUMN = -1;

  /// if the TSQLRecordVirtual table kind is a FTS virtual table
  IS_FTS = [rFTS3, rFTS4, rFTS5];

  /// if the TSQLRecordVirtual table kind is not an embedded type
  // - can be set for a TSQLRecord after a VirtualTableExternalRegister call
  IS_CUSTOM_VIRTUAL = [rCustomForcedID, rCustomAutoID];

  /// if the TSQLRecordVirtual table kind expects the ID to be set on INSERT
  INSERT_WITH_ID = [rFTS3, rFTS4, rFTS5, rRTree, rRTreeInteger, rCustomForcedID];

  /// Supervisor Table access right, i.e. alllmighty over all fields
  ALL_ACCESS_RIGHTS = [0..MAX_SQLTABLES-1];

  /// Complete Database access right, i.e. allmighty over all Tables
  // - WITH the possibility to remotely execute any SQL statement (reSQL right)
  // - is used by default by TSQLRestClientDB.URI() method, i.e. for direct
  // local/in-process access
  // - is used as reference to create TSQLAuthUser 'Admin' access policy
  FULL_ACCESS_RIGHTS: TSQLAccessRights =
    (AllowRemoteExecute:
      [reSQL,reSQLSelectWithoutTable,reService,reUrlEncodedSQL,reUrlEncodedDelete];
     GET: ALL_ACCESS_RIGHTS; POST: ALL_ACCESS_RIGHTS;
     PUT: ALL_ACCESS_RIGHTS; DELETE: ALL_ACCESS_RIGHTS);

  /// Supervisor Database access right, i.e. allmighty over all Tables
  // - but WITHOUT the possibility to remotely execute any SQL statement (reSQL)
  // - is used as reference to create TSQLAuthUser 'Supervisor' access policy
  SUPERVISOR_ACCESS_RIGHTS: TSQLAccessRights =
    (AllowRemoteExecute:
      [reSQLSelectWithoutTable,reService,reUrlEncodedSQL,reUrlEncodedDelete];
     GET: ALL_ACCESS_RIGHTS; POST: ALL_ACCESS_RIGHTS;
     PUT: ALL_ACCESS_RIGHTS; DELETE: ALL_ACCESS_RIGHTS);

  /// special TSQLFieldBits value containing all field bits set to 1
  ALL_FIELDS: TSQLFieldBits = [0..MAX_SQLFIELDS-1];

  /// default hashed password set by TSQLAuthGroup.InitializeTable for all users
  // - contains TSQLAuthUser.ComputeHashedPassword('synopse')
  // - override AuthAdminDefaultPassword, AuthSupervisorDefaultPassword and
  // AuthUserDefaultPassword values to follow your own application expectations
  DEFAULT_HASH_SYNOPSE = '67aeea294e1cb515236fd7829c55ec820ef888e8e221814d24d83b3dc4d825dd';

  /// the Server-side instance implementation patterns without any ID
  SERVICE_IMPLEMENTATION_NOID = [sicSingle,sicShared];

  /// typical TJSONSerializerSQLRecordOptions values for AJAX clients
  JSONSERIALIZEROPTIONS_AJAX = [jwoAsJsonNotAsString,jwoID_str];

var
  /// default timeout period set by TSQLAuthGroup.InitializeTable for 'Admin' group
  // - you can override this value to follow your own application expectations
  AuthAdminGroupDefaultTimeout: integer = 10;
  /// default timeout period set by TSQLAuthGroup.InitializeTable for 'Supervisor' group
  // - you can override this value to follow your own application expectations
  // - note that clients will maintain the session alive using CacheFlush/_ping_
  AuthSupervisorGroupDefaultTimeout: integer = 60;
  /// default timeout period set by TSQLAuthGroup.InitializeTable for 'User' group
  // - you can override this value to follow your own application expectations
  // - note that clients will maintain the session alive using CacheFlush/_ping_
  AuthUserGroupDefaultTimeout: integer = 60;
  /// default timeout period set by TSQLAuthGroup.InitializeTable for 'Guest' group
  // - you can override this value to follow your own application expectations
  // - note that clients will maintain the session alive using CacheFlush/_ping_
  AuthGuestGroupDefaultTimeout: integer = 60;

  /// default hashed password set by TSQLAuthGroup.InitializeTable for 'Admin' user
  // - you can override this value to follow your own application expectations
  AuthAdminDefaultPassword: RawUTF8 = DEFAULT_HASH_SYNOPSE;
  /// default hashed password set by TSQLAuthGroup.InitializeTable for 'Supervisor' user
  // - you can override this value to follow your own application expectations
  AuthSupervisorDefaultPassword: RawUTF8 = DEFAULT_HASH_SYNOPSE;
  /// default hashed password set by TSQLAuthGroup.InitializeTable for 'User' user
  // - you can override this value to follow your own application expectations
  AuthUserDefaultPassword: RawUTF8 = DEFAULT_HASH_SYNOPSE;

const
  {$ifndef DOMAINAUTH} // fallback is no SSPI library was made available
  TSQLRestServerAuthenticationSSPI = nil;
  {$endif DOMAINAUTH}

  /// timer identifier which indicates we must refresh the current Page
  // - used for User Interface generation
  // - is associated with the TSQLRibbonTabParameters.AutoRefresh property,
  // and is handled in TSQLRibbon.RefreshClickHandled
  WM_TIMER_REFRESH_SCREEN = 1;
  /// timer identifier which indicates we must refresh the Report content
  // - used for User Interface generation
  // - is handled in TSQLRibbon.RefreshClickHandled
  WM_TIMER_REFRESH_REPORT = 2;

  /// the default URI parameters for query paging
  // - those values are the one expected by YUI components
  PAGINGPARAMETERS_YAHOO: TSQLRestServerURIPagingParameters = (
    Sort: 'SORT=';
    Dir: 'DIR=';
    StartIndex: 'STARTINDEX=';
    Results: 'RESULTS=';
    Select: 'SELECT=';
    Where: 'WHERE=';
    SendTotalRowsCountFmt: '');

  /// options to specify no index createon for TSQLRestServer.CreateMissingTables
  // and TSQLRecord.InitializeTable methods
  INITIALIZETABLE_NOINDEX: TSQLInitializeTableOptions =
    [itoNoIndex4ID..itoNoIndex4RecordVersion];

  /// default value of TSQLRestServer.StatLevels property
  // - i.e. gather all statistics, but mlSessions
  SERVERDEFAULTMONITORLEVELS: TSQLRestServerMonitorLevels =
    [mlTables,mlMethods,mlInterfaces,mlSQLite3];

/// wrapper to search for a given TSQLRecord by ID in an array of TSQLRecord
function ObjArraySearch(const aSQLRecordObjArray; aID: TID): TSQLRecord;

/// wrapper to return all TID values of an array of TSQLRecord
procedure ObjArrayRecordIDs(const aSQLRecordObjArray; out result: TInt64DynArray);

/// wrapper to create a new T*ObjArray with copied instances of a source T*ObjArray
// - use internally CopyObject() over aSourceObjArray[] instances
// - will clear aDestObjArray before items copy, if aDestObjArrayClear = TRUE
procedure ObjArrayCopy(const aSourceObjArray; var aDestObjArray;
  aDestObjArrayClear: boolean=true);

/// safe deletion of a T*InterfaceArray dynamic array item
// - similar to InterfaceArrayDelete, but with a safe try .. except block
// during the entry deletion (since the system may be unstable)
// - will also log a warning with the Interface name (from aLogMsg) and aInstance
procedure InterfaceArrayDeleteAfterException(var aInterfaceArray;
  const aItemIndex: integer; aLog: TSynLogFamily; const aLogMsg: RawUTF8; aInstance: TObject);

/// create a TRecordReference with the corresponding parameters
function RecordReference(Model: TSQLModel; aTable: TSQLRecordClass; aID: TID): TRecordReference; overload;

/// create a TRecordReference with the corresponding parameters
function RecordReference(aTableIndex: cardinal; aID: TID): TRecordReference; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a dynamic array of TRecordReference into its corresponding IDs
procedure RecordRefToID(var aArray: TInt64DynArray);

/// get the order table name from a SQL statement
// - return the word following any 'ORDER BY' statement
// - return 'RowID' if none found
function SQLGetOrder(const SQL: RawUTF8): RawUTF8;

{$ifdef PUREPASCAL}{$ifdef HASINLINE}
/// this function is published only for class function TSQLRecord.RecordProps()
// internal call after inlining
function PropsCreate(aTable: TSQLRecordClass): TSQLRecordProperties;
{$endif}{$endif}

/// low-level function to retrieve the class instance implementing a given interface
// - this will work with interfaces stubs generated by the compiler, but also
// with TInterfaceFactory.CreateFakeInstance kind of classes
// - returns nil if aValue is nil or not recognized
function ObjectFromInterface(const aValue: IInterface): TObject;

/// low-level function to check if a class instance, retrieved from its
// interface variable, does in fact implement a given interface
// - this will call ObjectFromInterface(), so will work with interfaces
// stubs generated by the compiler, but also with
// TInterfaceFactory.CreateFakeInstance kind of classes
function ObjectFromInterfaceImplements(const aValue: IInterface;
  const aInterface: TGUID): boolean;

/// assign a Weak interface reference, to be used for circular references
// - by default setting aInterface.Field := aValue will increment the internal
// reference count of the implementation object: when underlying objects reference
// each other via interfaces (e.g. as parent and children), what causes the
// reference count to never reach zero, therefore resulting in memory links
// - to avoid this issue, use this procedure instead
procedure SetWeak(aInterfaceField: PIInterface; const aValue: IInterface);
 // {$ifdef HASINLINE}inline;{$endif} raise compilation Internal Error C2170

/// assign a Weak interface reference, which will be ZEROed (set to nil) when
// the corresponding object will be released
// - this function is bit slower than SetWeak, but will avoid any GPF, by
// maintaining a list of per-instance weak interface field reference, and
// hook the FreeInstance virtual method in order to reset any reference to nil:
// FreeInstance will be overridden for this given class VMT only (to avoid
// unnecessary slowdown of other classes), calling the previous method afterward
// (so will work even with custom FreeInstance implementations)
// - for faster possible retrieval, it will assign the unused vmtAutoTable VMT
// entry trick (just like TSQLRecord.RecordProps) - note that it will be
// compatible also with interfaces implemented via TSQLRecord children
// - thread-safe implementation, using a per-class fast lock
procedure SetWeakZero(aObject: TObject; aObjectInterfaceField: PIInterface;
  const aValue: IInterface);

{$ifdef ISDELPHIXE} // class helper requires Delphi 2006 or newer but are buggy before XE :(
type
  /// TWeakZeroInterfaceHelper is a class helper that allows you to use
  // SetWeakZero() in any class without specifying the Self parameter
  TWeakZeroInterfaceHelper = class helper for TObject
  protected
    /// Use SetWeak0 to assign an interface to a weak interface field
    // - this is just a wrapper around the global SetWeakZero() function
    procedure SetWeak0(aObjectInterfaceField: PIInterface; const aValue: IInterface);
  end;
{$endif}

var
  /// if this variable is TRUE, the URIRequest() function won't use
  // Win32 API GlobalAlloc() function, but fastest native Getmem()
  // - can be also useful for debugg
  USEFASTMM4ALLOC: boolean = false;

/// this function can be exported from a DLL to remotely access to a TSQLRestServer
// - use TSQLRestServer.ExportServer to assign a server to this function
// - return 501 HTTP_NOTIMPLEMENTED if no TSQLRestServer.ExportServer has been assigned
// - memory for Resp and Head are allocated with GlobalAlloc(): client must release
// this pointers with GlobalFree() after having retrieved their content
// - simply use TSQLRestClientURIDll to access to an exported URIRequest() function
function URIRequest(url, method, SendData: PUTF8Char; Resp, Head: PPUTF8Char): Int64Rec; cdecl;


threadvar
  /// this thread-specific variable will be set with the currently running
  // service context (on the server side)
  // - note that in case of direct server side execution of the service, this
  // information won't be filled, so the safest (and slightly faster) access
  // to the TSQLRestServer instance associated with a service is to inherit your
  // implementation class from TInjectableObjectRest, and not use this threadvar
  // - is set by TServiceFactoryServer.ExecuteMethod() just before calling the
  // implementation method of a service, allowing to retrieve the current
  // execution context - Request member is set from a client/server execution:
  // Request.Server is the safe access point to the underlying TSQLRestServer,
  // in such context - also consider the CurrentServiceContextServer function to
  // retrieve directly the running TSQLRestServer (if any)
  // - its content is reset to zero out of the scope of a method execution
  // - when used, a local copy or a PServiceRunningContext pointer should better
  // be created, since accessing a threadvar has a non negligible performance
  // cost - for instance, if you want to use a "with" statement:
  // ! with PServiceRunningContext(@ServiceContext)^ do
  // !   ... access TServiceRunningContext members
  // or as a local variable:
  // !var context: PServiceRunningContext;
  // !    inContentType: RawUTF8;
  // !begin
  // !  context := @ServiceContext; // threadvar access once
  // !  ...
  // !  inContentType := context.Request.Call^.InBodyType;
  // !end;
  // - when accessed from a package, use function CurrentServiceContext()
  // instead, to circumvent a Delphi RTL/compiler restriction (bug?)
  ServiceContext: TServiceRunningContext;

/// wrapper function to retrieve the global ServiceContext threadvar value
// - to be used when accessing the value from a package, to circumvent a
// Delphi RTL/compiler restriction (bug?)
// - for a cleaner SOA/DI approach, consider using TInjectableObjectRest
function CurrentServiceContext: TServiceRunningContext;

/// wrapper function to retrieve the current REST server instance from
// the global ServiceContext threadvar value
// - may return nil if ServiceContext.Request is nil: in this case,
// you should better implement your service by inheriting the implementation
// class from TInjectableObjectRest
function CurrentServiceContextServer: TSQLRestServer;

/// returns a safe 256-bit hexadecimal nonce, changing every 5 minutes
// - as used e.g. by TSQLRestServerAuthenticationDefault.Auth
// - this function is very fast, even if cryptographically-level SHA-3 secure
function CurrentServerNonce(Previous: boolean=false): RawUTF8;

function ToText(ft: TSQLFieldType): PShortString; overload;
function ToText(vk: TSQLRecordVirtualKind): PShortString; overload;
function ToText(e: TSQLEvent): PShortString; overload;
function ToText(he: TSQLHistoryEvent): PShortString; overload;
function ToText(o: TSQLOccasion): PShortString; overload;
function ToText(dft: TSQLDBFieldType): PShortString; overload;
function ToText(si: TServiceInstanceImplementation): PShortString; overload;
function ToText(cmd: TSQLRestServerURIContextCommand): PShortString; overload;
function ToText(op: TSQLQueryOperator): PShortString; overload;
function ToText(V: TInterfaceMockSpyCheck): PShortString; overload;
function ToText(m: TSQLURIMethod): PShortString; overload;
function ToText(o: TSynTableStatementOperator): PShortString; overload;
function ToText(t: TSQLVirtualTableTransaction): PShortString; overload;
function ToText(a: TSQLRestServerAuthenticationSignedURIAlgo): PShortString; overload;
function ToText(res: TNotifyAuthenticationFailedReason): PShortString; overload;


{ ************ Logging classes and functions }

type
  /// logging class with enhanced RTTI
  // - will write TObject/TSQLRecord, enumerations and sets content as JSON
  // - is the default logging family used by the mORMot framework
  // - mORMotDB.pas unit will set SynDBLog := TSQLLog
  // - mORMotSQLite3.pas unit will set SynSQLite3Log := TSQLLog
  TSQLLog = TSynLog;

{$ifdef WITHLOG}
var
  /// TSQLLog class is used for logging for all our ORM related functions
  // - this global variable can be used to customize it for the whole process
  // - each TSQLRest.LogClass property is set by default to this SQLite3Log
  // - you can override the TSQLRest.LogClass property value to customize it
  // for a given REST instance
  SQLite3Log: TSynLogClass = TSQLLog;

  /// TSQLogClass used by overriden SetThreadName() function to name the thread
  SetThreadNameLog: TSynLogClass = TSQLLog;
{$endif}

implementation

{$ifdef FPC}
uses
  {$ifndef MSWINDOWS}
  SynFPCLinux, // includes minimal redirection to FPC's TypInfo.pp unit
  BaseUnix,
  Unix,
  {$endif}
  dynlibs;
{$endif FPC}

// ************ some RTTI and SQL mapping routines

procedure SetID(P: PUTF8Char; var result: TID);
{$ifdef CPU64}
begin // PtrInt is already int64 -> call PtrInt version
  result := GetInteger(P);
{$else}
{$ifdef HASINLINENOTX86}
begin
  {$ifdef VER3_0} // FPC issue woraround
  SetInt64(P,result);
  {$else}
  SetInt64(P,PInt64(@result)^);
  {$endif}
{$else}
asm
        jmp     SynCommons.SetInt64
{$endif HASINLINENOTX86}
{$endif CPU64}
end;

procedure SetID(const U: RawByteString; var result: TID);
{$ifdef CPU64}
begin // PtrInt is already int64 -> call PtrInt version
  result := GetInteger(pointer(U));
{$else}
{$ifdef HASINLINENOTX86}
begin
  SetID(pointer(U),result);
{$else}
asm
        jmp     SynCommons.SetInt64
{$endif HASINLINENOTX86}
{$endif CPU64}
end;

function TSQLRecordDynArrayCompare(const Item1,Item2): integer;
{$ifdef CPUX64}  // very efficient branchless asm - rcx/rdi=Item1 rdx/rsi=Item2
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        mov     rcx, qword ptr[Item1]
        mov     rdx, qword ptr[Item2]
        mov     rcx, qword ptr[rcx+TSQLRecord.fID]
        mov     rdx, qword ptr[rdx+TSQLRecord.fID]
        xor     eax, eax
        cmp     rcx, rdx
        seta    al
        sbb     eax, 0
end;
{$else}
begin // we assume Item1<>nil and Item2<>nil
  result := {$ifdef HASINLINE}CompareQWord{$else}SortDynArrayQWord{$endif}(
    TSQLRecord(Item1).fID,TSQLRecord(Item2).fID);
end;
{$endif CPUX64}

function TSQLRecordDynArrayHashOne(const Elem; Hasher: THasher): cardinal;
begin
  with PQWordRec(@TSQLRecord(Elem).fID)^ do
    result := crc32cBy4(L,H);
end;

{$ifdef HASDIRECTTYPEINFO}
type
  Deref = PTypeInfo;
{$else}
function Deref(Info: PPTypeInfo): PTypeInfo;
{$ifdef HASINLINENOTX86} inline;
begin
  if Info=nil then
    result := pointer(Info) else
    result := Info^;
end;
{$else}
asm     // Delphi is so bad at compiling above code...
        test    eax, eax
        jz      @z
        mov     eax, [eax]
        ret
@z:     db      $f3 // rep ret
end;
{$endif HASINLINENOTX86}
{$endif HASDIRECTTYPEINFO}


{$ifndef FPC} /// no RTTI alignment under Delphi - see also SynFPCTypInfo
type
  AlignToPtr = pointer;
  AlignTypeData = pointer;
  AlignTypeDataClean = pointer;
  UnalignToDouble = Double;
{$endif FPC}

{ some inlined methods }

function GetTypeData(const info: TTypeInfo): pointer;
{$ifdef HASINLINE}inline;{$endif}
begin
  result := AlignTypeData(PAnsiChar(@info)+2+PByte(PAnsiChar(@info)+1)^);
end;

function GetTypeDataClean(const info: TTypeInfo): pointer;
{$ifdef HASINLINE}inline;{$endif}
begin
  result := AlignTypeDataClean(PAnsiChar(@info)+2+PByte(PAnsiChar(@info)+1)^);
end;

function TTypeInfo.ClassType: PClassType;
{$ifdef HASINLINENOTX86}
begin
  result := GetTypeData(self);
end;
{$else}
asm // very fast code
        movzx   edx, byte ptr[eax].TTypeInfo.Name
        lea     eax, [eax + edx].TTypeInfo.Name[1]
end;
{$endif}

function TTypeInfo.RecordType: PRecordType;
{$ifdef HASINLINENOTX86}
begin
  result := GetTypeData(self);
end;
{$else}
asm // very fast code
        movzx   edx, byte ptr[eax].TTypeInfo.Name
        lea     eax, [eax + edx].TTypeInfo.Name[1]
end;
{$endif}

function TTypeInfo.InterfaceType: PInterfaceTypeData;
{$ifdef HASINLINENOTX86}
begin
  result := GetTypeData(self);
end;
{$else}
asm // very fast code
        movzx   edx, byte ptr[eax].TTypeInfo.Name
        lea     eax, [eax + edx].TTypeInfo.Name[1]
end;
{$endif}

function TTypeInfo.FloatType: TFloatType;
begin
  result := PFloatType(GetTypeData(self))^;
end;

function TTypeInfo.OrdType: TOrdType;
begin
  result := POrdType(GetTypeData(self))^;
end;

function TTypeInfo.IsQWord: boolean;
begin
  {$ifdef FPC}
  result := Kind=tkQWord;
  {$else}
  if @self=TypeInfo(QWord) then
    result := true else
    {$ifdef UINICODE}if Kind=tkInt64 then // check MinInt64Value>MaxInt64Value
      with PHash128Rec(PAnsiChar(@Name[1])+ord(Name[0]))^ do
        result := Lo>Hi else {$endif}
        result := false;
  {$endif}
end;

function TPropInfo.Getter(Instance: TObject; Call: PMethod): TPropInfoCall;
begin
  if GetProc=0 then begin // no 'read' was defined -> try from 'write' field
    if (SetProc<>0) and
       ({$ifdef FPC}(PropProcs shr 2)and 3{$else}PropWrap(SetProc).Kind{$endif}=ptField) then begin
      Call.Data := pointer(PtrUInt(Instance)+SetProc{$ifndef FPC}and $00ffffff{$endif});
      result := picField;
    end else
      result := picNone;
    exit;
  end else
  case {$ifdef FPC}integer(PropProcs)and 3{$else}PropWrap(GetProc).Kind{$endif} of
  ptField: begin  // GetProc is an offset to the instance fields
    Call.Data := pointer(PtrUInt(Instance)+GetProc{$ifndef FPC}and $00ffffff{$endif});
    result := picField;
    exit;
  end;
  ptVirtual: // GetProc is an offset to the class VMT
    Call.Code := PPointer(PPtrUInt(Instance)^+{$ifndef FPC}word{$endif}(GetProc))^;
  {$ifdef FPC} ptConst: exit(picNone); {$endif} // never happen on properties?
  else // ptStatic: GetProc is the method code itself
    Call.Code := pointer(GetProc);
  end;
  Call.Data := Instance;
  if {$ifdef FPC}(PropProcs shr 6)and 1{$else}Index{$endif}<>NO_INDEX then
    result := picIndexed else
    result := picMethod;
end;

function TPropInfo.Setter(Instance: TObject; Call: PMethod): TPropInfoCall;
begin
  if SetProc=0 then begin // no 'write' was defined -> try from 'read' field
    if (GetProc<>0) and
       ({$ifdef FPC}integer(PropProcs)and 3{$else}PropWrap(GetProc).Kind{$endif}=ptField) then begin
      Call.Data := pointer(PtrUInt(Instance)+GetProc{$ifndef FPC}and $00ffffff{$endif});
      result := picField;
    end else
      result := picNone;
    exit;
  end else
  case {$ifdef FPC}(PropProcs shr 2)and 3{$else}PropWrap(SetProc).Kind{$endif} of
  ptField: begin  // SetProc is an offset to the instance fields
    Call.Data := pointer(PtrUInt(Instance)+SetProc{$ifndef FPC}and $00ffffff{$endif});
    result := picField;
    exit;
  end;
  ptVirtual: // SetProc is an offset to the class VMT
    Call.Code := PPointer(PPtrUInt(Instance)^+{$ifndef FPC}word{$endif}(SetProc))^;
  {$ifdef FPC} ptConst: exit(picNone); {$endif}
  else // ptStatic: SetProc is the method code itself
    Call.Code := pointer(SetProc);
  end;
  Call.Data := Instance;
  if {$ifdef FPC}(PropProcs shr 6)and 1{$else}Index{$endif}<>NO_INDEX then
    result := picIndexed else
    result := picMethod;
end;

function TPropInfo.GetterAddr(Instance: pointer): pointer;
{$ifdef HASINLINENOTX86}
begin
  result := Pointer(PtrUInt(Instance)+GetProc{$ifndef FPC} and $00ffffff{$endif});
end;
{$else}
asm
        mov     eax, [eax].TPropInfo.GetProc
        and     eax, $00ffffff
        add     eax, edx
end;
{$endif}

function TPropInfo.SetterAddr(Instance: pointer): pointer;
begin
  result := Pointer(PtrUInt(Instance)+SetProc{$ifndef FPC} and $00ffffff{$endif});
end;

function TPropInfo.TypeInfo: PTypeInfo;
{$ifdef HASINLINENOTX86}
begin
  {$ifndef HASDIRECTTYPEINFO}
  if PropType<>nil then
    result := PropType^ else
  {$endif}
    result := pointer(PropType);
end;
{$else}
asm // Delphi is so bad at compiling above code...
        mov     eax, [eax].TPropInfo.PropType
        test    eax, eax
        jz      @z
        mov     eax, [eax]
        ret
@z:     db      $f3 // rep ret
end;
{$endif HASINLINENOTX86}

function TPropInfo.GetterIsField: boolean;
begin
  result := {$ifdef FPC}integer(PropProcs)and 3{$else}PropWrap(GetProc).Kind{$endif}=ptField;
end;

function TPropInfo.SetterIsField: boolean;
begin
  result := {$ifdef FPC}(PropProcs shr 2)and 3{$else}PropWrap(SetProc).Kind{$endif}=ptField;
end;

function TPropInfo.GetFieldAddr(Instance: TObject): pointer;
begin
  if not GetterIsField then
    if not SetterIsField then
      // both are methods -> returns nil
      result := nil else
      // field - Setter is the field offset in the instance data
      result := SetterAddr(Instance) else
    // field - Getter is the field offset in the instance data
    result := GetterAddr(Instance);
end;

{$ifdef HASINLINENOTX86}
function TPropInfo.Next: PPropInfo;
begin
  result := AlignToPtr(PAnsiChar(@Name[0]) + SizeOf(Name[0]) + Length(Name));
end;
{$else}
function TPropInfo.Next: PPropInfo;
asm     // very fast code
        movzx   edx, byte ptr[eax].TPropInfo.Name
        lea     eax, [eax + edx].TPropInfo.Name[1]
end;
{$endif HASINLINENOTX86}

function TPropInfo.WriteIsDefined: boolean;
begin
  {$ifdef FPC} // see typinfo.IsWriteableProp
  result := (SetProc<>0) and ((PropProcs shr 2)and 3 in [ptField..ptVirtual]);
  {$else}
  result := SetProc<>0;
  {$endif}
end;

function GetInterfaceFromEntry(Instance: TObject; Entry: PInterfaceEntry; out Obj): boolean;
  {$ifndef FPC}
  procedure UseImplGetter(Instance: TObject; ImplGetter: PtrInt; var result: IInterface);
  type // function(Instance: TObject) trick does not work with CPU64 :(
    TGetProc = function: IInterface of object;
  var Call: TMethod;
  begin // sub-procedure to avoid try..finally for TGetProc(): Interface result
    if PropWrap(ImplGetter).Kind=ptVirtual then
      Call.Code := PPointer(PPtrInt(Instance)^+SmallInt(ImplGetter))^ else
      Call.Code := Pointer(ImplGetter);
    Call.Data := Instance;
    result := TGetProc(Call);
  end;
  {$endif}
begin
  Pointer(Obj) := nil;
  if Entry<>nil then
    if Entry^.IOffset <> 0 then begin
      Pointer(Obj) := Pointer(PtrInt(PtrUInt(Instance))+Entry^.IOffset);
      if Pointer(Obj)<>nil then
        IInterface(Obj)._AddRef;
    end
  {$ifndef FPC} else
    if PropWrap(Entry^.ImplGetter).Kind=ptField then
      IInterface(Obj) := IInterface(PPointer(PtrUInt(Instance)+PtrUInt(Entry^.ImplGetter and $00ffffff))^) else
      UseImplGetter(Instance,Entry^.ImplGetter,IInterface(Obj)){$endif};
  Result := Pointer(Obj)<>nil;
end;

function InternalMethodInfo(aClassType: TClass; const aMethodName: ShortString): PMethodInfo;
var Count, i: integer;
begin
  while aClassType<>nil do begin
    result := PPointer(PtrInt(PtrUInt(aClassType))+vmtMethodTable)^;
    if result<>nil then begin
      {$ifdef FPC}
      Count := PCardinal(result)^;
      inc(PCardinal(result));
      {$else}
      Count := PWord(result)^;
      inc(PWord(result));
      {$endif}
      for i := 0 to Count-1 do
      if IdemPropName(result^.Name{$ifdef FPC}^{$endif},aMethodName) then
        exit else
        {$ifdef FPC}
        inc(result);
        {$else}
        inc(PByte(result),result^.Len);
        {$endif}
    end;
    {$ifdef FPC}
    aClassType := GetClassParent(aClassType); // vmtParent slot is reference on FPC
    if aClassType=nil then
    {$else}
    if PPointer(PtrInt(aClassType)+vmtParent)^<>nil then
      aClassType := PPointer(PPointer(PtrInt(aClassType)+vmtParent)^)^ else
    {$endif}
      break;
  end;
  result := nil;
end;

function TMethodInfo.MethodAddr: Pointer;
begin
  if @self<>nil then
    result := Addr else
    result := @self;
end;

function TMethodInfo.ReturnInfo: PReturnInfo;
begin // see http://hallvards.blogspot.fr/2006/09/extended-class-rtti.html
  if @self<>nil then begin
    {$ifdef FPC}
    result := pointer(PtrUInt(@Addr)+SizeOf(Pointer));
    {$else}
    result := pointer(PAnsiChar(@Name[1])+ord(Name[0]));
    if PtrUInt(result)-PtrUInt(@self)=Len then
      result := nil; // no method details available
    {$endif FPC}
  end else
      result := @self;
end;

function TReturnInfo.Param: PParamInfo;
begin
  result := Pointer(PtrUInt(@self)+SizeOf(TReturnInfo));
end;

function TParamInfo.Next: PParamInfo;
begin
  result := AlignToPtr(PAnsiChar(@Name[1])+ord(Name[0]));
  {$ifdef ISDELPHI2010}
  inc(PByte(result),PWord(result)^); // ignore optional attributes
  {$endif}
end;

function InternalClassProp(ClassType: TClass): PClassProp;
{$ifdef FPC}
begin
  with PTypeInfo(PPointer(PtrUInt(ClassType)+vmtTypeInfo)^)^.ClassType^ do
    result := AlignToPtr(PAnsiChar(@UnitName[1])+ord(UnitName[0]));
{$else}
{$ifdef HASINLINENOTX86}
var PTI: PTypeInfo;
begin // code is a bit abstract, but compiles very well
  PTI := PPointer(PtrInt(ClassType)+vmtTypeInfo)^;
  if PTI<>nil then // avoid GPF if no RTTI available for this class
    with PTI^, PClassType(@Name[ord(Name[0])+1])^ do
      result := PClassProp(@UnitName[ord(UnitName[0])+1]) else
    result := nil;
{$else}
asm // this code is the fastest possible
        mov     eax, [eax + vmtTypeInfo]
        test    eax, eax
        jz      @z // avoid GPF if no RTTI available for this class
        movzx   edx, byte ptr[eax].TTypeInfo.Name
        lea     eax, [eax + edx].TTypeInfo.Name[1]
        movzx   edx, byte ptr[eax].TClassType.UnitName
        lea     eax, [eax + edx].TClassType.UnitName[1].TClassProp
@z:
{$endif HASINLINENOTX86}
{$endif FPC}
end;

function InternalClassPropInfo(ClassType: TClass; out PropInfo: PPropInfo): integer;
{$ifdef FPC}
var CP: PClassProp;
{$endif}
begin
  if ClassType<>nil then begin
    {$ifdef FPC}
    CP := InternalClassProp(ClassType);
    if CP<>nil then begin // no more RTTI information available
      PropInfo := AlignToPtr(@CP^.PropList);
      result := CP^.PropCount;
    {$else} // code is a bit abstract, but compiles very well for Delphi/Kylix
    inc(PByte(ClassType),vmtTypeInfo);
    if PPointer(ClassType)^<>nil then // avoid GPF if no RTTI available
      with PTypeInfo(PPointer(ClassType)^)^, PClassType(@Name[ord(Name[0])+1])^,
        PClassProp(@UnitName[ord(UnitName[0])+1])^ do begin
      PropInfo := @PropList;
      result := PropCount;
    {$endif FPC}
      exit;
    end;
  end;
  result := 0;
end;

function ClassFieldCountWithParents(ClassType: TClass;
  onlyWithoutGetter: boolean): integer;
var CP: PClassProp;
    P: PPropInfo;
    i: integer;
begin
  result := 0;
  while ClassType<>nil do begin
    CP := InternalClassProp(ClassType);
    if CP=nil then
      break; // no RTTI information (e.g. reached TObject level)
    if onlyWithoutGetter then begin
      P := AlignToPtr(@CP^.PropList);
      for i := 1 to CP^.PropCount do begin
        if P^.GetterIsField then
          inc(result);
        P := P^.Next;
      end;
    end else
      inc(result,CP^.PropCount);
    ClassType := GetClassParent(ClassType);
  end;
end;

function ClassHasPublishedFields(ClassType: TClass): boolean;
var CP: PClassProp;
begin
  result := true;
  while ClassType<>nil do begin
    CP := InternalClassProp(ClassType);
    if CP=nil then
      break; // no RTTI information (e.g. reached TObject level)
    if CP^.PropCount>0 then
      exit;
    ClassType := GetClassParent(ClassType);
  end;
  result := false;
end;

function ClassHierarchyWithField(ClassType: TClass): TClassDynArray;
procedure InternalAdd(C: TClass; var list: TClassDynArray);
var P: PClassProp;
begin
  if C=nil then
    exit;
  InternalAdd(GetClassParent(C),list);
  P := InternalClassProp(C);
  if (P<>nil) and (P^.PropCount>0) then
    ObjArrayAdd(list,pointer(C));
end;
begin
  result := nil;
  InternalAdd(ClassType,result);
end;

function ClassFieldAllProps(ClassType: TClass; Types: TTypeKinds): PPropInfoDynArray;
var CP: PClassProp;
    P: PPropInfo;
    i,n: integer;
begin
  n := 0;
  result := nil;
  while ClassType<>nil do begin
    CP := InternalClassProp(ClassType);
    if CP=nil then
      break; // no RTTI information (e.g. reached TObject level)
    if CP^.PropCount>0 then begin
      SetLength(result,n+CP^.PropCount);
      P := AlignToPtr(@CP^.PropList);
      for i := 1 to CP^.PropCount do begin
        if P^.PropType^.Kind in Types then begin
          result[n] := P;
          inc(n);
        end;
        P := AlignToPtr(PAnsiChar(@P^.Name[1])+ord(P^.Name[0])); // := P^.Next
      end;
    end;
    ClassType := GetClassParent(ClassType);
  end;
  SetLength(result,n);
end;

function ClassFieldNamesAllProps(ClassType: TClass; IncludePropType: boolean;
  Types: TTypeKinds): TRawUTF8DynArray;
var props: PPropInfoDynArray;
    n,i: integer;
begin
  result := nil;
  props := ClassFieldAllProps(ClassType,Types);
  n := length(props);
  SetLength(result,n);
  for i := 0 to n-1 do
    if IncludePropType then
      FormatUTF8('%: %',[props[i]^.Name,props[i]^.PropType^.Name],result[i]) else
      ShortStringToAnsi7String(props[i]^.Name,result[i]);
end;

function ClassFieldNamesAllPropsAsText(ClassType: TClass; IncludePropType: boolean;
  Types: TTypeKinds): RawUTF8;
begin
  result := RawUTF8ArrayToCSV(
    ClassFieldNamesAllProps(ClassType,IncludePropType,Types),', ');
end;

function ClassFieldProp(ClassType: TClass; const PropName: shortstring): PPropInfo;
begin
  if ClassType<>nil then
    result := InternalClassProp(ClassType)^.FieldProp(PropName) else
    result := nil;
end;

function ClassFieldPropWithParents(aClassType: TClass; const aPropName: shortstring;
  aCaseSensitive: boolean): PPropInfo;
var n, i: integer;
begin
  while aClassType<>nil do begin
    n := InternalClassPropInfo(aClassType,result);
    if n<>0 then
      if aCaseSensitive then
        for i := 1 to n do
          if result^.Name=aPropName then
            exit else
            result := result^.Next else
        for i := 1 to n do
          if (result^.Name[0]=aPropName[0]) and
             IdemPropNameUSameLen(@result^.Name[1],@aPropName[1],ord(aPropName[0])) then
            exit else
            result := result^.Next;
    aClassType := GetClassParent(aClassType);
  end;
  result := nil;
end;

function ClassFieldPropWithParentsFromUTF8(aClassType: TClass; PropName: PUTF8Char;
  PropNameLen: integer; aCaseSensitive: boolean): PPropInfo;
var n, i: integer;
begin
  if PropNameLen<>0 then
    while aClassType<>nil do begin
      n := InternalClassPropInfo(aClassType,result);
      if n<>0 then
        if aCaseSensitive then
          for i := 1 to n do
            if (result^.Name[0]=AnsiChar(PropNameLen)) and
               CompareMemFixed(@result^.Name[1],PropName,PropNameLen) then
              exit else
              result := result^.Next else
        for i := 1 to n do
          if (result^.Name[0]=AnsiChar(PropNameLen)) and
             IdemPropNameUSameLen(@result^.Name[1],PropName,PropNameLen) then
            exit else
            result := result^.Next;
      aClassType := GetClassParent(aClassType);
    end;
  result := nil;
end;

function ClassFieldPropWithParentsFromClassType(aClassType,aSearchedClassType: TClass): PPropInfo;
var i: integer;
begin
  if aSearchedClassType<>nil then
    while aClassType<>nil do begin
      for i := 1 to InternalClassPropInfo(aClassType,result) do
        if (result^.PropType^.Kind=tkClass) and
           (result^.PropType^.ClassType^.ClassType=aSearchedClassType) then
          exit else
          result := result^.Next;
      aClassType := GetClassParent(aClassType);
    end;
  result := nil;
end;

function ClassFieldPropWithParentsInheritsFromClassType(aClassType,aSearchedClassType: TClass): PPropInfo;
var i: integer;
begin
  if aSearchedClassType<>nil then
    while aClassType<>nil do begin
      for i := 1 to InternalClassPropInfo(aClassType,result) do
        if (result^.PropType^.Kind=tkClass) and
           (result^.PropType^.InheritsFrom(aSearchedClassType)) then
          exit else
          result := result^.Next;
      aClassType := GetClassParent(aClassType);
    end;
  result := nil;
end;

function ClassFieldPropWithParentsFromClassOffset(aClassType: TClass; aSearchedOffset: pointer): PPropInfo;
var i: integer;
begin
  if aSearchedOffset<>nil then
    while aClassType<>nil do begin
      for i := 1 to InternalClassPropInfo(aClassType,result) do
        if result^.GetFieldAddr(nil)=aSearchedOffset then
          exit else
          result := result^.Next;
      aClassType := GetClassParent(aClassType);
    end;
  result := nil;
end;

function ClassFieldInstance(Instance: TObject; const PropName: shortstring;
  PropClassType: TClass; out PropInstance): boolean;
var P: PPropInfo;
begin
  result := false;
  if Instance=nil then
    exit;
  P := ClassFieldPropWithParents(PPointer(Instance)^,PropName);
  if (P=nil) or (P^.PropType^.Kind<>tkClass) or
     not P^.PropType^.InheritsFrom(PropClassType) then
    exit;
  TObject(PropInstance) := P^.GetObjProp(Instance);
  result := true;
end;

function ClassFieldInstance(Instance: TObject; PropClassType: TClass;
  out PropInstance): boolean;
var P: PPropInfo;
begin
  result := false;
  if Instance=nil then
    exit;
  P := ClassFieldPropWithParentsFromClassType(PPointer(Instance)^,PropClassType);
  if P=nil then
    exit;
  TObject(PropInstance) := P^.GetObjProp(Instance);
  result := true;
end;

function ClassFieldInt64(Instance: TObject; const PropName: ShortString;
  out PropValue: Int64): boolean;
var P: PPropInfo;
begin
  result := false;
  if Instance=nil then
    exit;
  P := ClassFieldPropWithParents(PPointer(Instance)^,PropName);
  if P=nil then
    exit;
  PropValue := P^.GetInt64Value(Instance);
  result := true;
end;

function ClassFieldInstances(Instance: TObject; PropClassType: TClass): TObjectDynArray;
var nested: PPropInfoDynArray;
    i: integer;
begin
  result := nil;
  if Instance=nil then
    exit;
  nested := ClassFieldAllProps(PPointer(Instance)^,[tkClass]);
  for i := 0 to high(nested) do
    with nested[i]^ do
      if PropType^.InheritsFrom(PropClassType) then
        ObjArrayAdd(result,GetObjProp(Instance));
end;

function GetObjectComponent(Obj: TPersistent; const ComponentName: shortstring;
  ComponentClass: TClass): pointer;
var P: PPropInfo;
begin
  result := nil;
  if Obj=nil then
    exit;
  P := ClassFieldPropWithParents(Obj.ClassType,ComponentName);
  if (P<>nil) and (P^.PropType^.Kind=tkClass) then
    if P^.PropType^.InheritsFrom(ComponentClass) then
      result := P^.GetObjProp(Obj);
end;

function GetEnumCaption(aTypeInfo: PTypeInfo; const aIndex): string;
begin
  if (aTypeInfo=nil) or (aTypeInfo^.Kind<>tkEnumeration) then
    result := '' else
    result := aTypeInfo^.EnumBaseType^.GetCaption(PByte(@aIndex)^);
end;

function GetEnumNameTrimed(aTypeInfo: PTypeInfo; const aIndex): RawUTF8;
begin
  if (aTypeInfo=nil) or (aTypeInfo^.Kind<>tkEnumeration) then
    result := '' else
    result := aTypeInfo^.EnumBaseType^.GetEnumNameTrimed(aIndex);
end;

function GetSetNameCSV(aTypeInfo: PTypeInfo; const aValue): RawUTF8;
begin
  if (aTypeInfo=nil) or (aTypeInfo^.Kind<>tkSet) then
    result := '' else
    result := aTypeInfo^.SetEnumType^.GetSetNameCSV(integer(aValue));
end;

{$ifndef NOVARIANTS}

function DocVariantToObject(var doc: TDocVariantData; obj: TObject): boolean;
var p: integer;
    prop: PPropInfo;
begin
  if (doc.Kind=dvObject) and (doc.Count>0) and (obj<>nil) then begin
    for p := 0 to doc.Count-1 do begin
      prop := ClassFieldPropWithParentsFromUTF8(
        PPointer(obj)^,pointer(doc.Names[p]),length(doc.Names[p]));
      if prop<>nil then
        prop^.SetFromVariant(obj,doc.Values[p]);
    end;
    result := true;
  end else
    result := false;
end;

procedure DocVariantToObjArray(var arr: TDocVariantData; var objArray;
  objClass: TClass);
var instance: TClassInstance;
begin
  instance.Init(objClass);
  DocVariantToObjArray(arr,objArray,@instance);
end;

procedure DocVariantToObjArray(var arr: TDocVariantData; var objArray;
  objClass: PClassInstance);
var i: integer;
    obj: TObjectDynArray absolute objArray;
begin
  if objClass=nil then
    exit;
  ObjArrayClear(obj);
  if not(dvoIsArray in arr.Options) or (arr.Count=0) then
    exit;
  SetLength(obj,arr.Count);
  for i := 0 to arr.Count-1 do begin
    obj[i] := objClass^.CreateNew;
    DocVariantToObject(_Safe(arr.Values[i])^,obj[i]);
  end;
end;

function ObjectDefaultToVariant(aClass: TClass; aOptions: TDocVariantOptions): variant;
var instance: TClassInstance;
    temp: TObject;
    json: RawUTF8;
begin
  VarClear(result);
  instance.Init(aClass);
  temp := instance.CreateNew;
  try
    json := ObjectToJSON(temp,[woDontStoreDefault]);
    PDocVariantData(@result)^.InitJSONInPlace(pointer(json),aOptions);
  finally
    temp.Free;
  end;
end;

{$endif}

type // those classes will be used to register globally some classes for JSON
  TJSONSerializerRegisteredClassAbstract = class(TSynList)
  protected
    fLastClass: TClass;
    fSafe: TSynLocker;
  public
    constructor Create; override;
    destructor Destroy; override;
  end;

  TJSONSerializerRegisteredClass = class(TJSONSerializerRegisteredClassAbstract)
  protected
  public
    procedure AddOnce(aItemClass: TClass);
    function Find(JSON: PUTF8Char; AndRegisterClass: boolean): TClass; overload;
    function Find(aClassName: PUTF8Char; aClassNameLen: integer): TClass; overload;
  end;

var
  JSONSerializerRegisteredClass: TJSONSerializerRegisteredClass=nil;


{ TSQLPropInfo }

const
  NULL_SHORTSTRING: string[1] = '';

function TSQLPropInfo.GetSQLFieldTypeName: PShortString;
begin
  if self=nil then
    result := @NULL_SHORTSTRING else
    result := ToText(fSQLFieldType);
end;

function TSQLPropInfo.GetSQLFieldRTTITypeName: RawUTF8;
begin
  result := GetDisplayNameFromClass(ClassType);
  if IdemPChar(pointer(result),'PROPINFO') then
    delete(result,1,8);
end;

function TSQLPropInfo.GetNameDisplay: string;
begin
  GetCaptionFromPCharLen(pointer(fName),result);
end;

procedure TSQLPropInfo.TextToBinary(Value: PUTF8Char; var result: RawByteString);
begin
  result := BlobToTSQLRawBlob(Value);
end;

procedure TSQLPropInfo.BinaryToText(var Value: RawUTF8; ToSQL: boolean;
  wasSQLString: PBoolean);
begin
  if Value='' then begin
    if wasSQLString<>nil then
      wasSQLString^ := false;
    Value := NULL_STR_VAR;
  end else begin
    if wasSQLString<>nil then
      wasSQLString^ := true;
    if ToSQL then
      // encode as BLOB literals (e.g. "X'53514C697465'")
      Value := TSQLRawBlobToBlob(TSQLRawBlob(Value)) else
      // JSON content is e.g. '\uFFF0base64encodedbinary'
      Value := BinToBase64WithMagic(Value);
  end;
end;

{$ifndef NOVARIANTS}
function NullableTypeToSQLFieldType(aType: pointer): TSQLFieldType;
begin
  if aType<>nil then
    if aType<>TypeInfo(TNullableInteger) then
      if aType<>TypeInfo(TNullableUTF8Text) then
        if aType<>TypeInfo(TNullableBoolean) then
          if aType<>TypeInfo(TNullableFloat) then
            if aType<>TypeInfo(TNullableCurrency) then
              if aType<>TypeInfo(TNullableDateTime) then
                if aType<>TypeInfo(TNullableTimeLog) then begin
                  result := sftUnknown;
                  exit;
                end else
                result := sftTimeLog else
              result := sftDateTime else
            result := sftCurrency else
          result := sftFloat else
        result := sftBoolean else
      result := sftUTF8Text else
    result := sftInteger else
  result := sftUnknown;
end;
{$endif NOVARIANTS}

const
  SQLFIELDTYPETODBFIELDTYPE: array[TSQLFieldType] of TSQLDBFieldType =
    (ftUnknown,   // sftUnknown
     ftUTF8,      // sftAnsiText
     ftUTF8,      // sftUTF8Text
     ftInt64,     // sftEnumerate
     ftInt64,     // sftSet
     ftInt64,     // sftInteger
     ftInt64,     // sftID = TSQLRecord(aID)
     ftInt64,     // sftRecord = TRecordReference = RecordRef
     ftInt64,     // sftBoolean
     ftDouble,    // sftFloat
     ftDate,      // sftDateTime
     ftInt64,     // sftTimeLog
     ftCurrency,  // sftCurrency
     ftUTF8,      // sftObject
     {$ifndef NOVARIANTS}
     ftUTF8,      // sftVariant
     ftNull,      // sftNullable
     {$endif}
     ftBlob,      // sftBlob
     ftBlob,      // sftBlobDynArray
     ftBlob,      // sftBlobCustom
     ftUTF8,      // sftUTF8Custom
     ftUnknown,   // sftMany
     ftInt64,     // sftModTime
     ftInt64,     // sftCreateTime
     ftInt64,     // sftTID
     ftInt64,     // sftRecordVersion = TRecordVersion
     ftInt64,     // sftSessionUserID
     ftDate,      // sftDateTimeMS
     ftInt64,     // sftUnixTime = TUnixTime
     ftInt64);    // sftUnixMSTime = TUnixMSTime

function SQLFieldTypeToDBField(aSQLFieldType: TSQLFieldType; aTypeInfo: pointer): TSQLDBFieldType;
  {$ifdef HASINLINE}inline;{$endif}
begin
  {$ifndef NOVARIANTS}
  if aSQLFieldType=sftNullable then
    aSQLFieldType := NullableTypeToSQLFieldType(aTypeInfo);
  {$endif}
  result := SQLFIELDTYPETODBFIELDTYPE[aSQLFieldType];
end;

constructor TSQLPropInfo.Create(const aName: RawUTF8; aSQLFieldType: TSQLFieldType;
  aAttributes: TSQLPropInfoAttributes; aFieldWidth, aPropertyIndex: integer);
begin
  if aName='' then
    EORMException.CreateUTF8('Void name for %.Create',[self]);
  if aAuxiliaryRTreeField in aAttributes then
    fName := copy(aName,2,MaxInt) else
    fName := aName;
  fNameUnflattened := fName;
  fSQLFieldType := aSQLFieldType;
  fSQLFieldTypeStored := aSQLFieldType;
  fSQLDBFieldType := SQLFIELDTYPETODBFIELDTYPE[fSQLFieldTypeStored];
  fAttributes := aAttributes;
  fFieldWidth := aFieldWidth;
  fPropertyIndex := aPropertyIndex;
end;

function TSQLPropInfo.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var tmp: RawUTF8;
begin
  GetValueVar(Instance,false,tmp,nil);
  result := crc32c(0,pointer(tmp),length(tmp));
end;

procedure TSQLPropInfo.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var wasString: boolean;
    tmp: RawUTF8;
begin
  GetValueVar(Instance,false,tmp,@wasString);
  if wasString then begin
    W.Add('"');
    if tmp<>'' then
      W.AddJSONEscape(pointer(tmp));
    W.Add('"');
  end else
    W.AddRawJSON(tmp);
end;

function TSQLPropInfo.GetValue(Instance: TObject; ToSQL: boolean;
  wasSQLString: PBoolean): RawUTF8;
begin
  GetValueVar(Instance,ToSQL,Result,wasSQLString);
end;

procedure TSQLPropInfo.SetValueVar(Instance: TObject; const Value: RawUTF8;
  wasString: boolean);
begin
  SetValue(Instance,pointer(Value),wasString);
end;

function TSQLPropInfo.SQLDBFieldTypeName: PShortString;
begin
  result := ToText(fSQLDBFieldType);
end;

procedure TSQLPropInfo.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  GetValueVar(Instance,true,RawUTF8(temp),nil);
  aValue.Options := [];
  aValue.VType := fSQLDBFieldType;
  case aValue.VType of
    ftInt64:
      SetInt64(pointer(temp),aValue.VInt64);
    ftCurrency:
      aValue.VInt64 := StrToCurr64(pointer(temp));
    ftDouble:
      aValue.VDouble := GetExtended(pointer(temp));
    ftDate:
      aValue.VDateTime := Iso8601ToDateTime(temp);
    ftBlob:
      if temp='' then
        aValue.VType := ftNull else begin
        temp := BlobToTSQLRawBlob(temp);
        aValue.VBlob := pointer(temp);
        aValue.VBlobLen := length(temp);
      end;
    ftUTF8:
      aValue.VText := pointer(temp);
    else
      aValue.VInt64 := 0;
  end;
end;

function TSQLPropInfo.IsValueVoid(Instance: TObject): boolean;
var temp: RawUTF8;
    wasString: boolean;
begin
  GetValueVar(Instance,true,temp,@wasString);
  if wasString then
    result := temp='' else
    result := GetInt64(pointer(temp))=0;
end;

function TSQLPropInfo.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
begin
  case aValue.VType of
    ftInt64:
      SetValueVar(Instance,Int64ToUtf8(aValue.VInt64),false);
    ftCurrency:
      SetValueVar(Instance,Curr64ToStr(aValue.VInt64),false);
    ftDouble:
      SetValueVar(Instance,DoubleToStr(aValue.VDouble),false);
    ftDate:
      SetValueVar(Instance,DateTimeToIso8601Text(
        aValue.VDateTime,'T',svoDateWithMS in aValue.Options),true);
    ftBlob:
      SetValueVar(Instance,TSQLRawBlobToBlob(aValue.VBlob,aValue.VBlobLen),true);
    ftUTF8:
      SetValue(Instance,aValue.VText,true);
    else
      SetValue(Instance,nil,false);
  end;
  result := true;
end;

const
  NULL_LOW = ord('n')+ord('u')shl 8+ord('l')shl 16+ord('l')shl 24;
  FALSE_LOW = ord('f')+ord('a')shl 8+ord('l')shl 16+ord('s')shl 24;
  TRUE_LOW  = ord('t')+ord('r')shl 8+ord('u')shl 16+ord('e')shl 24;

{$ifndef NOVARIANTS}
procedure ValueVarToVariant(Value: PUTF8Char; ValueLen: integer; fieldType: TSQLFieldType;
  var result: TVarData; createValueTempCopy: boolean; typeInfo: pointer;
  options: TDocVariantOptions);
const
  /// map our available types for any SQL field property into variant values
  // - varNull will be used to store a true variant instance from JSON
  SQL_ELEMENTTYPES: array[TSQLFieldType] of word = (
 // sftUnknown, sftAnsiText, sftUTF8Text, sftEnumerate, sftSet,   sftInteger,
    varEmpty,    varString,  varString,   varInteger,   varInt64, varInt64,
 // sftID, sftRecord, sftBoolean, sftFloat, sftDateTime,
    varInt64,varInt64,varBoolean, varDouble, varDate,
 //  sftTimeLog, sftCurrency,  sftObject,
    varInt64,   varCurrency,   varNull,
 //                   sftVariant, sftNullable       sftBlob,sftBlobDynArray,
    {$ifndef NOVARIANTS} varNull, varNull, {$endif} varString, varNull,
 // sftBlobCustom, sftUTF8Custom, sftMany, sftModTime, sftCreateTime, sftTID,
    varString,      varString,    varEmpty, varInt64,  varInt64,     varInt64,
 // sftRecordVersion, sftSessionUserID, sftDateTimeMS, sftUnixTime, sftUnixMSTime
    varInt64, varInt64, varDate, varInt64, varInt64);
  procedure Complex;
  var tmp: TSynTempBuffer;
   begin
    if (fieldType=sftBlobDynArray) and (typeInfo<>nil) and
       (Value<>nil) and (Value^<>'[') and
       Base64MagicCheckAndDecode(Value,tmp) then
      Value := pointer(DynArrayBlobSaveJSON(typeInfo,tmp.buf)) else
    if createValueTempCopy then
      Value := tmp.Init(Value) else
      tmp.buf := nil;
    GetVariantFromJSON(Value,false,variant(result),@options);
    tmp.Done;
  end;
var err: integer;
begin
  VarClear(variant(result));
  result.VType := SQL_ELEMENTTYPES[fieldType];
  result.VAny := nil; // avoid GPF
  case fieldType of
  sftCurrency:
    result.VInt64 := StrToCurr64(Value);
  sftFloat: begin
    result.VDouble := GetExtended(Value,err);
    if err<>0 then begin
      result.VType := varString;
      FastSetString(RawUTF8(result.VAny),Value,ValueLen);
    end;
  end;
  sftDateTime, sftDateTimeMS:
    Iso8601ToDateTimePUTF8CharVar(Value,0,result.VDate);
  sftBoolean:
    result.VBoolean :=
      not((Value=nil) or (PWord(Value)^=ord('0')) or (PInteger(Value)^=FALSE_LOW));
  sftEnumerate:
    result.VInteger := GetInteger(Value);
  sftInteger, sftID, sftTID, sftRecord, sftSet, sftRecordVersion, sftSessionUserID,
  sftTimeLog, sftModTime, sftCreateTime, sftUnixTime, sftUnixMSTime:
    SetInt64(Value,result.VInt64);
  sftAnsiText, sftUTF8Text:
    FastSetString(RawUTF8(result.VAny),Value,ValueLen);
  sftBlobCustom, sftBlob:
    BlobToTSQLRawBlob(Value,TSQLRawBlob(result.VAny));
  {$ifndef NOVARIANTS}sftVariant, sftNullable,{$endif}
  sftBlobDynArray, sftObject, sftUTF8Custom:
    Complex;
  end;
end;

function ObjectLoadVariant(var ObjectInstance; const aDocVariant: variant;
  TObjectListItemClass: TClass; Options: TJSONToObjectOptions): boolean;
var tmp: RawUTF8;
begin
  result := false;
  if _Safe(aDocVariant)^.Kind=dvObject then
    VariantSaveJSON(aDocVariant,twJSONEscape,tmp) else
    if VariantToUTF8(aDocVariant, tmp) and (tmp<>'') and (tmp[1]='{') then
      UniqueRawUTF8(tmp) else
      exit;
  JSONToObject(ObjectInstance,pointer(tmp),result,TObjectListItemClass,Options);
end;

procedure TSQLPropInfo.GetVariant(Instance: TObject; var Dest: Variant);
var temp: RawUTF8;
begin
  GetValueVar(Instance,true,temp,nil);
  ValueVarToVariant(pointer(temp),Length(temp),fSQLFieldTypeStored,TVarData(Dest),false,nil);
end;

procedure TSQLPropInfo.SetVariant(Instance: TObject; const Source: Variant);
begin
  SetValueVar(Instance,VariantToUTF8(Source),
    (TVarData(Source).VType=varOleStr) or (TVarData(Source).VType>=varString));
end;

{$endif NOVARIANTS}

function TSQLPropInfo.CompareValue(Item1, Item2: TObject; CaseInsensitive: boolean): PtrInt;
var tmp1,tmp2: RawUTF8;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    GetValueVar(Item1,false,tmp1,nil);
    GetValueVar(Item2,false,tmp2,nil);
    if CaseInsensitive then // slow, always working implementation
      result := StrIComp(pointer(tmp1),pointer(tmp2)) else
      result := StrComp(pointer(tmp1),pointer(tmp2));
  end;
end;

procedure TSQLPropInfo.CopyProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject);

  procedure GenericCopy;
  var tmp: RawUTF8;
      wasString: boolean;
      {$ifndef NOVARIANTS}
      val: variant;
      {$endif}
  begin
    {$ifndef NOVARIANTS} // force JSON serialization, e.g. for dynamic arrays
    if (DestInfo.SQLFieldType=sftVariant) or (SQLfieldType=sftVariant) then begin
      GetVariant(Source,val);
      DestInfo.SetVariant(Dest,val);
      exit;
    end;
    {$endif}
    GetValueVar(Source,false,tmp,@wasString);
    DestInfo.SetValueVar(Dest,tmp,wasString);
  end;

var i: integer;
begin
  if (Source=nil) or (DestInfo=nil) or (Dest=nil) then
    exit; // avoid GPF
  with TSQLPropInfoRTTI(self) do
    if fFromRTTI and (fFlattenedProps<>nil) then
    for i := 0 to length(fFlattenedProps)-1 do
      Source := fFlattenedProps[i].GetObjProp(Source);
  with TSQLPropInfoRTTI(DestInfo) do
    if fFromRTTI and (fFlattenedProps<>nil) then
    for i := 0 to length(fFlattenedProps)-1 do
      Dest := fFlattenedProps[i].GetObjProp(Dest);
  if DestInfo.ClassType=ClassType then
    CopySameClassProp(Source,DestInfo,Dest) else
    GenericCopy;
end;

procedure TSQLPropInfo.CopyValue(Source, Dest: TObject);
begin
  CopySameClassProp(Source,self,Dest);
end;

procedure TSQLPropInfo.CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo;
  Dest: TObject);
var tmp: RawUTF8;
    wasString: boolean;
begin
  GetValueVar(Source,false,tmp,@wasString);
  DestInfo.SetValueVar(Dest,tmp,wasString);
end;


{ TSQLPropInfoRTTI }

var
  SQLPropInfoRegistration: TSynDictionary = nil;

class procedure TSQLPropInfoRTTI.RegisterTypeInfo(aTypeInfo: Pointer);
begin
  if SQLPropInfoRegistration=nil then
    GarbageCollectorFreeAndNil(SQLPropInfoRegistration,
     TSynDictionary.Create(TypeInfo(TPointerDynArray),TypeInfo(TPointerDynArray)));
  SQLPropInfoRegistration.AddOrUpdate(aTypeInfo,self);
end;

class function TSQLPropInfoRTTI.CreateFrom(aPropInfo: PPropInfo; aPropIndex: integer;
  aOptions: TSQLPropInfoListOptions; const aFlattenedProps: PPropInfoDynArray): TSQLPropInfo;
var aSQLFieldType: TSQLFieldType;
    aType: PTypeInfo;
    C: TSQLPropInfoRTTIClass;
procedure FlattenedPropNameSet;
var i,max: Integer;
begin // Address.Street1 -> Address_Street1
  (result as TSQLPropInfoRTTI).fFlattenedProps := aFlattenedProps;
  result.fNameUnflattened := result.fName;
  max := high(aFlattenedProps);
  for i := max downto 0 do
    result.fNameUnflattened := ToUTF8(aFlattenedProps[i]^.Name)+'.'+result.fNameUnflattened;
  if (max>=0) and (aFlattenedProps[max]^.PropType^.
     ClassFieldCount(pilIgnoreIfGetter in aOptions)=1) then begin
    // Birth.Date -> Birth or Address.Country.Iso -> Address_Country
    result.fName := ToUTF8(aFlattenedProps[max]^.Name);
    dec(max);
  end;
  for i := max downto 0 do
    result.fName := ToUTF8(aFlattenedProps[i]^.Name)+'_'+result.fName;
end;
begin
  if aPropInfo=nil then
    raise EORMException.CreateUTF8('Invalid %.CreateFrom(nil) call',[self]);
  result := nil;
  aSQLFieldType := sftUnknown;
  aType := aPropInfo^.TypeInfo;
  {$ifndef NOVARIANTS}
  if aType^.Kind=tkVariant then begin
    aSQLFieldType := NullableTypeToSQLFieldType(aType);
    if aSQLFieldType<>sftUnknown then // handle sftNullable type
      result := TSQLPropInfoRTTIVariant.Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  end;
  {$endif NOVARIANTS}
  if result=nil then begin
    aSQLFieldType := aType^.GetSQLFieldType;
    C := nil;
    if (SQLPropInfoRegistration=nil) or
       not SQLPropInfoRegistration.FindAndCopy(aType,C) then
    case aSQLFieldType of
      sftUnknown, sftBlobCustom:
        ; // will raise an EORMException
      sftBoolean, sftEnumerate:
        C := TSQLPropInfoRTTIEnum;
      sftTimeLog, sftModTime, sftCreateTime: // specific class for further use
        C := TSQLPropInfoRTTITimeLog;
      sftUnixTime: // specific class for further use
        C := TSQLPropInfoRTTIUnixTime;
      sftUnixMSTime:
        C := TSQLPropInfoRTTIUnixMSTime;
      sftCurrency:
        C := TSQLPropInfoRTTICurrency;
      sftDateTime, sftDateTimeMS:
        C := TSQLPropInfoRTTIDateTime;
      sftID: // = TSQLRecord(aID)
        C := TSQLPropInfoRTTIID;
      sftTID: // = TID or T*ID
        C := TSQLPropInfoRTTITID;
      sftSessionUserID:
        C := TSQLPropInfoRTTIInt64;
      sftRecord: // = TRecordReference/TRecordReferenceToBeDeleted
        C := TSQLPropInfoRTTIRecordReference;
      sftRecordVersion:
        C := TSQLPropInfoRTTIRecordVersion;
      sftMany:
        C := TSQLPropInfoRTTIMany;
      sftObject:
        C := TSQLPropInfoRTTIObject;
      {$ifndef NOVARIANTS}
      sftVariant:
        C := TSQLPropInfoRTTIVariant;  // sftNullable already handle above
      {$endif NOVARIANTS}
      sftBlob:
        C := TSQLPropInfoRTTIRawBlob;
      sftBlobDynArray:
        C := TSQLPropInfoRTTIDynArray;
      sftUTF8Custom: // will happen only for DELPHI XE5 and up
        result := TSQLPropInfoCustomJSON.Create(aPropInfo,aPropIndex);
      else
      case aType^.Kind of // retrieve matched type from RTTI binary level
        tkInteger:
          C := TSQLPropInfoRTTIInt32;
        tkSet:
          C := TSQLPropInfoRTTISet;
        tkChar, tkWChar:
          C := TSQLPropInfoRTTIChar;
        tkInt64 {$ifdef FPC}, tkQWord{$endif}:
          C := TSQLPropInfoRTTIInt64;
        tkFloat:
          if aType^.FloatType=ftDoub then
            C := TSQLPropInfoRTTIDouble;
        tkLString {$ifdef FPC},tkLStringOld{$endif}:
          case aType^.AnsiStringCodePage of // recognize optimized UTF-8/UTF-16
            CP_UTF8:  C := TSQLPropInfoRTTIRawUTF8;
            CP_UTF16: C := TSQLPropInfoRTTIRawUnicode;
            else C := TSQLPropInfoRTTIAnsi; // will use the right TSynAnsiConvert
          end;
        {$ifdef HASVARUSTRING}
        tkUString:
          C := TSQLPropInfoRTTIUnicode;
        {$endif}
        tkWString:
          C := TSQLPropInfoRTTIWide;
      end;
    end;
    if C<>nil then
      result := C.Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  end;
  if result<>nil then begin
    if aFlattenedProps<>nil then
      FlattenedPropNameSet;
  end else
    if pilRaiseEORMExceptionIfNotHandled in aOptions then
      raise EORMException.CreateUTF8('%.CreateFrom: Unhandled %/% type for property %',
        [self,ToText(aSQLFieldType)^,ToText(aType^.Kind)^,aPropInfo^.Name]);
end;

function TSQLPropInfoRTTI.GetSQLFieldRTTITypeName: RawUTF8;
begin
  result := ToUTF8(fPropType^.Name);
end;

function TSQLPropInfoRTTI.GetFieldAddr(Instance: TObject): pointer;
begin
  if Instance=nil then
    result := nil else
    result := fPropInfo^.GetFieldAddr(Instance);
end;

function TSQLPropInfoRTTI.Flattened(Instance: TObject): TObject;
var i: integer;
begin
  result := Instance;
  for i := 0 to length(fFlattenedProps)-1 do
    result := fFlattenedProps[i].GetObjProp(result);
end;

{$ifndef NOVARIANTS}
procedure TSQLPropInfoRTTI.GetVariant(Instance: TObject; var Dest: Variant);
var temp: RawUTF8;
begin
  GetValueVar(Instance,true,temp,nil);
  ValueVarToVariant(pointer(temp),length(temp),fSQLFieldTypeStored,TVarData(Dest),false,fPropInfo);
end;
{$endif NOVARIANTS}

constructor TSQLPropInfoRTTI.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
var attrib: TSQLPropInfoAttributes;
begin
  byte(attrib) := 0;
  if aPropInfo^.IsStored(nil)=AS_UNIQUE then
    Include(attrib,aIsUnique); // property MyProperty: RawUTF8 stored AS_UNIQUE;
  if (pilAuxiliaryFields in aOptions) and (aPropInfo^.Name[1] = '_') then
    Include(attrib,aAuxiliaryRTreeField);
  inherited Create(ToUTF8(aPropInfo^.Name),aSQLFieldType,attrib,
    aPropInfo^.Index,aPropIndex); // property MyProperty: RawUTF8 index 10; -> FieldWidth=10
  fPropInfo := aPropInfo;
  fPropType := aPropInfo^.TypeInfo;
  if aPropInfo.GetterIsField then begin
    fGetterIsFieldPropOffset := aPropInfo.GetProc{$ifndef FPC} and $00ffffff{$endif};
    if (aPropInfo.SetProc=0) or (aPropInfo.SetProc=fPropInfo.GetProc) then
      fInPlaceCopySameClassPropOffset := fGetterIsFieldPropOffset;
  end;
  fFromRTTI := true;
end;


{ TSQLPropInfoRTTIInt32 }

constructor TSQLPropInfoRTTIInt32.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
begin
  inherited Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  fUnsigned := fPropType^.OrdType in [otUByte,otUWord,otULong];
end;

procedure TSQLPropInfoRTTIInt32.CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo;
  Dest: TObject);
begin
  TSQLPropInfoRTTIInt32(DestInfo).fPropInfo.SetOrdProp(Dest,fPropInfo.GetOrdProp(Source));
end;

procedure TSQLPropInfoRTTIInt32.GetBinary(Instance: TObject; W: TFileBufferWriter);
begin
   W.WriteVarUInt32(cardinal(fPropInfo.GetOrdProp(Instance)));
end;

function TSQLPropInfoRTTIInt32.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var v: integer;
begin
  v := fPropInfo.GetOrdProp(Instance);
  result := crc32cBy4(0,v); // better hash distribution using crc32c
end;

procedure TSQLPropInfoRTTIInt32.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var v: integer;
begin
  v := fPropInfo.GetOrdProp(Instance);
  if fUnsigned then
    W.AddU(cardinal(v)) else
    W.Add(v);
end;

procedure TSQLPropInfoRTTIInt32.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var v: integer;
begin
  if wasSQLString<>nil then
    wasSQLString^ := false;
  v := fPropInfo.GetOrdProp(Instance);
  if fUnsigned then
    UInt32ToUtf8(cardinal(v),result) else
    Int32ToUtf8(v,result);
end;

procedure TSQLPropInfoRTTIInt32.NormalizeValue(var Value: RawUTF8);
var err,v: integer;
begin
  v := GetInteger(pointer(Value),err);
  if err<>0 then
    Value := '' else
    if fUnsigned then
      UInt32ToUtf8(cardinal(v),Value) else
      Int32ToUtf8(v,Value);
end;

function TSQLPropInfoRTTIInt32.CompareValue(Item1, Item2: TObject; CaseInsensitive: boolean): PtrInt;
var A,B: integer;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    A := fPropInfo.GetOrdProp(Item1);
    B := fPropInfo.GetOrdProp(Item2);
    result := {$ifdef HASINLINE}CompareInteger{$else}SortDynArrayInteger{$endif}(A,B);
  end;
end;

function TSQLPropInfoRTTIInt32.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
var c: cardinal;
begin
  if P<>nil then begin
    P := pointer(FromVarUInt32Safe(pointer(P),pointer(PEnd),c));
    if P<>nil then
      fPropInfo.SetOrdProp(Instance,integer(c));
  end;
  result := P;
end;

procedure TSQLPropInfoRTTIInt32.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
begin
  fPropInfo.SetOrdProp(Instance,GetInteger(Value));
end;

function TSQLPropInfoRTTIInt32.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
begin
  if aValue.VType=ftInt64 then begin
    fPropInfo.SetOrdProp(Instance,aValue.VInt64);
    result := true;
  end else
    result := inherited SetFieldSQLVar(Instance,aValue);
end;

procedure TSQLPropInfoRTTIInt32.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
var v: integer;
begin
  aValue.Options := [];
  aValue.VType := ftInt64;
  v := fPropInfo.GetOrdProp(Instance);
  if fUnsigned then
    aValue.VInt64 := cardinal(v) else
    aValue.VInt64 := v;
end;


{ TSQLPropInfoRTTISet }

constructor TSQLPropInfoRTTISet.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
begin
  inherited Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  fSetEnumType := fPropType^.SetEnumType;
end;


{ TSQLPropInfoRTTIEnum }

constructor TSQLPropInfoRTTIEnum.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
begin
  inherited Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  fEnumType := fPropType^.EnumBaseType;
end;

procedure TSQLPropInfoRTTIEnum.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var i: integer;
begin
  i := fPropInfo.GetOrdProp(Instance);
  if fSQLFieldType=sftBoolean then
    W.Add(i<>0) else
    W.Add(i);
end;

function TSQLPropInfoRTTIEnum.GetCaption(Value: RawUTF8; out IntValue: integer): string;
begin
  NormalizeValue(Value);
  IntValue := GetInteger(pointer(Value));
  if Value='' then
    result := '' else
    result := EnumType^.GetCaption(IntValue);
end;

procedure TSQLPropInfoRTTIEnum.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var i: integer;
begin
  if wasSQLString<>nil then
    wasSQLString^ := false;
  i := fPropInfo.GetOrdProp(Instance);
  if (fSQLFieldType=sftBoolean) and not ToSQL then
    result := BOOL_UTF8[i<>0] else
    UInt32ToUtf8(i,result);
end;

procedure TSQLPropInfoRTTIEnum.NormalizeValue(var Value: RawUTF8);
var i,err: integer;
begin
  i := GetInteger(pointer(Value),err);
  if err<>0 then  // we allow a value stated as text
    if fSQLFieldType=sftBoolean then
      i := Ord(IdemPropNameU(Value,'TRUE') or IdemPropNameU(Value,'YES')) else
      i := fEnumType^.GetEnumNameValue(pointer(Value),length(Value)) else
    if fSQLFieldType=sftBoolean then // normalize boolean values range to 0,1
      if i<>0 then
        i := 1;
  if cardinal(i)>cardinal(fEnumType^.MaxValue) then
    Value := '' else // only set a valid value
    UInt32ToUtf8(i,Value);
end;

procedure TSQLPropInfoRTTIEnum.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var i,err,len: integer;
begin
  if Value=nil then
    i := 0 else begin
    i := GetInteger(Value,err);
    if err<>0 then begin // we allow a value stated as text
      if fSQLFieldType=sftBoolean then begin
        len := StrLen(Value);
        i := ord(IdemPropName('TRUE',Value,len) or IdemPropName('YES',Value,len));
      end else
        i := fEnumType^.GetEnumNameValue(Value); // -> convert into integer
      if cardinal(i)>cardinal(fEnumType^.MaxValue) then
        i := 0;  // only set a valid text value
    end else
    if fSQLFieldType=sftBoolean then // normalize boolean values range to 0,1
      if i<>0 then
        i := 1;
  end;
  fPropInfo.SetOrdProp(Instance,i);
end;


{ TSQLPropInfoRTTIChar }

procedure TSQLPropInfoRTTIChar.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var w: WideChar;
begin
  w := WideChar(fPropInfo.GetOrdProp(Instance));
  if ToSQL and (w=#0) then begin
    // 'null' and not #0 to avoid end of SQL text - JSON will escape #0
    result := NULL_STR_VAR;
    if wasSQLString<>nil then
      wasSQLString^ := false;
   end else begin
    RawUnicodeToUtf8(@w,1,result);
    if wasSQLString<>nil then
      wasSQLString^ := true;
  end;
end;

procedure TSQLPropInfoRTTIChar.NormalizeValue(var Value: RawUTF8);
begin // do nothing: should already be UTF-8 encoded
end;

procedure TSQLPropInfoRTTIChar.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var i: integer;
begin
  if (Value=nil) or (PInteger(Value)^=NULL_LOW) then
    i := 0 else
    i := GetUTF8Char(Value);
  fPropInfo.SetOrdProp(Instance,i);
end;


{ TSQLPropInfoRTTIInt64 }

constructor TSQLPropInfoRTTIInt64.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
begin
  inherited Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  fIsQWord := fPropType^.IsQword;
end;

procedure TSQLPropInfoRTTIInt64.CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo;
  Dest: TObject);
begin
  TSQLPropInfoRTTIInt64(DestInfo).fPropInfo.SetInt64Prop(Dest,fPropInfo.GetInt64Prop(Source));
end;

procedure TSQLPropInfoRTTIInt64.GetBinary(Instance: TObject;
  W: TFileBufferWriter);
var V64: Int64;
begin
  V64 := fPropInfo.GetInt64Prop(Instance);
  W.Write(@V64,SizeOf(Int64));
end;

function TSQLPropInfoRTTIInt64.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var V64: TQWordRec;
begin
  if fGetterIsFieldPropOffset<>0 then
    V64.V := PInt64(PtrUInt(Instance)+fGetterIsFieldPropOffset)^ else
    V64.V := fPropInfo.GetInt64Prop(Instance);
  result := crc32cBy4(V64.L,V64.H); // better hash distribution using crc32c
end;

procedure TSQLPropInfoRTTIInt64.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var V64: Int64;
begin
  if fGetterIsFieldPropOffset<>0 then
    V64 := PInt64(PtrUInt(Instance)+fGetterIsFieldPropOffset)^ else
    V64 := fPropInfo.GetInt64Prop(Instance);
  if fIsQWord then
    W.AddQ(V64) else
    W.Add(V64);
end;

procedure TSQLPropInfoRTTIInt64.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var V64: Int64;
begin
  if wasSQLString<>nil then
    wasSQLString^ := false;
  if fGetterIsFieldPropOffset<>0 then
    V64 := PInt64(PtrUInt(Instance)+fGetterIsFieldPropOffset)^ else
    V64 := fPropInfo.GetInt64Prop(Instance);
  if fIsQWord then
    UInt64ToUtf8(V64,result) else
    Int64ToUtf8(V64,result);
end;

procedure TSQLPropInfoRTTIInt64.NormalizeValue(var Value: RawUTF8);
var err: integer;
    V64: Int64;
begin
  if fIsQWord then begin
    V64 := GetQWord(pointer(Value),err);
    if err<>0 then
      Value := '' else
      UInt64ToUtf8(V64,Value);
  end else begin
    V64 := GetInt64(pointer(Value),err);
    if err<>0 then
      Value := '' else
      Int64ToUtf8(V64,Value);
  end;
end;

function TSQLPropInfoRTTIInt64.CompareValue(Item1, Item2: TObject; CaseInsensitive: boolean): PtrInt;
var V1,V2: Int64;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    if fGetterIsFieldPropOffset<>0 then begin
      V1 := PInt64(PtrUInt(Item1)+fGetterIsFieldPropOffset)^;
      V2 := PInt64(PtrUInt(Item2)+fGetterIsFieldPropOffset)^;
    end else begin
      V1 := fPropinfo.GetInt64Prop(Item1);
      V2 := fPropinfo.GetInt64Prop(Item2);
    end;
    if fIsQWord then
      result := {$ifdef HASINLINE}CompareQWord{$else}SortDynArrayQWord{$endif}(V1,V2) else
      result := {$ifdef HASINLINE}CompareInt64{$else}SortDynArrayInt64{$endif}(V1,V2);
  end;
end;

function TSQLPropInfoRTTIInt64.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin
  if P=nil then
    result := nil else begin
    result := P+SizeOf(Int64);
    if result>PEnd then
      result := nil else
      fPropInfo.SetInt64Prop(Instance,PInt64(P)^);
  end;
end;

procedure TSQLPropInfoRTTIInt64.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var V64: Int64;
begin
  if fIsQWord then
    SetQWord(Value,PQword(@V64)^) else
    SetInt64(Value,V64);
  fPropInfo.SetInt64Prop(Instance,V64);
end;

function TSQLPropInfoRTTIInt64.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
begin
  if aValue.VType=ftInt64 then begin
    fPropInfo.SetInt64Prop(Instance,aValue.VInt64);
    result := true;
  end else
    result := inherited SetFieldSQLVar(Instance,aValue);
end;

procedure TSQLPropInfoRTTIInt64.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  aValue.Options := [];
  aValue.VType := ftInt64;
  aValue.VInt64 := fPropInfo.GetInt64Prop(Instance);
end;


{ TSQLPropInfoRTTIDouble }

procedure TSQLPropInfoRTTIDouble.CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo;
  Dest: TObject);
begin
  TSQLPropInfoRTTIDouble(DestInfo).fPropInfo.SetDoubleProp(Dest,
    fPropInfo.GetDoubleProp(Source));
end;

procedure TSQLPropInfoRTTIDouble.GetJSONValues(Instance: TObject; W: TJSONSerializer);
begin
  W.AddDouble(fPropInfo.GetDoubleProp(Instance));
end;

procedure TSQLPropInfoRTTIDouble.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  DoubleToStr(fPropInfo.GetDoubleProp(Instance),result);
  if wasSQLString<>nil then
    wasSQLString^ := (result='') or not (result[1] in ['0'..'9']);
end;

procedure TSQLPropInfoRTTIDouble.NormalizeValue(var Value: RawUTF8);
var VFloat: TSynExtended;
    err: integer;
begin
  VFloat := GetExtended(pointer(Value),err);
  if err<>0 then
    Value := '' else
    DoubleToStr(VFloat,Value);
end;

procedure TSQLPropInfoRTTIDouble.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var V: double;
    err: integer;
begin
  if Value=nil then
    V := 0 else begin
    V := GetExtended(pointer(Value),err);
    if err<>0 then
      V := 0;
  end;
  fPropInfo.SetDoubleProp(Instance,V);
end;

function TSQLPropInfoRTTIDouble.CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else
    result := CompareFloat(fPropInfo.GetDoubleProp(Item1),fPropInfo.GetDoubleProp(Item2));
end;

function TSQLPropInfoRTTIDouble.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var V: double;
begin
  V := fPropInfo.GetDoubleProp(Instance);
  with PQWordRec(@V)^ do
    result := crc32cBy4(L,H); // better hash distribution using crc32c
end;

procedure TSQLPropInfoRTTIDouble.GetBinary(Instance: TObject;
  W: TFileBufferWriter);
var V: double;
begin
  V := fPropInfo.GetDoubleProp(Instance);
  W.Write(@V,SizeOf(V));
end;

{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
type
  unaligned = Double;
{$endif}

function TSQLPropInfoRTTIDouble.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin
  if P=nil then
    result := nil else begin
    result := P+SizeOf(double);
    if result>PEnd then
      result := nil else
      fPropInfo.SetDoubleProp(Instance,unaligned(PDouble(P)^));
  end;
end;

function TSQLPropInfoRTTIDouble.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
var V: double;
begin
  case aValue.VType of
  ftCurrency:       V := aValue.VCurrency;
  ftDouble, ftDate: V := aValue.VDouble;
  ftInt64:          V := aValue.VInt64;
  else begin
    result := inherited SetFieldSQLVar(Instance,aValue);
    exit;
  end;
  end;
  fPropInfo.SetDoubleProp(Instance,V);
  result := true;
end;

procedure TSQLPropInfoRTTIDouble.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  aValue.Options := [];
  aValue.VType := ftDouble;
  aValue.VDouble := fPropInfo.GetDoubleProp(Instance);
end;


{ TSQLPropInfoRTTICurrency }

procedure TSQLPropInfoRTTICurrency.CopySameClassProp(Source: TObject; DestInfo: TSQLPropInfo;
  Dest: TObject);
begin
  TSQLPropInfoRTTICurrency(DestInfo).fPropInfo.SetCurrencyProp(Dest,
    fPropInfo.GetCurrencyProp(Source));
end;

procedure TSQLPropInfoRTTICurrency.GetJSONValues(Instance: TObject; W: TJSONSerializer);
begin
  W.AddCurr64(fPropInfo.GetCurrencyProp(Instance));
end;

procedure TSQLPropInfoRTTICurrency.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  if wasSQLString<>nil then
    wasSQLString^ := false;
  result := CurrencyToStr(fPropInfo.GetCurrencyProp(Instance));
end;

procedure TSQLPropInfoRTTICurrency.NormalizeValue(var Value: RawUTF8);
begin
  Value := Curr64ToStr(StrToCurr64(pointer(Value)));
end;

procedure TSQLPropInfoRTTICurrency.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var tmp: Int64;
begin
  tmp := StrToCurr64(Value,nil);
  fPropInfo.SetCurrencyProp(Instance,PCurrency(@tmp)^);
end;

function TSQLPropInfoRTTICurrency.CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt;
var V1, V2: currency;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    V1 := fPropInfo.GetCurrencyProp(Item1);
    V2 := fPropInfo.GetCurrencyProp(Item2);
    result := CompareInt64(PInt64(@V1)^,PInt64(@V2)^);
  end;
end;

function TSQLPropInfoRTTICurrency.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var V: currency;
begin
  V := fPropInfo.GetCurrencyProp(Instance);
  with PQWordRec(@V)^ do
    result := crc32cBy4(L,H); // better hash distribution using crc32c
end;

procedure TSQLPropInfoRTTICurrency.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  aValue.Options := [];
  aValue.VType := ftCurrency;
  aValue.VCurrency := fPropInfo.GetCurrencyProp(Instance);
end;

function TSQLPropInfoRTTICurrency.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
var V: Currency;
begin
  case aValue.VType of
  ftDouble, ftDate: V := aValue.VDouble;
  ftInt64:          V := aValue.VInt64;
  ftCurrency:       V := aValue.VCurrency;
  else begin
    result := inherited SetFieldSQLVar(Instance,aValue);
    exit;
  end;
  end;
  fPropInfo.SetCurrencyProp(Instance,V);
  result := true;
end;

procedure TSQLPropInfoRTTICurrency.GetBinary(Instance: TObject;
  W: TFileBufferWriter);
var V: Currency;
begin
  V := fPropInfo.GetCurrencyProp(Instance);
  W.Write(@V,SizeOf(V));
end;

function TSQLPropInfoRTTICurrency.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin
  if P=nil then
    result := nil else begin
    result := P+SizeOf(Currency);
    if result>PEnd then
      result := nil else
      fPropInfo.SetCurrencyProp(Instance,PCurrency(P)^);
  end;
end;


{ TSQLPropInfoRTTIDateTime }

procedure TSQLPropInfoRTTIDateTime.GetJSONValues(Instance: TObject; W: TJSONSerializer);
begin
  W.Add('"');
  W.AddDateTime(fPropInfo.GetDoubleProp(Instance),fSQLFieldType=sftDateTimeMS);
  W.Add('"');
end;

function TSQLPropInfoRTTIDateTime.CompareValue(Item1,Item2: TObject; CaseInsensitive: boolean): PtrInt;
const PRECISION: array[boolean] of double = (1/SecsPerDay, 1/MSecsPerDay);
var V1, V2: double;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    V1 := fPropInfo.GetDoubleProp(Item1);
    V2 := fPropInfo.GetDoubleProp(Item2);
    if SynCommons.SameValue(V1,V2,PRECISION[fSQLFieldType=sftDateTimeMS]) then
      result := 0 else
    if V1>V2 then
      result := 1 else
      result := -1;
  end;
end;

procedure TSQLPropInfoRTTIDateTime.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  if wasSQLString<>nil then
    wasSQLString^ := true;
  DateTimeToIso8601TextVar(fPropInfo.GetDoubleProp(Instance),
    'T',result,fSQLFieldType=sftDateTimeMS);
end;

procedure TSQLPropInfoRTTIDateTime.NormalizeValue(var Value: RawUTF8);
begin
  DateTimeToIso8601TextVar(Iso8601ToDateTime(Value),'T',Value,fSQLFieldType=sftDateTimeMS);
end;

procedure TSQLPropInfoRTTIDateTime.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var V: TDateTime;
begin
  Iso8601ToDateTimePUTF8CharVar(Value,0,V);
  fPropInfo.SetDoubleProp(Instance,V);
end;

procedure TSQLPropInfoRTTIDateTime.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  if fSQLFieldType=sftDateTimeMS then
    aValue.Options := [svoDateWithMS] else
    aValue.Options := [];
  aValue.VType := ftDate;
  aValue.VDouble := fPropInfo.GetDoubleProp(Instance);
end;


{ TSQLPropInfoRTTIMany }

// TSQLRecordMany stores nothing within the table

procedure TSQLPropInfoRTTIMany.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  result := '';
end;

procedure TSQLPropInfoRTTIMany.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
begin
end;

procedure TSQLPropInfoRTTIMany.GetBinary(Instance: TObject; W: TFileBufferWriter);
begin
end;

function TSQLPropInfoRTTIMany.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin
  result := P;
end;


{ TSQLPropInfoRTTIInstance }

constructor TSQLPropInfoRTTIInstance.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
begin
  inherited Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  fObjectClass := fPropType^.ClassType^.ClassType;
end;

function TSQLPropInfoRTTIInstance.GetInstance(Instance: TObject): TObject;
begin
  result := fPropInfo.GetObjProp(Instance);
end;

procedure TSQLPropInfoRTTIInstance.SetInstance(Instance, Value: TObject);
begin
  fPropInfo.SetOrdProp(Instance,PtrInt(Value));
end;


{ TSQLPropInfoRTTIRecordReference }

constructor TSQLPropInfoRTTIRecordReference.Create(aPropInfo: PPropInfo;
  aPropIndex: integer; aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
begin
  inherited Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  fCascadeDelete := IdemPropName(fPropType^.Name,'TRecordReferenceToBeDeleted')
end;


{ TSQLPropInfoRTTITID }

constructor TSQLPropInfoRTTITID.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
var TypeName: PShortString;
    ItemClass: TClass;
begin
  inherited Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  TypeName := @fPropType^.Name;
  if IdemPropName(TypeName^,'TID') or
     (ord(TypeName^[1]) and $df<>ord('T')) or // expect T...ID pattern
     (PWord(@TypeName^[ord(TypeName^[0])-1])^ and $dfdf<>ord('I')+ord('D') shl 8) or
     (JSONSerializerRegisteredClass=nil) then
    exit;
  if (ord(TypeName^[0])>13) and
     IdemPropName('ToBeDeletedID',@TypeName^[ord(TypeName^[0])-12],13) then begin
    // 'TSQLRecordClientToBeDeletedID' -> TSQLRecordClient + CascadeDelete=true
    fCascadeDelete := true;
    ItemClass := JSONSerializerRegisteredClass.Find(@TypeName^[1],ord(TypeName^[0])-13);
  end else
    // 'TSQLRecordClientID' -> TSQLRecordClient
    ItemClass := JSONSerializerRegisteredClass.Find(@TypeName^[1],ord(TypeName^[0])-2);
  if (ItemClass<>nil) and ItemClass.InheritsFrom(TSQLRecord) then
    fRecordClass := pointer(ItemClass);
end;


{ TSQLPropInfoRTTIID }

procedure TSQLPropInfoRTTIID.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
begin
  if TSQLRecord(Instance).fFill.JoinedFields then
    raise EORMException.CreateUTF8('%(%).SetValue after Create*Joined',[self,Name]);
  inherited SetValue(Instance,Value,wasString);
end;

procedure TSQLPropInfoRTTIID.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var ID: PtrUInt;
begin
  ID := fPropInfo.GetOrdProp(Instance);
  if TSQLRecord(Instance).fFill.JoinedFields then
    ID := TSQLRecord(ID).fID;
  W.AddU(ID);
end;


{ TSQLPropInfoRTTIIObject }

procedure TSQLPropInfoRTTIObject.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var S,D: TObject;
begin
  // generic case: copy also class content (create instances)
  S := GetInstance(Source);
  D := TSQLPropInfoRTTIObject(DestInfo).GetInstance(Dest);
  {$ifndef LVCL}
  if S.InheritsFrom(TCollection) then
    CopyCollection(TCollection(S),TCollection(D)) else
  {$endif}
  if S.InheritsFrom(TStrings) and D.InheritsFrom(TStrings) then
    CopyStrings(TStrings(S),TStrings(D)) else begin
    D.Free; // release previous instance
    TSQLPropInfoRTTIObject(DestInfo).SetInstance(Dest,CopyObject(S));
  end;
end;

procedure TSQLPropInfoRTTIObject.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var valid: boolean;
    tmp: TSynTempBuffer;
begin
  tmp.Init(Value); // private copy since the buffer will be modified
  try
    PropInfo^.ClassFromJSON(Instance,tmp.buf,valid,JSONTOOBJECT_TOLERANTOPTIONS);
  finally
    tmp.Done;
  end;
end;

procedure TSQLPropInfoRTTIObject.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  if wasSQLString<>nil then
    wasSQLString^ := true;
  result := ObjectToJSON(GetInstance(Instance));
end;

procedure TSQLPropInfoRTTIObject.GetBinary(Instance: TObject; W: TFileBufferWriter);
begin
  // serialize object as JSON UTF-8 TEXT - not fast, but works
  W.Write(ObjectToJSON(GetInstance(Instance)));
end;

function TSQLPropInfoRTTIObject.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
var valid: boolean;
    tmp: TSynTempBuffer;
begin
  // unserialize object from JSON UTF-8 TEXT - not fast, but works
  FromVarString(PByte(P),PByte(PEnd),tmp);
  try
    PropInfo^.ClassFromJSON(Instance,tmp.buf,valid,JSONTOOBJECT_TOLERANTOPTIONS);
  finally
    tmp.Done;
  end;
  if valid then
    result := P else
    result := nil;
end;

function TSQLPropInfoRTTIObject.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var tmp: RawUTF8;
begin // JSON is case-sensitive by design -> ignore CaseInsensitive parameter
  tmp := ObjectToJSON(GetInstance(Instance));
  result := crc32c(0,pointer(tmp),length(tmp));
end;

procedure TSQLPropInfoRTTIObject.NormalizeValue(var Value: RawUTF8);
begin // do nothing: should already be normalized
end;

procedure TSQLPropInfoRTTIObject.GetJSONValues(Instance: TObject; W: TJSONSerializer);
begin
  if jwoAsJsonNotAsString in W.fSQLRecordOptions then
    W.WriteObject(GetInstance(Instance)) else
    W.WriteObjectAsString(GetInstance(Instance));
end;


{ TSQLPropInfoRTTIAnsi }

constructor TSQLPropInfoRTTIAnsi.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
begin
  inherited;
  fEngine := TSynAnsiConvert.Engine(aPropInfo^.PropType^.AnsiStringCodePage);
end;

procedure TSQLPropInfoRTTIAnsi.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var Value: RawByteString;
begin
  if (TSQLPropInfoRTTIAnsi(DestInfo).fEngine=fEngine) then begin
    fPropInfo.GetLongStrProp(Source,Value);
    TSQLPropInfoRTTIAnsi(DestInfo).fPropInfo.SetLongStrProp(Dest,Value);
  end else begin
    GetValueVar(Source,false,RawUTF8(Value),nil);
    DestInfo.SetValueVar(Dest,Value,true);
  end;
end;

procedure TSQLPropInfoRTTIAnsi.GetBinary(Instance: TObject; W: TFileBufferWriter);
var Value: RawByteString;
begin
  fPropInfo.GetLongStrProp(Instance,Value);
  W.Write(Value);
end;

function TSQLPropInfoRTTIAnsi.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var Up: array[byte] of AnsiChar; // avoid slow heap allocation
    Value: RawByteString;
begin
  fPropInfo.GetLongStrProp(Instance,Value);
  if CaseInsensitive then
    if fEngine.CodePage=CODEPAGE_US then
      result := crc32c(0,Up,UpperCopyWin255(Up,Value)-Up) else
      result := crc32c(0,Up,UpperCopy255Buf(Up,pointer(Value),length(Value))-Up) else
    result := crc32c(0,pointer(Value),length(Value));
end;

procedure TSQLPropInfoRTTIAnsi.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var tmp: RawByteString;
begin
  if wasSQLString<>nil then
    wasSQLString^ := true;
  fPropInfo.GetLongStrProp(Instance,tmp);
  result := fEngine.AnsiBufferToRawUTF8(pointer(tmp),length(tmp));
end;

procedure TSQLPropInfoRTTIAnsi.NormalizeValue(var Value: RawUTF8);
begin // do nothing: should already be UTF-8 encoded
end;

function TSQLPropInfoRTTIAnsi.CompareValue(Item1, Item2: TObject; CaseInsensitive: boolean): PtrInt;
var tmp1,tmp2: RawByteString;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    fPropInfo.GetLongStrProp(Item1,tmp1);
    fPropInfo.GetLongStrProp(Item2,tmp2);
    if CaseInsensitive then
      if fEngine.CodePage=CODEPAGE_US then
        result := AnsiIComp(pointer(tmp1),pointer(tmp2)) else
        result := StrIComp(pointer(tmp1),pointer(tmp2)) else
      result := StrComp(pointer(tmp1),pointer(tmp2));
  end;
end;

function TSQLPropInfoRTTIAnsi.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
var tmp: RawByteString;
begin
  FromVarString(PByte(P),PByte(PEnd),tmp,fEngine.CodePage);
  fPropInfo.SetLongStrProp(Instance,tmp);
  result := P;
end;

procedure TSQLPropInfoRTTIAnsi.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
begin
  if Value=nil then
    fPropInfo.SetLongStrProp(Instance,'') else
    fPropInfo.SetLongStrProp(Instance,fEngine.UTF8BufferToAnsi(Value,StrLen(Value)));
end;

procedure TSQLPropInfoRTTIAnsi.SetValueVar(Instance: TObject; const Value: RawUTF8;
  wasString: boolean);
begin
  fPropInfo.SetLongStrProp(Instance,fEngine.UTF8ToAnsi(Value));
end;

procedure TSQLPropInfoRTTIAnsi.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var tmp: RawByteString;
begin
  W.Add('"');
  fPropInfo.GetLongStrProp(Instance,tmp);
  if tmp<>'' then
    W.AddAnyAnsiString(tmp,twJSONEscape,fEngine.CodePage);
  W.Add('"');
end;

function TSQLPropInfoRTTIAnsi.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
var tmp: RawByteString;
begin
  case aValue.VType of
  ftNull: ; // leave tmp=''
  ftUTF8: fEngine.UTF8BufferToAnsi(aValue.VText,StrLen(aValue.VText),tmp);
  else begin
    result := inherited SetFieldSQLVar(Instance,aValue);
    exit;
  end;
  end;
  fPropInfo.SetLongStrProp(Instance,tmp);
  result := True;
end;

procedure TSQLPropInfoRTTIAnsi.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  fPropInfo.GetLongStrProp(Instance,temp);
  temp := fEngine.AnsiToUTF8(temp);
  aValue.Options := [];
  aValue.VType := ftUTF8;
  aValue.VText := pointer(temp);
end;

procedure TSQLPropInfoRTTIAnsi.CopyValue(Source, Dest: TObject);
begin // avoid temporary variable use, for simple fields with no getter/setter
  if fInPlaceCopySameClassPropOffset=0 then
    fPropInfo.CopyLongStrProp(Source,Dest) else
    PRawByteString(PtrUInt(Dest)+fInPlaceCopySameClassPropOffset)^ :=
      PRawByteString(PtrUInt(Source)+fInPlaceCopySameClassPropOffset)^;
end;


{ TSQLPropInfoRTTIRawUTF8 }

procedure TSQLPropInfoRTTIRawUTF8.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var Value: RawByteString;
begin // don't know why, but fInPlaceCopySameClassPropOffset trick leaks memory :(
  fPropInfo.GetLongStrProp(Source,Value);
  TSQLPropInfoRTTIRawUTF8(DestInfo).fPropInfo.SetLongStrProp(Dest,Value);
end;

function TSQLPropInfoRTTIRawUTF8.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var Up: array[byte] of AnsiChar; // avoid slow heap allocation
    Value: RawByteString;
begin
  fPropInfo.GetLongStrProp(Instance,Value);
  if CaseInsensitive then
    result := crc32c(0,Up,UTF8UpperCopy255(Up,Value)-Up) else
    result := crc32c(0,pointer(Value),length(Value));
end;

procedure TSQLPropInfoRTTIRawUTF8.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var tmp: RawByteString;
begin
  fPropInfo.GetLongStrProp(Instance,tmp);
  if fPropType=TypeInfo(RawJSON) then
    W.AddRawJSON(tmp) else begin
    W.Add('"');
    if tmp<>'' then
      W.AddJSONEscape(pointer(tmp));
    W.Add('"');
  end;
end;

procedure TSQLPropInfoRTTIRawUTF8.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  if wasSQLString<>nil then
    wasSQLString^ := fPropType<>TypeInfo(RawJSON);
  fPropInfo.GetLongStrProp(Instance,RawByteString(result));
end;

function TSQLPropInfoRTTIRawUTF8.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin
  fPropInfo.SetLongStrProp(Instance,FromVarString(PByte(P),PByte(PEnd)));
  result := P;
end;

function TSQLPropInfoRTTIRawUTF8.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
var tmp: RawByteString;
begin
  case aValue.VType of
  ftNull: ; // leave tmp=''
  ftUTF8: SetString(tmp,PAnsiChar(aValue.VText),StrLen(aValue.VText));
  else begin
    result := inherited SetFieldSQLVar(Instance,aValue);
    exit;
  end;
  end;
  fPropInfo.SetLongStrProp(Instance,tmp);
  result := True;
end;

procedure TSQLPropInfoRTTIRawUTF8.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  fPropInfo.GetLongStrProp(Instance,temp);
  aValue.Options := [];
  aValue.VType := ftUTF8;
  aValue.VText := Pointer(temp);
end;

function TSQLPropInfoRTTIRawUTF8.CompareValue(Item1, Item2: TObject;
  CaseInsensitive: boolean): PtrInt;
  function CompareWithLocalTempCopy: PtrInt;
  var tmp1,tmp2: RawByteString;
  begin
    fPropInfo.GetLongStrProp(Item1,tmp1);
    fPropInfo.GetLongStrProp(Item2,tmp2);
    if CaseInsensitive then
      result := UTF8IComp(pointer(tmp1),pointer(tmp2)) else
      result := StrComp(pointer(tmp1),pointer(tmp2));
  end;
var
  offs: PtrUInt;
  p1,p2: pointer;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    offs := fGetterIsFieldPropOffset;
    if offs<>0 then begin // avoid any temporary variable
      p1 := PPointer(PtrUInt(Item1)+offs)^;
      p2 := PPointer(PtrUInt(Item2)+offs)^;
      if CaseInsensitive then
        result := UTF8IComp(p1,p2) else
        result := StrComp(p1,p2);
    end else
      result := CompareWithLocalTempCopy;
  end;
end;

procedure TSQLPropInfoRTTIRawUTF8.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var tmp: RawUTF8;
begin
  if Value<>nil then
    FastSetString(tmp,Value,StrLen(Value));
  fPropInfo.SetLongStrProp(Instance,tmp);
end;

procedure TSQLPropInfoRTTIRawUTF8.SetValueVar(Instance: TObject; const Value: RawUTF8;
  wasString: boolean);
begin
  fPropInfo.SetLongStrProp(Instance,Value);
end;


{ TSQLPropInfoRTTIRawUnicode }

procedure TSQLPropInfoRTTIRawUnicode.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var Value: RawByteString;
begin
  fPropInfo.GetLongStrProp(Source,Value);
  TSQLPropInfoRTTIRawUnicode(DestInfo).fPropInfo.SetLongStrProp(Dest,Value);
end;

function TSQLPropInfoRTTIRawUnicode.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var Up: array[byte] of AnsiChar; // avoid slow heap allocation
    Value: RawByteString;
begin
  fPropInfo.GetLongStrProp(Instance,Value);
  if CaseInsensitive then
    result := crc32c(0,Up,UpperCopy255W(Up,pointer(Value),length(Value)shr 1)-Up) else
    result := crc32c(0,pointer(Value),length(Value));
end;

procedure TSQLPropInfoRTTIRawUnicode.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var tmp: RawByteString;
begin
  if wasSQLString<>nil then
    wasSQLString^ := true;
  fPropInfo.GetLongStrProp(Instance,tmp);
  RawUnicodeToUTF8(pointer(tmp),length(tmp)shr 1,result);
end;

function TSQLPropInfoRTTIRawUnicode.CompareValue(Item1, Item2: TObject;
  CaseInsensitive: boolean): PtrInt;
var tmp1,tmp2: RawByteString;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    fPropInfo.GetLongStrProp(Item1,tmp1);
    fPropInfo.GetLongStrProp(Item2,tmp2);
    if CaseInsensitive then
      result := AnsiICompW(pointer(tmp1),pointer(tmp2)) else
      result := StrCompW(pointer(tmp1),pointer(tmp2));
  end;
end;

procedure TSQLPropInfoRTTIRawUnicode.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
begin
  if Value=nil then
    fPropInfo.SetLongStrProp(Instance,'') else
    fPropInfo.SetLongStrProp(Instance,Utf8DecodeToRawUnicode(Value,StrLen(Value)));
end;

procedure TSQLPropInfoRTTIRawUnicode.SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean);
begin
  fPropInfo.SetLongStrProp(Instance,Utf8DecodeToRawUnicode(Value));
end;


{ TSQLPropInfoRTTIRawBlob }

procedure TSQLPropInfoRTTIRawBlob.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var Value: RawByteString;
begin
  fPropInfo.GetLongStrProp(Source,Value);
  TSQLPropInfoRTTIRawBlob(DestInfo).fPropInfo.SetLongStrProp(Dest,Value);
end;

function TSQLPropInfoRTTIRawBlob.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var Value: RawByteString;
begin
  fPropInfo.GetLongStrProp(Instance,Value);
  result := crc32c(0,pointer(Value),length(Value)); // binary -> case sensitive
end;

procedure TSQLPropInfoRTTIRawBlob.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var tmp: RawByteString;
begin
  fPropInfo.GetLongStrProp(Instance,tmp);
  W.WrBase64(pointer(tmp),length(tmp),true);
end;

procedure TSQLPropInfoRTTIRawBlob.GetBlob(Instance: TObject;
  var Blob: RawByteString);
begin
  fPropInfo.GetLongStrProp(Instance,Blob);
end;

procedure TSQLPropInfoRTTIRawBlob.SetBlob(Instance: TObject;
  const Blob: RawByteString);
begin
  fPropInfo.SetLongStrProp(Instance,Blob);
end;

function TSQLPropInfoRTTIRawBlob.IsNull(Instance: TObject): Boolean;
var Blob: RawByteString;
begin
  fPropInfo.GetLongStrProp(Instance,Blob);
  result := (Blob='');
end;

procedure TSQLPropInfoRTTIRawBlob.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  fPropInfo.GetLongStrProp(Instance,RawByteString(result));
  BinaryToText(result,ToSQL,wasSQLString);
end;

function TSQLPropInfoRTTIRawBlob.CompareValue(Item1, Item2: TObject;
  CaseInsensitive: boolean): PtrInt;
var tmp1,tmp2: RawByteString;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    fPropInfo.GetLongStrProp(Item1,tmp1);
    fPropInfo.GetLongStrProp(Item2,tmp2);
    // BLOB is binary so always case sensitive
    result := StrComp(pointer(tmp1),pointer(tmp2));
  end;
end;

procedure TSQLPropInfoRTTIRawBlob.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
begin
  fPropInfo.SetLongStrProp(Instance,BlobToTSQLRawBlob(Value));
end;

procedure TSQLPropInfoRTTIRawBlob.SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean);
begin
  fPropInfo.SetLongStrProp(Instance,BlobToTSQLRawBlob(Value));
end;

function TSQLPropInfoRTTIRawBlob.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
var tmp: RawByteString;
begin
  case aValue.VType of
  ftBlob: begin
    SetString(tmp,PAnsiChar(aValue.VBlob),aValue.VBlobLen);
    fPropInfo.SetLongStrProp(Instance,tmp);
    result := true;
  end;
  ftNull: begin
    fPropInfo.SetLongStrProp(Instance,'');
    result := true;
  end;
  else result := inherited SetFieldSQLVar(Instance,aValue);
  end;
end;

procedure TSQLPropInfoRTTIRawBlob.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  fPropInfo.GetLongStrProp(Instance,temp);
  aValue.Options := [];
  if temp='' then
    aValue.VType := ftNull else begin
    aValue.VType := ftBlob;
    aValue.VBlob := pointer(temp);
    aValue.VBlobLen := length(temp);
  end;
end;


{ TSQLPropInfoRTTIWide }

procedure TSQLPropInfoRTTIWide.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var Value: WideString;
begin
  fPropInfo.GetWideStrProp(Source,Value);
  TSQLPropInfoRTTIWide(DestInfo).fPropInfo.SetWideStrProp(Dest,Value);
end;

procedure TSQLPropInfoRTTIWide.GetBinary(Instance: TObject; W: TFileBufferWriter);
var Value: WideString;
begin
  fPropInfo.GetWideStrProp(Instance,Value);
  W.Write(WideStringToUTF8(Value));
end;

function TSQLPropInfoRTTIWide.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var Up: array[byte] of AnsiChar; // avoid slow heap allocation
    Value: WideString;
begin
  fPropInfo.GetWideStrProp(Instance,Value);
  if CaseInsensitive then
    result := crc32c(0,Up,UpperCopy255W(Up,pointer(Value),length(Value))-Up) else
    result := crc32c(0,pointer(Value),length(Value)*2);
end;

procedure TSQLPropInfoRTTIWide.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var Value: WideString;
begin
  W.Add('"');
  fPropInfo.GetWideStrProp(Instance,Value);
  if pointer(Value)<>nil then
    W.AddJSONEscapeW(pointer(Value),0);
  W.Add('"');
end;

procedure TSQLPropInfoRTTIWide.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var Value: WideString;
begin
  fPropInfo.GetWideStrProp(Instance,Value);
  result := WideStringToUTF8(Value);
  if wasSQLString<>nil then
    wasSQLString^ := true;
end;

procedure TSQLPropInfoRTTIWide.CopyValue(Source, Dest: TObject);
begin // avoid temporary variable use, for simple fields with no getter/setter
  if fInPlaceCopySameClassPropOffset=0 then
    CopySameClassProp(Source,self,Dest) else
    PWideString(PtrUInt(Dest)+fInPlaceCopySameClassPropOffset)^ :=
      PWideString(PtrUInt(Source)+fInPlaceCopySameClassPropOffset)^;
end;

function TSQLPropInfoRTTIWide.CompareValue(Item1, Item2: TObject;
  CaseInsensitive: boolean): PtrInt;
var tmp1,tmp2: WideString;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    fPropInfo.GetWideStrProp(Item1,tmp1);
    fPropInfo.GetWideStrProp(Item2,tmp2);
    if CaseInsensitive then
      result := AnsiICompW(pointer(tmp1),pointer(tmp2)) else
      result := StrCompW(pointer(tmp1),pointer(tmp2));
  end;
end;

function TSQLPropInfoRTTIWide.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin
  fPropInfo.SetWideStrProp(Instance,
    UTF8ToWideString(FromVarString(PByte(P),pointer(PEnd))));
  result := P;
end;

procedure TSQLPropInfoRTTIWide.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var Wide: WideString;
begin
  if Value<>nil then
    UTF8ToWideString(Value,StrLen(Value),Wide);
  fPropInfo.SetWideStrProp(Instance,Wide);
end;


{$ifdef HASVARUSTRING}

{ TSQLPropInfoRTTIUnicode }

procedure TSQLPropInfoRTTIUnicode.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var tmp: UnicodeString;
begin
  fPropInfo.GetUnicodeStrProp(Source,tmp);
  TSQLPropInfoRTTIUnicode(DestInfo).fPropInfo.SetUnicodeStrProp(Dest,tmp);
end;

procedure TSQLPropInfoRTTIUnicode.GetBinary(Instance: TObject; W: TFileBufferWriter);
var tmp: UnicodeString;
begin
  fPropInfo.GetUnicodeStrProp(Instance,tmp);
  W.Write(UnicodeStringToUtf8(tmp));
end;

procedure TSQLPropInfoRTTIUnicode.CopyValue(Source, Dest: TObject);
begin // avoid temporary variable use, for simple fields with no getter/setter
  if fInPlaceCopySameClassPropOffset=0 then
    CopySameClassProp(Source,self,Dest) else
    PUnicodeString(PtrUInt(Dest)+fInPlaceCopySameClassPropOffset)^ :=
      PUnicodeString(PtrUInt(Source)+fInPlaceCopySameClassPropOffset)^;
end;

function TSQLPropInfoRTTIUnicode.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var Up: array[byte] of AnsiChar; // avoid slow heap allocation
    Value: UnicodeString;
begin
  fPropInfo.GetUnicodeStrProp(Instance,Value);
  if CaseInsensitive then
    result := crc32c(0,Up,UpperCopy255W(Up,pointer(Value),length(Value))-Up) else
    result := crc32c(0,pointer(Value),length(Value)*2);
end;

procedure TSQLPropInfoRTTIUnicode.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var tmp: UnicodeString;
begin
  fPropInfo.GetUnicodeStrProp(Instance,tmp);
  RawUnicodeToUtf8(pointer(tmp),length(tmp),result);
  if wasSQLString<>nil then
    wasSQLString^ := true;
end;

procedure TSQLPropInfoRTTIUnicode.GetJSONValues(Instance: TObject; W: TJSONSerializer);
var tmp: UnicodeString;
begin
  W.Add('"');
  fPropInfo.GetUnicodeStrProp(Instance,tmp);
  if tmp<>'' then
    W.AddJSONEscapeW(pointer(tmp),0);
  W.Add('"');
end;

function TSQLPropInfoRTTIUnicode.CompareValue(Item1, Item2: TObject;
  CaseInsensitive: boolean): PtrInt;
var tmp1,tmp2: UnicodeString;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    fPropInfo.GetUnicodeStrProp(Item1,tmp1);
    fPropInfo.GetUnicodeStrProp(Item2,tmp2);
    if CaseInsensitive then
      result := AnsiICompW(pointer(tmp1),pointer(tmp2)) else
      result := StrCompW(pointer(tmp1),pointer(tmp2));
  end;
end;

function TSQLPropInfoRTTIUnicode.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin
  fPropInfo.SetUnicodeStrProp(Instance,
    UTF8DecodeToUnicodeString(FromVarString(PByte(P),pointer(PEnd))));
  result := P;
end;

procedure TSQLPropInfoRTTIUnicode.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var tmp: UnicodeString;
begin
  if Value<>nil then
    UTF8DecodeToUnicodeString(Value,StrLen(Value),tmp);
  fPropInfo.SetUnicodeStrProp(Instance,tmp);
end;

procedure TSQLPropInfoRTTIUnicode.SetValueVar(Instance: TObject; const Value: RawUTF8; wasString: boolean);
begin
  fPropInfo.SetUnicodeStrProp(Instance,UTF8DecodeToUnicodeString(Value));
end;

function TSQLPropInfoRTTIUnicode.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
var tmp: UnicodeString;
begin
  case aValue.VType of
  ftNull: ; // leave tmp=''
  ftUTF8: UTF8DecodeToUnicodeString(aValue.VText,StrLen(aValue.VText),tmp);
  else begin
    result := inherited SetFieldSQLVar(Instance,aValue);
    exit;
  end;
  end;
  fPropInfo.SetUnicodeStrProp(Instance,tmp);
  result := True;
end;

procedure TSQLPropInfoRTTIUnicode.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
var tmp: UnicodeString;
begin
  fPropInfo.GetUnicodeStrProp(Instance,tmp);
  RawUnicodeToUtf8(pointer(tmp),length(tmp),RawUTF8(temp));
  aValue.Options := [];
  aValue.VType := ftUTF8;
  aValue.VText := Pointer(temp);
end;

{$endif HASVARUSTRING}

type
  TObjArraySerializer = class(TPointerClassHashed)
  protected
    procedure DefaultCustomWriter(const aWriter: TTextWriter; const aValue);
    function DefaultCustomReader(P: PUTF8Char; var aValue; out aValid: Boolean{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
  public
    Instance: TClassInstance;
    CustomReader: TDynArrayJSONCustomReader;
    CustomWriter: TDynArrayJSONCustomWriter;
    constructor Create(aInfo: pointer; aItem: TClass;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter); reintroduce;
  end;
  PTObjArraySerializer = ^TObjArraySerializer;

constructor TObjArraySerializer.Create(aInfo: pointer; aItem: TClass;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
begin
  inherited Create(aInfo);
  Instance.Init(aItem);
  if Assigned(aReader) then
    CustomReader := aReader else
    CustomReader := DefaultCustomReader;
  if Assigned(aWriter) then
    CustomWriter := aWriter else
    CustomWriter := DefaultCustomWriter;
end;

function HasDefaultObjArrayWriter(var dyn: TDynArray): boolean;
var CustomReader: TDynArrayJSONCustomReader;
    CustomWriter, DefaultWriter: TDynArrayJSONCustomWriter;
begin
  result := TTextWriter.GetCustomJSONParser(dyn,CustomReader,CustomWriter);
  if result then begin
    DefaultWriter := TObjArraySerializer(nil).DefaultCustomWriter;
    result := PMethod(@CustomWriter)^.Code=PMethod(@DefaultWriter)^.Code;
  end;
end;

procedure TObjArraySerializer.DefaultCustomWriter(const aWriter: TTextWriter; const aValue);
var opt: TTextWriterWriteObjectOptions;
begin
  opt := DEFAULT_WRITEOPTIONS[twoIgnoreDefaultInRecord in aWriter.CustomOptions];
  if twoEnumSetsAsTextInRecord in aWriter.CustomOptions then
    include(opt,woEnumSetsAsText);
  aWriter.WriteObject(TObject(aValue),opt);
end;

function TObjArraySerializer.DefaultCustomReader(P: PUTF8Char; var aValue;
  out aValid: Boolean{$ifndef NOVARIANTS}; CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
begin
  if TObject(aValue)=nil then
    TObject(aValue) := Instance.CreateNew;
  result := JSONToObject(aValue,P,aValid,nil,JSONTOOBJECT_TOLERANTOPTIONS);
end;

function InternalIsObjArray(aDynArrayTypeInfo: pointer): TPointerClassHashed;
begin
  result := ObjArraySerializers.Find(aDynArrayTypeInfo);
end;


{ TSQLPropInfoRTTIDynArray }

constructor TSQLPropInfoRTTIDynArray.Create(aPropInfo: PPropInfo;
  aPropIndex: integer; aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
var dummy: pointer;
begin
  inherited Create(aPropInfo,aPropIndex,aSQLFieldType,aOptions);
  fObjArray := aPropInfo^.DynArrayIsObjArrayInstance;
  if fObjArray<>nil then
    fSQLDBFieldType := ftUTF8; // matches GetFieldSQLVar() below
  if fGetterIsFieldPropOffset=0 then
    raise EModelException.CreateUTF8('%.Create(%) getter!',[self,fPropType^.Name]);
  fWrapper.Init(fPropType,dummy);
  fWrapper.IsObjArray := fObjArray<>nil;
  fWrapper.HasCustomJSONParser; // set fWrapper.fParser
end;

procedure TSQLPropInfoRTTIDynArray.GetDynArray(Instance: TObject; var result: TDynArray);
begin // fast assignment of fWrapper pre-initialized RTTI
  result.InitFrom(fWrapper,pointer(PtrUInt(Instance)+fGetterIsFieldPropOffset)^);
end;

procedure TSQLPropInfoRTTIDynArray.Serialize(Instance: TObject;
  var data: RawByteString; ExtendedJson: boolean);
var da: TDynArray;
    temp: TTextWriterStackBuffer;
begin
  GetDynArray(Instance,da);
  if da.Count=0 then
    data := '' else
    if fObjArray<>nil then
      with TJSONSerializer.CreateOwnedStream(temp) do
      try
        if ExtendedJson then
          include(fCustomOptions,twoForceJSONExtended); // smaller content
        AddDynArrayJSON(da);
        SetText(RawUTF8(data));
      finally
        Free;
      end else
      data := da.SaveTo;
end;

procedure TSQLPropInfoRTTIDynArray.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var sda,dda: TDynArray;
begin
  GetDynArray(Source,sda);
  TSQLPropInfoRTTIDynArray(DestInfo).GetDynArray(Dest,dda);
  if (fObjArray<>nil) or (TSQLPropInfoRTTIDynArray(DestInfo).fObjArray<>nil) or
     (sda.ArrayType<>dda.ArrayType) then
    dda.LoadFromJSON(pointer(sda.SaveToJSON)) else
    dda.Copy(sda);
end;

procedure TSQLPropInfoRTTIDynArray.GetBinary(Instance: TObject; W: TFileBufferWriter);
var Value: RawByteString;
begin
  Serialize(Instance,Value,true);
  if fObjArray<>nil then
    W.Write(Value) else
    W.WriteBinary(Value);
end;

function TSQLPropInfoRTTIDynArray.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
var tmp: RawByteString;
begin
  Serialize(Instance,tmp,true);
  result := crc32c(0,pointer(tmp),length(tmp));
end;

procedure TSQLPropInfoRTTIDynArray.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  Serialize(Instance,RawByteString(result),false);
  if fObjArray=nil then
    BinaryToText(result,ToSQL,wasSQLString);
end;

{$ifndef NOVARIANTS}

procedure TSQLPropInfoRTTIDynArray.GetVariant(Instance: TObject; var Dest: Variant);
var json: RawUTF8;
    da: TDynArray;
begin
  GetDynArray(Instance,da);
  json := da.SaveToJSON;
  VarClear(Dest);
  TDocVariantData(Dest).InitJSONInPlace(pointer(json),JSON_OPTIONS_FAST);
end;

procedure TSQLPropInfoRTTIDynArray.SetVariant(Instance: TObject; const Source: Variant);
var json: RawUTF8;
    da: TDynArray;
begin
  GetDynArray(Instance,da);
  VariantSaveJSON(Source,twJSONEscape,json);
  da.LoadFromJSON(pointer(json));
end;

{$endif NOVARIANTS}

procedure TSQLPropInfoRTTIDynArray.NormalizeValue(var Value: RawUTF8);
begin // do nothing: should already be normalized
end;

function TSQLPropInfoRTTIDynArray.CompareValue(Item1, Item2: TObject; CaseInsensitive: boolean): PtrInt;
var da1,da2: TDynArray;
    i: integer;
begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    GetDynArray(Item1,da1);
    GetDynArray(Item2,da2);
    result := da1.Count-da2.Count;
    if result<>0 then
      exit;
    result := PtrInt(Item1)-PtrInt(Item2); // pseudo comparison
    if fObjArray<>nil then begin
      for i := 0 to da1.Count-1 do
        if not ObjectEquals(PObjectArray(da1.Value^)[i],PObjectArray(da2.Value^)[i]) then
          exit;
    end else
      if not da1.Equals(da2) then
        exit;
    result := 0;
  end;
end;

function TSQLPropInfoRTTIDynArray.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
var tmp: TSynTempBuffer; // LoadFromJSON() may change the input buffer
    da: TDynArray;
begin
  GetDynArray(Instance,da);
  if fObjArray<>nil then begin
    FromVarString(PByte(P),PByte(PEnd),tmp);
    try // T*ObjArray use JSON serialization
      da.LoadFromJSON(tmp.buf);
    finally
      tmp.Done;
    end;
    result := P;
  end else
    // regular dynamic arrays use our binary encoding
    result := da.LoadFrom(P,nil,{nohash=}true,PEnd);
end;

procedure TSQLPropInfoRTTIDynArray.SetValue(Instance: TObject;
  Value: PUTF8Char; wasString: boolean);
var tmp: TSynTempBuffer;
    da: TDynArray;
begin
  GetDynArray(Instance,da);
  if Value=nil then
    da.Clear else
    try
      if (fObjArray=nil) and Base64MagicCheckAndDecode(Value,tmp) then
        da.LoadFrom(tmp.buf,nil,{nohash=}true,PAnsiChar(tmp.buf)+tmp.len) else
        da.LoadFromJSON(tmp.Init(Value));
    finally
      tmp.Done;
    end;
end;

function TSQLPropInfoRTTIDynArray.SetFieldSQLVar(Instance: TObject;
  const aValue: TSQLVar): boolean;
var da: TDynArray;
begin
  if aValue.VType=ftBlob then begin
    GetDynArray(Instance,da);
    result := da.LoadFrom(aValue.VBlob,nil,{nohash=}true,
      PAnsiChar(aValue.VBlob)+aValue.VBlobLen)<>nil;
  end else
    result := inherited SetFieldSQLVar(Instance,aValue);
end;

procedure TSQLPropInfoRTTIDynArray.GetJSONValues(Instance: TObject;
  W: TJSONSerializer);
var tmp: RawByteString;
begin
  if jwoAsJsonNotAsString in W.fSQLRecordOptions then
    W.AddDynArrayJSON(fPropType,GetFieldAddr(Instance)^) else
    if fObjArray<>nil then
      W.AddDynArrayJSONAsString(fPropType,GetFieldAddr(Instance)^) else begin
      Serialize(Instance,tmp,false);
      W.WrBase64(pointer(tmp),Length(tmp),true); // withMagic=true -> add ""
    end;
end;

procedure TSQLPropInfoRTTIDynArray.GetFieldSQLVar(Instance: TObject;
  var aValue: TSQLVar; var temp: RawByteString);
begin
  Serialize(Instance,temp,false);
  aValue.Options := [];
  if temp='' then
    aValue.VType := ftNull else
    if fObjArray<>nil then begin
      aValue.VType := ftUTF8; // JSON
      aValue.VText := pointer(temp);
    end else begin
      aValue.VType := ftBlob; // binary
      aValue.VBlob := pointer(temp);
      aValue.VBlobLen := length(temp);
    end;
end;

function TSQLPropInfoRTTIDynArray.GetDynArrayElemType: PTypeInfo;
begin
  result := fWrapper.ElemType;
end;


{$ifndef NOVARIANTS}

{ TSQLPropInfoRTTIVariant }

constructor TSQLPropInfoRTTIVariant.Create(aPropInfo: PPropInfo; aPropIndex: integer;
  aSQLFieldType: TSQLFieldType; aOptions: TSQLPropInfoListOptions);
begin
  inherited;
  if aSQLFieldType=sftVariant then
    fDocVariantOptions := JSON_OPTIONS_FAST else
    fSQLFieldType := sftNullable; // TNullable* will use fSQLFieldTypeStored
end;

procedure TSQLPropInfoRTTIVariant.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
var value: Variant;
begin
  fPropInfo.GetVariantProp(Source,value);
  TSQLPropInfoRTTIVariant(DestInfo).fPropInfo.SetVariantProp(Dest,value);
end;

procedure TSQLPropInfoRTTIVariant.GetBinary(Instance: TObject;
  W: TFileBufferWriter);
var value: Variant;
begin
  fPropInfo.GetVariantProp(Instance,value);
  W.Write(value);
end;

function TSQLPropInfoRTTIVariant.GetHash(Instance: TObject;
  CaseInsensitive: boolean): cardinal;
var value: Variant;
begin
  fPropInfo.GetVariantProp(Instance,value);
  result := VariantHash(value,CaseInsensitive);
end;

procedure TSQLPropInfoRTTIVariant.GetJSONValues(Instance: TObject;
  W: TJSONSerializer);
var value: Variant;
    backup: TTextWriterOptions;
begin
  fPropInfo.GetVariantProp(Instance,value);
  backup := W.CustomOptions;
  if jwoAsJsonNotAsString in W.fSQLRecordOptions then
    W.CustomOptions := backup+[twoForceJSONStandard]-[twoForceJSONExtended];
  W.AddVariant(value,twJSONEscape); // even sftNullable should escape strings
  W.CustomOptions := backup;
end;

procedure TSQLPropInfoRTTIVariant.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var wasString: boolean;
    value: Variant;
begin
  fPropInfo.GetVariantProp(Instance,value);
  VariantToUTF8(value,result,wasString);
  if wasSQLString<>nil then
    if fSQLFieldType=sftNullable then
      // only TNullableUTF8Text and TNullableDateTime will be actual text
      wasSQLString^ := (fSQLDBFieldType in TEXT_DBFIELDS) and
                        not VarIsEmptyOrNull(value) else
      // from SQL point of view, variant columns are TEXT or NULL
      wasSQLString^ := not VarIsEmptyOrNull(value);
end;

procedure TSQLPropInfoRTTIVariant.GetVariant(Instance: TObject;
  var Dest: Variant);
begin
  fPropInfo.GetVariantProp(Instance,Dest);
end;

procedure TSQLPropInfoRTTIVariant.NormalizeValue(var Value: RawUTF8);
begin // content should be already normalized
end;

function TSQLPropInfoRTTIVariant.CompareValue(Item1, Item2: TObject;
  CaseInsensitive: boolean): PtrInt;

  function CompareWithLocalTempCopy: PtrInt;
  var V1,V2: variant;
  begin
    fPropInfo.GetVariantProp(Item1,V1);
    fPropInfo.GetVariantProp(Item2,V2);
    result := SortDynArrayVariantComp(TVarData(V1),TVarData(V2),CaseInsensitive);
  end;

begin
  if Item1=Item2 then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else
    if fGetterIsFieldPropOffset<>0 then // avoid any temporary variable
      result := SortDynArrayVariantComp(PVarData(PtrUInt(Item1)+fGetterIsFieldPropOffset)^,
          PVarData(PtrUInt(Item2)+fGetterIsFieldPropOffset)^,CaseInsensitive) else
      result := CompareWithLocalTempCopy;
end;

function TSQLPropInfoRTTIVariant.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
var value: Variant;
begin // use our VariantLoad() binary serialization
  if fSQLFieldType=sftNullable then
    result := VariantLoad(value,P,nil,PEnd) else
    result := VariantLoad(value,P,@DocVariantOptions,PEnd);
  fPropInfo.SetVariantProp(Instance,value);
end;

procedure TSQLPropInfoRTTIVariant.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
begin
  SetValuePtr(Instance,Value,StrLen(Value),wasString);
end;

procedure TSQLPropInfoRTTIVariant.SetValueVar(Instance: TObject;
  const Value: RawUTF8; wasString: boolean);
begin
  SetValuePtr(Instance,pointer(Value),length(Value),wasString);
end;

procedure TSQLPropInfoRTTIVariant.SetValuePtr(Instance: TObject; Value: PUTF8Char;
  ValueLen: integer; wasString: boolean);
var tmp: TSynTempBuffer;
    V: Variant;
begin
  if ValueLen>0 then begin
    tmp.Init(Value,ValueLen);
    try
      if fSQLFieldType=sftNullable then
        if fSQLDBFieldType=ftDate then begin // decode as date/time variant
          TVarData(V).VType := varDate;
          TVarData(V).VDate := Iso8601ToDateTimePUTF8Char(Value,ValueLen);
        end else
          GetVariantFromJSON(tmp.buf,wasString,V,nil) else begin
        if wasString and (GotoNextNotSpace(Value)^ in ['{','[']) then
          wasString := false; // allow to create a TDocVariant stored as DB text
        GetVariantFromJSON(tmp.buf,wasString,V,@DocVariantOptions);
      end;
      fPropInfo.SetVariantProp(Instance,V);
    finally
      tmp.Done;
    end;
  end else begin
    TVarData(V).VType := varNull; // TEXT or NULL: see GetValueVar()
    fPropInfo.SetVariantProp(Instance,V);
  end;
end;

procedure TSQLPropInfoRTTIVariant.SetVariant(Instance: TObject;
  const Source: Variant);
begin
  fPropInfo.SetVariantProp(Instance,Source);
end;

{$endif NOVARIANTS}


{ TSQLPropInfoCustom }

function TSQLPropInfoCustom.GetFieldAddr(Instance: TObject): pointer;
begin
  if Instance=nil then
    result := nil else
    result := PAnsiChar(Instance)+fOffset;
end;

constructor TSQLPropInfoCustom.Create(const aName: RawUTF8;
  aSQLFieldType: TSQLFieldType; aAttributes: TSQLPropInfoAttributes;
  aFieldWidth, aPropIndex: integer; aProperty: pointer;
  aData2Text: TOnSQLPropInfoRecord2Text; aText2Data: TOnSQLPropInfoRecord2Data);
begin
  inherited Create(aName,aSQLFieldType,aAttributes,aFieldWidth,aPropIndex);
  fOffset := PtrUInt(aProperty);
  if (Assigned(aData2Text) and not Assigned(aText2Data)) or
     (Assigned(aText2Data) and not Assigned(aData2Text)) then
    raise EModelException.CreateUTF8(
      'Invalid %.Create: expecting both Data2Text/Text2Data',[self]);
  fData2Text := aData2Text;
  fText2Data := aText2Data;
end;

procedure TSQLPropInfoCustom.TextToBinary(Value: PUTF8Char; var result: RawByteString);
begin
  if Assigned(fText2Data) then
    fText2Data(Value,result) else
    result := BlobToTSQLRawBlob(Value);
end;

procedure TSQLPropInfoCustom.BinaryToText(var Value: RawUTF8; ToSQL: boolean;
  wasSQLString: PBoolean);
begin
  if Assigned(fData2Text) then
    fData2Text(UniqueRawUTF8(Value),length(Value),Value) else
    inherited BinaryToText(Value,ToSQL,wasSQLString);
end;


{ TSQLPropInfoRecordRTTI }

procedure TSQLPropInfoRecordRTTI.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
begin
  if TSQLPropInfoRecordRTTI(DestInfo).fTypeInfo=fTypeInfo then
    RecordCopy(TSQLPropInfoRecordRTTI(DestInfo).GetFieldAddr(Dest)^,
      GetFieldAddr(Source)^,fTypeInfo) else
    inherited CopySameClassProp(Source,DestInfo,Dest);
end;

function TSQLPropInfoRecordRTTI.GetSQLFieldRTTITypeName: RawUTF8;
begin
  if fTypeInfo=nil then
    result := inherited GetSQLFieldRTTITypeName else
    result := ToUTF8(fTypeInfo^.Name);
end;

constructor TSQLPropInfoRecordRTTI.Create(aRecordInfo: PTypeInfo;
  const aName: RawUTF8; aPropertyIndex: integer; aPropertyPointer: pointer;
  aAttributes: TSQLPropInfoAttributes; aFieldWidth: integer;
  aData2Text: TOnSQLPropInfoRecord2Text; aText2Data: TOnSQLPropInfoRecord2Data);
begin
  if (aRecordInfo=nil) or not(aRecordInfo^.Kind in tkRecordTypes) then
    raise EORMException.CreateUTF8('%.Create: Invalid type information for %',[self,aName]);
  inherited Create(aName,sftBlobCustom,aAttributes,aFieldWidth,aPropertyIndex,
    aPropertyPointer,aData2Text,aText2Data);
  fTypeInfo := aRecordInfo;
end;

procedure TSQLPropInfoRecordRTTI.GetBinary(Instance: TObject; W: TFileBufferWriter);
var Value: RawByteString;
begin
  Value := RecordSave(GetFieldAddr(Instance)^,fTypeInfo);
  W.Write(pointer(Value),length(Value));
end;

function TSQLPropInfoRecordRTTI.GetHash(Instance: TObject;
  CaseInsensitive: boolean): cardinal;
var tmp: TSynTempBuffer;
begin
  RecordSave(GetFieldAddr(Instance)^,tmp,fTypeInfo);
  result := crc32c(0,tmp.buf,tmp.len);
  tmp.Done;
end;

{$ifndef NOVARIANTS}
procedure TSQLPropInfoRecordRTTI.GetVariant(Instance: TObject; var Dest: Variant);
begin
  RawByteStringToVariant(RecordSave(GetFieldAddr(Instance)^,fTypeInfo),Dest);
end;

procedure TSQLPropInfoRecordRTTI.SetVariant(Instance: TObject; const Source: Variant);
var tmp: RawByteString;
begin
  VariantToRawByteString(Source,tmp);
  RecordLoad(GetFieldAddr(Instance)^,tmp,fTypeInfo);
end;
{$endif NOVARIANTS}

procedure TSQLPropInfoRecordRTTI.NormalizeValue(var Value: RawUTF8);
begin // a BLOB should already be normalized
end;

function TSQLPropInfoRecordRTTI.CompareValue(Item1, Item2: TObject;
  CaseInsensitive: boolean): PtrInt;
begin
  if RecordEquals(GetFieldAddr(Item1)^,GetFieldAddr(Item2)^,fTypeInfo) then
    result := 0 else
    result := PtrInt(Item1)-PtrInt(Item2); // pseudo comparison
end;

function TSQLPropInfoRecordRTTI.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin // use our RecordLoad() binary serialization
  result := RecordLoad(GetFieldAddr(Instance)^,P,fTypeInfo,nil,PEnd);
end;

procedure TSQLPropInfoRecordRTTI.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var data: RawByteString;
begin
  TextToBinary(Value,data);
  RecordLoad(GetFieldAddr(Instance)^,data,fTypeInfo);
end;

procedure TSQLPropInfoRecordRTTI.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  result := RecordSave(GetFieldAddr(Instance)^,fTypeInfo);
  BinaryToText(result,ToSQL,wasSQLString);
end;

function TSQLPropInfoRecordRTTI.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
begin
  if aValue.VType=ftBlob then
    result := RecordLoad(GetFieldAddr(Instance)^,aValue.VBlob,fTypeInfo)<>nil else
    result := inherited SetFieldSQLVar(Instance,aValue);
end;

procedure TSQLPropInfoRecordRTTI.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  temp := RecordSave(GetFieldAddr(Instance)^,fTypeInfo);
  aValue.Options := [];
  aValue.VType := ftBlob;
  aValue.VBlob := pointer(temp);
  aValue.VBlobLen := length(temp);
end;


{ TSQLPropInfoRecordFixedSize }

procedure TSQLPropInfoRecordFixedSize.CopySameClassProp(Source: TObject;
  DestInfo: TSQLPropInfo; Dest: TObject);
begin
  if TSQLPropInfoRecordFixedSize(DestInfo).fTypeInfo=fTypeInfo then
    MoveFast(GetFieldAddr(Source)^,
      TSQLPropInfoRecordFixedSize(DestInfo).GetFieldAddr(Dest)^,fRecordSize) else
    inherited CopySameClassProp(Source,DestInfo,Dest);
end;

function TSQLPropInfoRecordFixedSize.GetSQLFieldRTTITypeName: RawUTF8;
begin
  if fTypeInfo=nil then
    result := inherited GetSQLFieldRTTITypeName else
    result := ToUTF8(fTypeInfo^.Name);
end;

constructor TSQLPropInfoRecordFixedSize.Create(aRecordSize: cardinal;
  const aName: RawUTF8; aPropertyIndex: integer;
  aPropertyPointer: pointer; aAttributes: TSQLPropInfoAttributes;
  aFieldWidth: integer; aData2Text: TOnSQLPropInfoRecord2Text;
  aText2Data: TOnSQLPropInfoRecord2Data);
begin
  if integer(aRecordSize)<=0 then
    raise EORMException.CreateUTF8('%.Create: invalid % record size',[self,aRecordSize]);
  fRecordSize := aRecordSize;
  inherited Create(aName,sftBlobCustom,aAttributes,aFieldWidth,aPropertyIndex,
    aPropertyPointer,aData2Text,aText2Data);
end;

procedure TSQLPropInfoRecordFixedSize.GetBinary(Instance: TObject; W: TFileBufferWriter);
begin
  W.Write(GetFieldAddr(Instance),fRecordSize);
end;

function TSQLPropInfoRecordFixedSize.GetHash(Instance: TObject; CaseInsensitive: boolean): cardinal;
begin
  result := crc32c(0,GetFieldAddr(Instance),fRecordSize);
end;

procedure TSQLPropInfoRecordFixedSize.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
begin
  FastSetString(result,GetFieldAddr(Instance),fRecordSize);
  BinaryToText(result,ToSQL,wasSQLString);
end;

{$ifndef NOVARIANTS}
procedure TSQLPropInfoRecordFixedSize.GetVariant(Instance: TObject;
  var Dest: Variant);
var tmp: RawByteString;
begin
  SetString(tmp,PAnsiChar(GetFieldAddr(Instance)),fRecordSize);
  Dest := tmp;
end;

procedure TSQLPropInfoRecordFixedSize.SetVariant(Instance: TObject;
  const Source: Variant);
begin
  if TVarData(Source).VType=varString then
    MoveFast(TVarData(Source).VAny^,GetFieldAddr(Instance)^,fRecordSize) else
    FillCharFast(GetFieldAddr(Instance)^,fRecordSize,0);
end;
{$endif NOVARIANTS}

procedure TSQLPropInfoRecordFixedSize.NormalizeValue(var Value: RawUTF8);
begin // a BLOB should already be normalized
end;

function TSQLPropInfoRecordFixedSize.CompareValue(Item1, Item2: TObject;
  CaseInsensitive: boolean): PtrInt;
var i: Integer;
    P1,P2: PByteArray;
begin
  if (Item1=Item2) or (fRecordSize=0) then
    result := 0 else
  if Item1=nil then
    result := -1 else
  if Item2=nil then
    result := 1 else begin
    result := 0;
    P1 := GetFieldAddr(Item1);
    P2 := GetFieldAddr(Item2);
    for i := 0 to fRecordSize-1 do begin
      result := P1^[i]-P2^[i];
      if result<>0 then
        exit;
    end;
  end;
end;

function TSQLPropInfoRecordFixedSize.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
begin
  result := P+fRecordSize;
  if result>PEnd then
    result := nil else
    MoveFast(P^,GetFieldAddr(Instance)^,fRecordSize);
end;

procedure TSQLPropInfoRecordFixedSize.SetValue(Instance: TObject; Value: PUTF8Char;
  wasString: boolean);
var data: RawByteString;
begin
  TextToBinary(Value,data);
  Value := pointer(data);
  if Value=nil then
    FillCharFast(GetFieldAddr(Instance)^,fRecordSize,0) else
    MoveFast(Value^,GetFieldAddr(Instance)^,fRecordSize);
end;

function TSQLPropInfoRecordFixedSize.SetFieldSQLVar(Instance: TObject; const aValue: TSQLVar): boolean;
begin
  if aValue.VType=ftBlob then begin
    result := aValue.VBlobLen=fRecordSize;
    if result then
      MoveFast(aValue.VBlob^,GetFieldAddr(Instance)^,fRecordSize)
  end else
    result := inherited SetFieldSQLVar(Instance,aValue);
end;

procedure TSQLPropInfoRecordFixedSize.GetFieldSQLVar(Instance: TObject; var aValue: TSQLVar;
  var temp: RawByteString);
begin
  SetString(temp,PAnsiChar(GetFieldAddr(Instance)),fRecordSize);
  aValue.Options := [];
  aValue.VType := ftBlob;
  aValue.VBlob := pointer(temp);
  aValue.VBlobLen := length(temp);
end;


{ TSQLPropInfoCustomJSON }

constructor TSQLPropInfoCustomJSON.Create(aPropInfo: PPropInfo; aPropIndex: integer);
var attrib: TSQLPropInfoAttributes;
begin
  byte(attrib) := 0;
  if aPropInfo^.IsStored(nil)=AS_UNIQUE then
    Include(attrib,aIsUnique); // property MyProperty: RawUTF8 stored AS_UNIQUE;ieldWidth=10
  Create(aPropInfo^.TypeInfo,ToUTF8(aPropInfo^.Name),
    aPropIndex,aPropInfo^.GetFieldAddr(nil),attrib,aPropInfo^.Index);
end;

constructor TSQLPropInfoCustomJSON.Create(aTypeInfo: PTypeInfo;
  const aName: RawUTF8; aPropertyIndex: integer; aPropertyPointer: pointer;
  aAttributes: TSQLPropInfoAttributes; aFieldWidth: integer);
begin
  inherited Create(aName,sftUTF8Custom,aAttributes,aFieldWidth,aPropertyIndex,
    aPropertyPointer,nil,nil);
  fTypeInfo := aTypeInfo;
  SetCustomParser(TJSONCustomParserRTTI.CreateFromRTTI(aName,aTypeInfo,0));
end;

constructor TSQLPropInfoCustomJSON.Create(const aTypeName, aName: RawUTF8;
  aPropertyIndex: integer; aPropertyPointer: pointer;
  aAttributes: TSQLPropInfoAttributes; aFieldWidth: integer);
begin
  inherited Create(aName,sftUTF8Custom,aAttributes,aFieldWidth,aPropertyIndex,
    aPropertyPointer,nil,nil);
  SetCustomParser(TJSONCustomParserRTTI.CreateFromTypeName(aName,aTypeName));
end;

function TSQLPropInfoCustomJSON.GetSQLFieldRTTITypeName: RawUTF8;
begin
  if fTypeInfo=nil then
    result := inherited GetSQLFieldRTTITypeName else
    result := ToUTF8(fTypeInfo^.Name);
end;

procedure TSQLPropInfoCustomJSON.SetCustomParser(
  aCustomParser: TJSONCustomParserRTTI);
begin
  if aCustomParser=nil then
    raise EORMException.CreateUTF8('%.SetCustomParser: Invalid type information for %',
      [self,Name]);
  fCustomParser := aCustomParser;
end;

destructor TSQLPropInfoCustomJSON.Destroy;
begin
  inherited;
  fCustomParser.Free;
end;

procedure TSQLPropInfoCustomJSON.GetBinary(Instance: TObject;
  W: TFileBufferWriter);
var JSON: RawUTF8;
begin
  GetValueVar(Instance,false,JSON,nil);
  W.Write(JSON);
end;

function TSQLPropInfoCustomJSON.SetBinary(Instance: TObject; P,PEnd: PAnsiChar): PAnsiChar;
var tmp: TSynTempBuffer;
begin // stored as JSON VarString in the binary stream
  if FromVarString(PByte(P),PByte(PEnd),tmp) then
    try
      SetValue(Instance,tmp.buf,false);
    finally
      tmp.Done;
    end else
    P := nil;
  result := P;
end;

procedure TSQLPropInfoCustomJSON.NormalizeValue(var Value: RawUTF8);
begin // do nothing: should already be normalized
end;

procedure TSQLPropInfoCustomJSON.GetJSONValues(Instance: TObject;
  W: TJSONSerializer);
var Data: PByte;
begin
  Data := GetFieldAddr(Instance);
  fCustomParser.WriteOneLevel(W,Data,
    [soReadIgnoreUnknownFields,soCustomVariantCopiedByReference]);
end;

procedure TSQLPropInfoCustomJSON.GetValueVar(Instance: TObject;
  ToSQL: boolean; var result: RawUTF8; wasSQLString: PBoolean);
var W: TJSONSerializer;
    temp: TTextWriterStackBuffer;
begin
  W := TJSONSerializer.CreateOwnedStream(temp);
  try
    GetJSONValues(Instance,W);
    W.SetText(result);
    if wasSQLString<>nil then
      wasSQLString^ := (result<>'') and (result[1]='"');
  finally
    W.Free;
  end;
end;

procedure TSQLPropInfoCustomJSON.SetValue(Instance: TObject;
  Value: PUTF8Char; wasString: boolean);
var Data: PByte;
    B: PUTF8Char;
    len: PtrInt;
    tmp: RawUTF8;
begin
  Data := GetFieldAddr(Instance);
  if Value<>nil then begin // exact JSON string, array of objet ?
    B := GotoNextJSONObjectOrArray(Value);
    if (B=nil) and (Value^='"') then begin
      B := GotoEndOfJSONString(Value);
      if B^<>'"' then
        B := nil;
    end;
    len := StrLen(Value);
    if (B=nil) or (B-Value<>len) then begin
      QuotedStrJSON(Value,len,tmp); // need escaping as JSON string
      Value := pointer(tmp);
    end;
  end;
  fCustomParser.ReadOneLevel(Value,Data,
    [soReadIgnoreUnknownFields,soCustomVariantCopiedByReference],nil);
end;


{ TSQLPropInfoList }

constructor TSQLPropInfoList.Create(aTable: TClass; aOptions: TSQLPropInfoListOptions);
begin
  fTable := aTable;
  fOptions := aOptions;
  if aTable.InheritsFrom(TSQLRecordRTreeAbstract) then
    include(fOptions,pilAuxiliaryFields);
  if pilSubClassesFlattening in fOptions then
    InternalAddParentsFirst(aTable,nil) else
    InternalAddParentsFirst(aTable);
end;

destructor TSQLPropInfoList.Destroy;
var i: integer;
begin
  for i := 0 to fCount-1 do
    fList[i].Free;
  inherited;
end;

procedure TSQLPropInfoList.InternalAddParentsFirst(aClassType: TClass;
  aFlattenedProps: PPropInfoDynArray);
var P: PPropInfo;
    i,prev: Integer;
begin
  if aClassType=nil then
    exit; // no RTTI information (e.g. reached TObject level)
  if not (pilSingleHierarchyLevel in fOptions) then
    InternalAddParentsFirst(GetClassParent(aClassType),aFlattenedProps);
  for i := 1 to InternalClassPropInfo(aClassType,P) do begin
    if (P^.PropType^.Kind=tkClass) and
       (P^.PropType^.ClassSQLFieldType in [sftObject,sftUnknown]) then begin
      prev := PtrArrayAdd(aFlattenedProps,P);
      InternalAddParentsFirst(P^.PropType^.ClassType^.ClassType,aFlattenedProps);
      SetLength(aFlattenedProps,prev);
    end else
    if not(pilIgnoreIfGetter in fOptions) or P^.GetterIsField then
      Add(TSQLPropInfoRTTI.CreateFrom(P,Count,fOptions,aFlattenedProps));
    P := P^.Next;
  end;
end;

procedure TSQLPropInfoList.InternalAddParentsFirst(aClassType: TClass);
var P: PPropInfo;
    i: Integer;
begin
  if aClassType=nil then
    exit; // no RTTI information (e.g. reached TObject level)
  if not (pilSingleHierarchyLevel in fOptions) then
    InternalAddParentsFirst(GetClassParent(aClassType));
  for i := 1 to InternalClassPropInfo(aClassType,P) do begin
    Add(TSQLPropInfoRTTI.CreateFrom(P,Count,fOptions,nil));
    P := P^.Next;
  end;
end;

function TSQLPropInfoList.Add(aItem: TSQLPropInfo): integer;
var f: integer;
begin
  if aItem=nil then begin
    result := -1;
    exit;
  end;
  // check that this property is not an ID/RowID (handled separately)
  if IsRowID(pointer(aItem.Name)) and not (pilAllowIDFields in fOptions) then
    raise EModelException.CreateUTF8(
      '%.Add: % should not include a [%] published property',[self,fTable,aItem.Name]);
  // check that this property name is not already defined
  for f := 0 to fCount-1 do
    if IdemPropNameU(fList[f].Name,aItem.Name) then
      raise EModelException.CreateUTF8('%.Add: % has duplicated name [%]',
        [self,fTable,aItem.Name]);
  // add to the internal list
  result := fCount;
  if result>=length(fList) then
    SetLength(fList,NextGrow(result));
  inc(fCount);
  fList[result] := aItem;
  fOrderedByName := nil; // force recompute sorted name array
end;

function TSQLPropInfoList.GetItem(aIndex: integer): TSQLPropInfo;
begin
  if cardinal(aIndex)>=Cardinal(fCount) then
    EORMException.Create('Invalid TSQLPropInfoList index');
  result := fList[aIndex];
end;

procedure TSQLPropInfoList.QuickSortByName(L,R: PtrInt);
var I,J,P,Tmp: PtrInt;
    pivot: PUTF8Char;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L+R) shr 1;
    repeat
      pivot := pointer(fList[fOrderedByName[P]].fName);
      while StrIComp(pointer(fList[fOrderedByName[I]].fName),pivot)<0 do inc(I);
      while StrIComp(pointer(fList[fOrderedByName[J]].fName),pivot)>0 do dec(J);
      if I <= J then begin
        Tmp := fOrderedByName[J];
        fOrderedByName[J] := fOrderedByName[I];
        fOrderedByName[I] := Tmp;
        if P=I then P := J else if P=J then P := I;
        inc(I); dec(J);
      end;
    until I>J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortByName(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortByName(I, R);
      R := J;
    end;
  until L >= R;
end;

function TSQLPropInfoList.ByRawUTF8Name(const aName: RawUTF8): TSQLPropInfo;
var i: integer;
begin
  i := IndexByName(pointer(aName));
  if i<0 then
    result := nil else
    result := fList[i];
end;

function TSQLPropInfoList.ByName(aName: PUTF8Char): TSQLPropInfo;
var i: integer;
begin
  i := IndexByName(aName);
  if i<0 then
    result := nil else
    result := fList[i];
end;

function TSQLPropInfoList.IndexByName(aName: PUTF8Char): integer;
var cmp,L,R: integer;
begin
  if (self<>nil) and (aName<>nil) and (fCount>0) then
  if fCount<5 then begin
    for result := 0 to fCount-1 do
      if StrIComp(pointer(fList[result].fName),aName)=0 then
        exit;
  end else begin
    if fOrderedByName=nil then begin
      SetLength(fOrderedByName,fCount);
      FillIncreasing(pointer(fOrderedByName),0,fCount);
      QuickSortByName(0,fCount-1);
    end;
    L := 0;
    R := fCount-1;
    repeat // fast O(log(n)) binary search
      result := (L+R)shr 1;
      cmp := StrIComp(pointer(fList[fOrderedByName[result]].fName),aName);
      if cmp=0 then begin
        result := fOrderedByName[result];
        exit;
      end;
      if cmp<0 then
        L := result+1 else
        R := result-1;
    until L>R;
  end;
  result := -1;
end;

function TSQLPropInfoList.IndexByName(const aName: RawUTF8): integer;
begin
  result := IndexByName(pointer(aName));
end;

function TSQLPropInfoList.IndexByNameOrExcept(const aName: RawUTF8): integer;
begin
  if IsRowID(pointer(aName)) then
    result := -1 else begin
    result := IndexByName(pointer(aName)); // fast O(log(n)) binary search
    if result<0 then
      raise EORMException.CreateUTF8(
        '%.IndexByNameOrExcept(%): unkwnown field in %',[self,aName,fTable]);
  end;
end;

procedure TSQLPropInfoList.IndexesByNamesOrExcept(const aNames: array of RawUTF8;
  const aIndexes: array of PInteger);
var i: integer;
begin
  if high(aNames)<>high(aIndexes) then
    raise EORMException.CreateUTF8('%.IndexesByNamesOrExcept(?)',[self]);
  for i := 0 to high(aNames) do
    if aIndexes[i]=nil then
      raise EORMException.CreateUTF8('%.IndexesByNamesOrExcept(aIndexes[%]=nil)',[self,aNames[i]]) else
      aIndexes[i]^ := IndexByNameOrExcept(aNames[i]);
end;

procedure TSQLPropInfoList.NamesToRawUTF8DynArray(var Names: TRawUTF8DynArray);
var i: integer;
begin
  SetLength(Names,Count);
  for i := 0 to Count-1 do
    Names[i] := fList[i].Name;
end;

function TSQLPropInfoList.IndexByNameUnflattenedOrExcept(const aName: RawUTF8): integer;
begin
  if pilSubClassesFlattening in fOptions then begin
    for result := 0 to Count-1 do
      if IdemPropNameU(List[result].NameUnflattened,aName) then // O(n) iteration
        exit;
  end else begin
    result := IndexByName(pointer(aName)); // faster O(log(n)) binary search
    if result>=0 then
      exit;
  end;
  raise EORMException.CreateUTF8(
    '%.IndexByNameUnflattenedOrExcept(%): unkwnown field in %',[self,aName,fTable]);
end;

procedure StatusCodeToErrorMsgBasic(Code: integer; var result: RawUTF8);
begin // only basic verbs here -> SynCrtSock.StatusCodeToReason() used instead
  case Code of
    HTTP_CONTINUE:          result := 'Continue';
    HTTP_SUCCESS:           result := 'OK';
    HTTP_CREATED:           result := 'Created';
    HTTP_NOCONTENT:         result := 'No Content';
    HTTP_MOVEDPERMANENTLY:  result := 'Moved Permanently';
    HTTP_NOTMODIFIED:       result := 'Not Modified';
    HTTP_BADREQUEST:        result := 'Bad Request';
    HTTP_UNAUTHORIZED:      result := 'Unauthorized';
    HTTP_FORBIDDEN:         result := 'Forbidden';
    HTTP_NOTFOUND:          result := 'Not Found';
    HTTP_NOTALLOWED:        result := 'Method Not Allowed';
    HTTP_NOTACCEPTABLE:     result := 'Not Acceptable';
    HTTP_TIMEOUT:           result := 'Request Timeout';
    HTTP_SERVERERROR:       result := 'Internal Server Error';
    HTTP_NOTIMPLEMENTED:    result := 'Not Implemented';
    HTTP_GATEWAYTIMEOUT:    result := 'Gateway Timeout';
    HTTP_UNAVAILABLE:       result := 'Service Unavailable';
    else if StatusCodeIsSuccess(Code) then
      result := 'Success' else
      result := 'Invalid Request';
  end;
end;

function StatusCodeToErrorMsg(Code: integer): shortstring;
var msg: RawUTF8;
begin
  StatusCodeToErrorMessage(Code,msg);
  FormatShort('HTTP Error % - %',[Code,msg],result);
end;

function StatusCodeIsSuccess(Code: integer): boolean;
begin
  result := (Code>=HTTP_SUCCESS) and (Code<HTTP_BADREQUEST); // 200..399
end;

function AuthURI(const URI, URIAuthenticationBearer: RawUTF8): RawUTF8;
begin
  if URIAuthenticationBearer='' then
    result := URI else
    if PosExChar('?',URI)=0 then
      result := URI+'?authenticationbearer='+URIAuthenticationBearer else
      result := URI+'&authenticationbearer='+URIAuthenticationBearer
end;

function ToMethod(const method: RawUTF8): TSQLURIMethod;
const NAME: array[mGET..high(TSQLURIMethod)] of string[10] = ( // sorted by occurence
  'GET','POST','PUT','DELETE','HEAD','BEGIN','END','ABORT','LOCK','UNLOCK','STATE',
  'OPTIONS','PROPFIND','PROPPATCH','TRACE','COPY','MKCOL','MOVE','PURGE','REPORT',
  'MKACTIVITY','MKCALENDAR','CHECKOUT','MERGE','NOTIFY','PATCH','SEARCH','CONNECT');
var L: PtrInt;
    N: PShortString;
begin
  L := Length(method);
  if L<11 then begin
    N := @NAME;
    for result := low(NAME) to high(NAME) do
      if (L=ord(N^[0])) and IdemPropNameUSameLen(@N^[1],pointer(method),L) then
        exit else
        inc(PByte(N),11);
  end;
  result := mNone;
end;

function IsInvalidHttpHeader(head: PUTF8Char; headlen: PtrInt): boolean;
var i: PtrInt;
begin
  result := true;
  for i := 0 to headlen-3 do
    if (PInteger(head+i)^=$0a0d0a0d) or
       (PWord(head+i)^=$0d0d) or (PWord(head+i)^=$0a0a) then
      exit;
  result := false;
end;


{ ******************* process monitoring / statistics }

{ TSynMonitorUsage }

function MonitorPropUsageValue(info: PPropInfo): TSynMonitorType;
var typ: pointer;
begin
  typ := info^.TypeInfo;
  if typ=TypeInfo(TSynMonitorTotalMicroSec) then
    result := smvMicroSec else
  if typ=TypeInfo(TSynMonitorOneMicroSec) then
    result := smvOneMicroSec else
  if typ=TypeInfo(TSynMonitorTotalBytes) then
    result := smvBytes else
  if typ=TypeInfo(TSynMonitorOneBytes) then
    result := smvOneBytes else
  if typ=TypeInfo(TSynMonitorBytesPerSec) then
    result := smvBytesPerSec else
  if typ=TypeInfo(TSynMonitorCount) then
    result := smvCount else
  if typ=TypeInfo(TSynMonitorCount64) then
    result := smvCount64 else
  if typ=TypeInfo(TSynMonitorOneCount) then
    result := smvOneCount else
    result := smvUndefined;
end;

function TSynMonitorUsage.Track(Instance: TObject; const Name: RawUTF8): integer;

  procedure ClassTrackProps(ClassType: TClass; var Props: TSynMonitorUsageTrackPropDynArray);
  var i,n: integer;
      nfo: PPropInfo;
      k: TSynMonitorType;
      g: TSynMonitorUsageGranularity;
      p: PSynMonitorUsageTrackProp;
      ctp: TClass;
  begin
    n := length(Props);
    while ClassType<>nil do begin
      ctp := GetClassParent(ClassType);
      for i := 1 to InternalClassPropInfo(ClassType,nfo) do begin
        k := MonitorPropUsageValue(nfo);
        if k<>smvUndefined then begin
          SetLength(Props,n+1);
          p := @Props[n];
          p^.Info := nfo;
          p^.Kind := k;
          ShortStringToAnsi7String(nfo^.Name,p^.Name);
          if (ctp<>nil) and (FindPropName(['Bytes','MicroSec'],p^.Name)>=0) then
            ToText(ctp,p^.Name); // meaningful property name = parent name
          for g := low(p^.Values) to high(p^.Values) do
            SetLength(p^.Values[g],USAGE_VALUE_LEN[g]);
          p^.ValueLast := nfo^.GetInt64Value(Instance);
          inc(n);
        end;
        nfo := nfo^.Next;
      end;
      ClassType := ctp;
    end;
  end;

var i,n: integer;
    instanceName: RawUTF8;
begin
  result := -1;
  if Instance=nil then
    exit; // nothing to track
  if (Name='') and Instance.InheritsFrom(TSynMonitor) then
    instanceName := TSynMonitor(Instance).Name else
    instanceName := Name;
  if instanceName='' then
    ToText(Instance.ClassType,instanceName);
  fSafe.Lock;
  try
    n := length(fTracked);
    for i := 0 to n-1 do
      if fTracked[i].Instance=Instance then
        exit else
      if IdemPropNameU(fTracked[i].Name,instanceName) then
        raise ESynException.CreateUTF8('%.Track("%") name already exists',[self,instanceName]);
    SetLength(fTracked,n+1);
    fTracked[n].Instance := Instance;
    fTracked[n].Name := instanceName;
    ClassTrackProps(PPointer(Instance)^,fTracked[n].Props);
    if fTracked[n].Props=nil then
      // nothing to track
      SetLength(fTracked,n) else begin
      result := n; // returns the index of the added item
      if fPrevious.Value<>0 then
        LoadTrack(fTracked[n]);
    end;
  finally
    fSafe.UnLock;
  end;
end;

procedure TSynMonitorUsage.Track(const Instances: array of TSynMonitor);
var i: integer;
begin
  if self<>nil then
    for i := 0 to high(Instances) do
      Track(Instances[i],Instances[i].Name);
end;

function TSynMonitorUsage.TrackPropLock(Instance: TObject;
  Info: PPropInfo): PSynMonitorUsageTrackProp;
var i,j: integer;
begin
  fSafe.Lock;
  for i := 0 to length(fTracked)-1 do
    if fTracked[i].Instance=Instance then
    with fTracked[i] do begin
      for j := 0 to length(Props)-1 do
        if Props[j].Info=Info then begin
          result := @Props[j];
          exit; // returned found entry locked
        end;
      break;
    end;
  fSafe.UnLock;
  result := nil;
end;

const
  // maps TTimeLogbits mask
  TL_MASK_SECONDS = pred(1 shl 6);
  TL_MASK_MINUTES = pred(1 shl 12);
  TL_MASK_HOURS = pred(1 shl 17);
  TL_MASK_DAYS = pred(1 shl 22);
  TL_MASK_MONTHS = pred(1 shl 26);
  // truncates a TTimeLogbits value to a granularity
  AS_MINUTES = not TL_MASK_SECONDS;
  AS_HOURS = not TL_MASK_MINUTES;
  AS_DAYS = not TL_MASK_HOURS;
  AS_MONTHS = not TL_MASK_DAYS;
  AS_YEARS = not TL_MASK_MONTHS;

function TSynMonitorUsage.Modified(Instance: TObject): integer;
begin
  if self<>nil then
    result := Modified(Instance,[]) else
    result := 0;
end;

procedure TSynMonitorUsage.SetCurrentUTCTime(out minutes: TTimeLogBits);
begin
  minutes.FromUTCTime;
end;

function TSynMonitorUsage.Modified(Instance: TObject;
  const PropNames: array of RawUTF8; ModificationTime: TTimeLog): integer;
  procedure save(const track: TSynMonitorUsageTrack);
    function scope({$ifndef CPU64}var{$endif} prev,current: Int64): TSynMonitorUsageGranularity;
    begin
      if prev and AS_YEARS<>current and AS_YEARS then
        result := mugYear else
      if prev and AS_MONTHS<>current and AS_MONTHS then
        result := mugMonth else
      if prev and AS_DAYS<>current and AS_DAYS then
        result := mugDay else
      if prev and AS_HOURS<>current and AS_HOURS then
        result := mugHour else
      if prev<>current then
        result := mugMinute else
        result := mugUndefined;
    end;
  var j,k,min: integer;
      time: TTimeLogBits;
      v,diff: Int64;
  begin
    if ModificationTime=0 then
      SetCurrentUTCTime(time) else
      time.Value := ModificationTime;
    time.Value := time.Value and AS_MINUTES; // save every minute
    if fPrevious.Value<>time.Value then begin
      if fPrevious.Value=0 then // startup?
        Load(time) else
        SavePrevious(scope(fPrevious.Value,time.Value));
      fPrevious.Value := time.Value;
    end;
    min := time.Minute;
    for j := 0 to length(track.Props)-1 do
      with track.Props[j] do
      if (high(PropNames)<0) or (FindPropName(PropNames,Name)>=0) then begin
        v := Info^.GetInt64Value(Instance);
        diff := v-ValueLast;
        if diff<>0 then begin
          inc(result);
          ValueLast := v;
          if Kind in SYNMONITORVALUE_CUMULATIVE then begin
            inc(Values[mugHour][min],diff);
            inc(Values[mugDay][time.Hour],diff); // propagate
            inc(Values[mugMonth][time.Day-1],diff);
            inc(Values[mugYear][time.Month-1],diff);
          end else
            for k := min to 59 do // make instant values continuous
              Values[mugHour][k] := v;
        end;
      end;
  end;
var i: integer;
begin
  result := 0;
  if Instance=nil then
    exit;
  fSafe.Lock;
  try
    for i := 0 to length(fTracked)-1 do
    if fTracked[i].Instance=Instance then begin
      save(fTracked[i]);
      exit;
    end;
    if Instance.InheritsFrom(TSynMonitor) and
       (TSynMonitor(Instance).Name<>'') then begin
      i := Track(Instance,TSynMonitor(Instance).Name);
      if i>=0 then
        save(fTracked[i]);
      exit;
    end;
  finally
    fSafe.UnLock;
  end;
end;

destructor TSynMonitorUsage.Destroy;
begin
  SavePrevious(mugUndefined); // save pending values for all granularities
  inherited Destroy;
end;

procedure TSynMonitorUsage.SavePrevious(Scope: TSynMonitorUsageGranularity);
var g: TSynMonitorUsageGranularity;
    id: TSynMonitorUsageID;
begin
  id.FromTimeLog(fPrevious.Value);
  Save(id,mugHour,Scope); // always save current minutes values
  for g := mugDay to mugYear do
    if (Scope<>mugUndefined) and (g>Scope) then
      break else // mugUndefined from Destroy
      Save(id,g,Scope);
end;

procedure TSynMonitorUsage.Save(ID: TSynMonitorUsageID;
  Gran,Scope: TSynMonitorUsageGranularity);
var t,n,p: Integer;
    track: PSynMonitorUsageTrack;
    data,val: TDocVariantData;
begin
  if Gran<low(fValues) then
    raise ESynException.CreateUTF8('%.Save(%) unexpected',[self,ToText(Gran)^]);
  TDocVariant.IsOfTypeOrNewFast(fValues[Gran]);
  for t := 0 to length(fTracked)-1 do begin
    track := @fTracked[t];
    n := length(track^.Props);
    data.InitFast(n,dvObject);
    for p := 0 to n-1 do
    with track^.Props[p] do
      if not IsZero(Values[Gran]) then begin
        // save non void values
        val.InitArrayFrom(Values[Gran],JSON_OPTIONS_FAST);
        data.AddValue(Name,Variant(val));
        val.Clear;
        // handle local cache
        if Kind in SYNMONITORVALUE_CUMULATIVE then begin
          if Gran<=Scope then // reset of cumulative values
            FillZero(Values[Gran]);
        end else begin
          if Gran<mugYear then // propagate instant values
            // e.g. Values[mugDay][hour] := Values[mugHour][minute] (=v)
            Values[succ(Gran)][ID.GetTime(Gran,true)] :=
              Values[Gran][ID.GetTime(pred(Gran),true)];
        end;
      end;
    _Safe(fValues[Gran]).AddOrUpdateValue(track^.Name,variant(data));
    data.Clear;
  end;
  _Safe(fValues[Gran]).SortByName;
  ID.Truncate(Gran);
  if not SaveDB(ID.Value,fValues[Gran],Gran) then
    fLog.SynLog.Log(sllWarning,'%.Save(ID=%=%,%) failed',
      [ClassType,ID.Value,ID.Text(true),ToText(Gran)^]);
end;

procedure TSynMonitorUsage.LoadTrack(var Track: TSynMonitorUsageTrack);
var p,v: Integer;
    g: TSynMonitorUsageGranularity;
    val,int: PDocVariantData;
begin // fValues[] variants -> fTracked[].Props[].Values[]
  for g := low(fValues) to high(fValues) do
    with _Safe(fValues[g])^ do begin
      val := GetAsDocVariantSafe(Track.Name);
      if val<>nil then
      for p := 0 to length(Track.Props)-1 do
        with Track.Props[p] do
        if val^.GetAsDocVariant(Name,int) and
           (int^.Count>0) and (dvoIsArray in int^.Options) then begin
          for v := 0 to length(Values[g])-1 do
            if v<int^.Count then
              Values[g][v] := VariantToInt64Def(int^.Values[v],0);
        end;
    end;
end;

function TSynMonitorUsage.Load(const Time: TTimeLogBits): boolean;
var g: TSynMonitorUsageGranularity;
    id: TSynMonitorUsageID;
    t: integer;
begin
  // load fValues[] variants
  result := true;
  id.FromTimeLog(Time.Value);
  for g := low(fValues) to high(fValues) do begin
    id.Truncate(g);
    if not LoadDB(id.Value,g,fValues[g]) then
      result := false;
  end;
  // fill fTracked[].Props[].Values[]
  for t := 0 to length(fTracked)-1 do
    LoadTrack(fTracked[t]);
end;


{ TSynMonitorUsageID }

procedure TSynMonitorUsageID.From(Y, M, D, H: integer);
begin
  Value := H+(D-1) shl USAGE_ID_SHIFT[mugDay]+
    (M-1) shl USAGE_ID_SHIFT[mugMonth]+(Y-USAGE_ID_YEAROFFSET)shl USAGE_ID_SHIFT[mugYear];
end;

procedure TSynMonitorUsageID.From(Y, M, D: integer);
begin
  Value := USAGE_ID_HOURMARKER[mugDay]+(D-1) shl USAGE_ID_SHIFT[mugDay]+
    (M-1) shl USAGE_ID_SHIFT[mugMonth]+(Y-USAGE_ID_YEAROFFSET)shl USAGE_ID_SHIFT[mugYear];
end;

procedure TSynMonitorUsageID.From(Y, M: integer);
begin
  Value := USAGE_ID_HOURMARKER[mugMonth]+(M-1) shl USAGE_ID_SHIFT[mugMonth]+
    (Y-USAGE_ID_YEAROFFSET)shl USAGE_ID_SHIFT[mugYear];
end;

procedure TSynMonitorUsageID.From(Y: integer);
begin
  Value := USAGE_ID_HOURMARKER[mugYear]+(Y-USAGE_ID_YEAROFFSET)shl USAGE_ID_SHIFT[mugYear];
end;

procedure TSynMonitorUsageID.FromTimeLog(const TimeLog: TTimeLog);
var bits: TTimeLogBits absolute TimeLog;
begin
  Value := bits.Hour+(bits.Day-1) shl USAGE_ID_SHIFT[mugDay]+
    (bits.Month-1) shl USAGE_ID_SHIFT[mugMonth]+
    (bits.Year-USAGE_ID_YEAROFFSET)shl USAGE_ID_SHIFT[mugYear];
end;

procedure TSynMonitorUsageID.FromNowUTC;
var now: TTimeLogBits;
begin
  now.FromUTCTime;
  From(now.Value);
end;

function TSynMonitorUsageID.GetTime(gran: TSynMonitorUsageGranularity;
  monthdaystartat0: boolean): integer;
begin
  if not (gran in [low(USAGE_ID_SHIFT)..high(USAGE_ID_SHIFT)]) then
    result := 0 else begin
    result := (Value shr USAGE_ID_SHIFT[gran]) and USAGE_ID_MASK[gran];
    case gran of
    mugYear:
      inc(result,USAGE_ID_YEAROFFSET);
    mugDay, mugMonth:
      if not monthdaystartat0 then
        inc(result);
    mugHour:
      if cardinal(result)>USAGE_ID_MAX[mugHour] then
        result := 0; // stored fake USAGE_ID_HOURMARKER[mugDay..mugYear] value
    end;
  end;
end;

function TSynMonitorUsageID.Granularity: TSynMonitorUsageGranularity;
var h: integer;
begin
  h := Value and USAGE_ID_MASK[mugHour];
  if cardinal(h)>USAGE_ID_MAX[mugHour] then begin
    for result := mugDay to mugYear do
      if USAGE_ID_HOURMARKER[result]=h then
        exit;
    result := mugUndefined; // should not happen
  end else
    result := mugHour;
end;

procedure TSynMonitorUsageID.Truncate(gran: TSynMonitorUsageGranularity);
begin
  if gran>mugHour then
    Value := (Value and not USAGE_ID_MASK[mugHour]) or USAGE_ID_HOURMARKER[gran];
end;

procedure TSynMonitorUsageID.SetTime(gran: TSynMonitorUsageGranularity; aValue: integer);
begin
  case gran of
  mugYear: dec(aValue,USAGE_ID_YEAROFFSET);
  mugDay, mugMonth: dec(aValue);
  mugHour: ;
  else raise ERangeError.CreateFmt('SetValue(%s)',[ToText(gran)^]);
  end;
  if cardinal(aValue)>USAGE_ID_MAX[gran] then
    raise ERangeError.CreateFmt('%s should be 0..%d',[ToText(gran)^,USAGE_ID_MAX[gran]]);
  Value := (Value and not (USAGE_ID_MASK[gran] shl USAGE_ID_SHIFT[gran]))
     or (aValue shl USAGE_ID_SHIFT[gran]);
end;

function TSynMonitorUsageID.Text(Expanded: boolean;
  FirstTimeChar: AnsiChar): RawUTF8;
var bits: TTimeLogBits;
begin
  bits.Value := ToTimeLog;
  result := bits.Text(Expanded,FirstTimeChar);
end;

function TSynMonitorUsageID.ToTimeLog: TTimeLog;
begin
  PTimeLogBits(@result)^.From(
    GetTime(mugYear),GetTime(mugMonth),GetTime(mugDay),GetTime(mugHour),0,0);
end;



{ ************ main ORM / SOA classes and types }

{ TSQLTable }

function TSQLTable.FieldIndex(FieldName: PUTF8Char): integer;
begin
  if (self<>nil) and (fResults<>nil) and (FieldName<>nil) and (FieldCount>0) then
    if IsRowID(FieldName) then begin // will work for both 'ID' or 'RowID'
      result := fFieldIndexID;
      exit;
    end else
    if FieldCount<4 then begin
      for result := 0 to FieldCount-1 do
        if StrIComp(fResults[result],FieldName)=0 then
          exit;
    end else begin
      if fFieldNameOrder=nil then
        QuickSortIndexedPUTF8Char(fResults,FieldCount,fFieldNameOrder);
      result := FastFindIndexedPUTF8Char(fResults,FieldCount-1,fFieldNameOrder,
        FieldName,@StrIComp);
      exit;
    end;
  result := -1;
end;

function TSQLTable.FieldIndex(const FieldName: RawUTF8): integer;
begin
  result := FieldIndex(Pointer(FieldName));
end;

function TSQLTable.FieldIndexExisting(const FieldName: RawUTF8): integer;
begin
  result := FieldIndex(Pointer(FieldName));
  if result<0 then
    raise ESQLTableException.CreateUTF8('%.FieldIndexExisting("%")',[self,FieldName]);
end;

function TSQLTable.FieldIndex(const FieldNames: array of RawUTF8;
  const FieldIndexes: array of PInteger): integer;
var i: PtrInt;
begin
  result := 0;
  if high(FieldNames)<0 then
    exit;
  if high(FieldNames)<>high(FieldIndexes) then
    raise ESQLTableException.CreateUTF8('%.FieldIndex() argument count',[self]);
  for i := 0 to high(FieldNames) do
    if FieldIndexes[i]=nil then
      raise ESQLTableException.CreateUTF8(
        '%.FieldIndex() FieldIndexes["%"]=nil',[self,FieldNames[i]]) else begin
      FieldIndexes[i]^ := FieldIndex(pointer(FieldNames[i]));
      if FieldIndexes[i]^>=0 then
        inc(result);
    end;
end;

procedure TSQLTable.FieldIndexExisting(const FieldNames: array of RawUTF8;
  const FieldIndexes: array of PInteger);
var i: PtrInt;
begin
  if high(FieldNames)<0 then
    exit;
  if high(FieldNames)<>high(FieldIndexes) then
    raise ESQLTableException.CreateUTF8('%.FieldIndexExisting() argument count',[self]);
  for i := 0 to high(FieldNames) do
    if FieldIndexes[i]=nil then
      raise ESQLTableException.CreateUTF8(
        '%.FieldIndexExisting() FieldIndexes["%"]=nil',[self,FieldNames[i]]) else
      FieldIndexes[i]^ := FieldIndexExisting(FieldNames[i]);
end;

function TSQLTable.FieldNames: TRawUTF8DynArray;
begin
  if length(fFieldNames)<>fFieldCount then
    InitFieldNames;
  result := fFieldNames;
end;

function TSQLTable.FieldValue(const FieldName: RawUTF8; Row: integer): PUTF8Char;
var Index: integer;
begin
  Index := FieldIndex(pointer(FieldName));
  if (Index<0) or (cardinal(Row-1)>=cardinal(fRowCount)) then
    result := nil else
    result := fResults[Index+Row*FieldCount];
end;

procedure TSQLTable.SortBitsFirst(var Bits);
var oldIDColumn, oldResults: TPUTF8CharDynArray;
    i, j, nSet, n: integer;
    R: PPUTF8Char;
begin
  if fIDColumn<>nil then begin
    n := length(fIDColumn);
    SetLength(oldIDColumn,n);
    MoveFast(fIDColumn[0],oldIDColumn[0],n*SizeOf(PUTF8Char));
  end;
  i := (fRowCount+1)*FieldCount;
  SetLength(oldResults,i);
  MoveFast(fResults[0],oldResults[0],i*SizeOf(PUTF8Char));
  // put marked IDs first
  n := 1; // copy row data (first row=0 i.e. idents is left as it is)
  R := @fResults[FieldCount];
  j := FieldCount;
  for i := 1 to fRowCount do begin
    if GetBitPtr(@Bits,i-1) then begin
      if fIDColumn<>nil then
        fIDColumn[n] := oldIDColumn[i];
      MoveFast(oldResults[j],R^,FieldCount*SizeOf(PUTF8Char));
      inc(n);
      inc(R,FieldCount);
    end;
    inc(j,FieldCount);
  end;
  nSet := n-1;
  // put unmarked IDs
  j := FieldCount;
  for i := 1 to fRowCount do begin
    if not GetBitPtr(@Bits,i-1) then begin
      if fIDColumn<>nil then
        fIDColumn[n] := oldIDColumn[i];
      MoveFast(oldResults[j],R^,FieldCount*SizeOf(PUTF8Char));
      inc(n);
      inc(R,FieldCount);
    end;
    inc(j,FieldCount);
  end;
  assert(n-1=fRowCount);
  // recalcultate Bits[]
  FillCharFast(Bits,(fRowCount shr 3)+1,0);
  for i := 0 to nSet-1 do
    SetBitPtr(@Bits,i); // slow but accurate
end;

function TSQLTable.IDColumnHide: boolean;
var FID,R,F: integer;
    S,D1,D2: PPUTF8Char;
begin
  // 1. check if possible
  result := false;
  if (self=nil) or Assigned(fIDColumn) or (FieldCount<=1) then
    exit; // already hidden or not possible
  FID := fFieldIndexID;
  if FID<0 then
    exit; // no 'ID' field
  // 2. alloc new arrays of PUTF8Char
  dec(fFieldCount);
  R := fRowCount+1;
  SetLength(fIDColumn,R);               // will contain the ID column data
  SetLength(fNotIDColumn,R*FieldCount); // will be the new fResults[]
  // 3. copy fResults[] into new arrays
  S := @fResults[0];
  D1 := @fNotIDColumn[0];
  D2 := @fIDColumn[0];
  for R := 0 to fRowCount do
    for F := 0 to FieldCount do begin // we have FieldCount := FieldCount-1
      if F<>FID then begin
        D1^ := S^; // copy not ID column into fNotIDColumn[]
        inc(D1);
      end else begin
        D2^ := S^; // copy ID column into fIDColumn[]
        inc(D2);
      end;
      inc(S);
    end;
  // 4. TSQLTable data now points to new values without ID field
  result := true;
  fResults := @fNotIDColumn[0];
end;

function TSQLTable.IDColumnHiddenValue(Row: integer): TID;
begin
  if (self=nil) or (fResults=nil) or (Row<=0) or (Row>fRowCount) then
    result := 0 else
    if Assigned(fIDColumn) then // get hidden ID column UTF-8 content
      SetID(fIDColumn[Row],result) else
      if fFieldIndexID>=0 then // get ID column field index
        SetID(fResults[Row*FieldCount+fFieldIndexID],result) else
        result := 0;
end;

procedure TSQLTable.IDArrayFromBits(const Bits; var IDs: TIDDynArray);
var n, i, FID: integer;
begin
  if not Assigned(fIDColumn) then begin
    FID := fFieldIndexID; // get ID column field index
    if FID<0 then
      exit;
  end else
    FID := 0; // make compiler happy
  n := GetBitsCount(Bits,fRowCount);
  if n=fRowCount then begin
    IDColumnHiddenValues(IDs); // all selected -> direct get all IDs
    exit;
  end;
  SetLength(IDs,n);
  if n=0 then
    exit;
  n := 0;
  if Assigned(fIDColumn) then begin
    for i := 1 to fRowCount do
    if GetBitPtr(@Bits,i-1) then begin
      IDs[n] := GetInt64(fIDColumn[i]); // get hidden ID column UTF-8 content
      inc(n);
    end;
  end else begin
    inc(FID,FieldCount); // [i*FieldCount+FID] = [(i+1)*FieldCount+FID] below
    for i := 0 to fRowCount-1 do
    if GetBitPtr(@Bits,i) then begin
      IDs[n] := GetInt64(fResults[i*FieldCount+FID]); // get ID column UTF-8 content
      inc(n);
    end;
  end;
end;

procedure TSQLTable.IDColumnHiddenValues(var IDs: TIDDynArray);
var n, i, FID: integer;
    U: PPUTF8Char;
begin
  n := fRowCount;
  if not Assigned(fIDColumn) then begin
    FID := fFieldIndexID; // get ID column field index
    if FID<0 then
      n := 0;
  end else
    FID := 0;
  SetLength(IDs,n);
  if n=0 then
    exit;
  if Assigned(fIDColumn) then begin
    for i := 1 to fRowCount do
      IDs[i-1] := GetInt64(fIDColumn[i]); // get hidden ID column UTF-8 content
  end else begin
    U := @fResults[FID+FieldCount];  // U^ = ID column UTF-8 content
    for i := 0 to fRowCount-1 do begin
      IDs[i] := GetInt64(U^);
      inc(U,FieldCount);
    end;
  end;
end;

procedure TSQLTable.IDArrayToBits(var Bits; var IDs: TIDDynArray);
var i,FID: integer;
    U: PPUTF8Char;
    ID: Pointer;
    IDmax: integer;
//    AllID: : TIDDynArray;
begin
  if length(IDs)=fRowCount then begin // all selected -> all bits set to 1
    FillCharFast(Bits,(fRowCount shr 3)+1,255);
    exit;
  end;
  FillCharFast(Bits,(fRowCount shr 3)+1,0);
  if IDs=nil then
    exit; // no selected -> all bits left to 0
  // we sort IDs to use FastFindInt64Sorted() and its O(log(n)) binary search
  ID := @IDs[0];
  IDmax := length(IDs)-1;
  QuickSortInt64(ID,0,IDmax);
  if not Assigned(fIDColumn) then begin
    FID := fFieldIndexID; // get ID column field index
    if FID<0 then
      exit; // no ID column -> unable to get bit index
  end else
    FID := 0; // make compiler happy
  if Assigned(fIDColumn) then begin
    for i := 1 to fRowCount do
      if FastFindInt64Sorted(ID,IDmax,GetInt64(fIDColumn[i]))>=0 then
        SetBitPtr(@Bits,i-1);
  end else begin
    U := @fResults[FID+FieldCount];  // U^ = ID column UTF-8 content
    for i := 0 to fRowCount-1 do begin
      if FastFindInt64Sorted(ID,IDmax,GetInt64(U^))>=0 then
        SetBitPtr(@Bits,i);
      inc(U,FieldCount);
    end;
  end;
{  // debugg:
  IDArrayFromBits(Bits,AllID);
  assert(length(AllID)=length(IDs));
  QuickSortInteger(@AllID[0],0,high(AllID));
  QuickSortInteger(@IDs[0],0,high(IDs));
  assert(comparemem(@AllID[0],@IDs[0],length(AllID)*SizeOf(TID))); }
end;

function TSQLTable.RowFromID(aID: TID; aNotFoundMinusOne: boolean): integer;
var ID: RawUTF8;
    FID: integer;
    U: PPUTF8Char;
begin
  if self=nil then begin
    result := -1;
    exit;
  end;
  if (fResults<>nil) and (aID>0) then begin
    // search aID as UTF-8 in fIDColumn[] or fResults[]
    Int64ToUtf8(aID,ID);
    if Assigned(fIDColumn) then begin // get hidden ID column UTF-8 content
      for result := 1 to fRowCount do
        if StrComp(fIDColumn[result],pointer(ID))=0 then
          exit;
    end else begin
      FID := fFieldIndexID;  // get ID column field index
      if FID>=0 then begin
        U := @fResults[FID+FieldCount];  // U^ = ID column UTF-8 content
        for result := 1 to fRowCount do
          if StrComp(U^,pointer(ID))=0 then
            exit else
            inc(U,FieldCount);
      end;
    end;
  end;
  if aNotFoundMinusOne then
    result := -1 else
    result := fRowCount; // not found -> return last row index
end;

function TSQLTable.DeleteRow(Row: integer): boolean;
begin
  if (self=nil) or (Row<1) or (Row>fRowCount) then begin
    result := false;
    exit; // out of range
  end;
  if Assigned(fIDColumn) then
    if Row<fRowCount then
      MoveFast(fIDColumn[Row+1],fIDColumn[Row],(fRowCount-Row)*SizeOf(PUTF8Char));
  if Row<fRowCount then begin
    Row := Row*FieldCount; // convert row index into position in fResults[]
    MoveFast(fResults[Row+FieldCount],fResults[Row],(fRowCount*FieldCount-Row)*SizeOf(pointer));
  end;
  dec(fRowCount);
  result := true;
end;

procedure TSQLTable.InitFieldNames;
var f: integer;
    P: PUTF8Char;
begin
  SetLength(fFieldNames,fFieldCount); // share one TRawUTF8DynArray
  for f := 0 to fFieldCount-1 do begin
    P := Get(0,f);
    if IsRowID(P) then // normalize RowID field name to 'ID'
      fFieldNames[f] := 'ID' else
      FastSetString(fFieldNames[f],P,StrLen(P));
  end;
end;

{$ifndef NOVARIANTS}
var
  SQLTableRowVariantType: TCustomVariantType = nil;

procedure TSQLTable.GetAsVariant(row,field: integer; out value: variant;
  expandTimeLogAsText,expandEnumsAsText,expandHugeIDAsUniqueIdentifier: boolean;
  options: TDocVariantOptions);
const JAN2015_UNIX = 1420070400;
var t: TTimeLogBits;
    id: TSynUniqueIdentifierBits;
    V: PUtf8Char;
    enum,err: integer;
begin
  if (self=nil) or (row<1) or (row>fRowCount) or
     (cardinal(field)>=cardinal(fFieldCount)) then
    exit; // out of range
  if fFieldType=nil then
    InitFieldTypes;
  V := fResults[row*fFieldCount+field];
  with fFieldType[field] do
    if expandHugeIDAsUniqueIdentifier and (field=fFieldIndexID) then begin
      SetInt64(V,PInt64(@id)^);
      if id.CreateTimeUnix>JAN2015_UNIX then
        id.ToVariant(value) else
        value := id.Value;
    end else begin
    if expandEnumsAsText and (ContentType=sftEnumerate) then begin
      enum := GetInteger(V,err);
      if (err=0) and (ContentTypeInfo<>nil) then begin
        value := PEnumType(ContentTypeInfo)^.GetEnumNameOrd(enum)^;
        exit;
      end;
    end else
    if expandTimeLogAsText then
    case ContentType of
    sftTimeLog,sftModTime,sftCreateTime,sftUnixTime: begin
      SetInt64(V,t.Value);
      if t.Value=0 then
        value := 0 else begin
        if ContentType=sftUnixTime then
          t.FromUnixTime(t.Value);
        TDocVariantData(value).InitObject(['Time',t.Text(true),'Value',t.Value],JSON_OPTIONS_FAST);
      end;
      exit;
    end;
    sftUnixMSTime: begin // no TTimeLog use for milliseconds resolution
      SetInt64(V,t.Value);
      if t.Value=0 then
        value := 0 else
        TDocVariantData(value).InitObject(['Time',UnixMSTimeToString(t.Value),'Value',t.Value],JSON_OPTIONS_FAST);
      exit;
    end;
    end;
    ValueVarToVariant(V,StrLen(V),ContentType,TVarData(value),true,ContentTypeInfo,options);
  end;
end;

procedure TSQLTable.ToDocVariant(Row: integer; out doc: variant;
  options: TDocVariantOptions; expandTimeLogAsText,expandEnumsAsText,
  expandHugeIDAsUniqueIdentifier: boolean);
var f: integer;
    v: TVariantDynArray;
begin
  if (self=nil) or (Row<1) or (Row>fRowCount) then
    exit; // out of range
  SetLength(v,fFieldCount);
  for f := 0 to fFieldCount-1 do
    GetAsVariant(Row,f,v[f],expandTimeLogAsText,expandEnumsAsText,
      expandHugeIDAsUniqueIdentifier,options);
  if length(fFieldNames)<>fFieldCount then
    InitFieldNames;
  TDocVariantData(doc).InitObjectFromVariants(fFieldNames,v,JSON_OPTIONS_FAST);
end;

procedure TSQLTable.ToDocVariant(out docs: TVariantDynArray; readonly: boolean);
var r: integer;
begin
  if (self=nil) or (fRowCount=0) then
    exit;
  SetLength(docs,fRowCount);
  if readonly then begin
    if SQLTableRowVariantType=nil then
      SQLTableRowVariantType := SynRegisterCustomVariantType(TSQLTableRowVariant);
    for r := 0 to fRowCount-1 do
    with TSQLTableRowVariantData(docs[r]) do begin
      VType := SQLTableRowVariantType.VarType;
      VTable := self;
      VRow := r+1;
    end;
  end else
    for r := 0 to fRowCount-1 do
      ToDocVariant(r+1,docs[r]);
end;

procedure TSQLTable.ToDocVariant(out docarray: variant; readonly: boolean);
var Values: TVariantDynArray;
begin
  ToDocVariant(Values,readonly);
  TDocVariantData(docarray).InitArrayFromVariants(Values,JSON_OPTIONS_FAST);
end;

{$endif NOVARIANTS}

function TSQLTable.DeleteColumnValues(Field: integer): boolean;
var i: integer;
    U: PPUTF8Char;
begin
  if cardinal(Field)>=cardinal(FieldCount) then begin
    result := false;
    exit; // out of range
  end;
  U := @fResults[Field+FieldCount];  // U^ = column UTF-8 content for this field
  for i := 1 to fRowCount do begin
    U^ := nil; // just void UTF-8 content text
    inc(U,FieldCount);
  end;
  result := true;
end;

function TSQLTable.GetQueryTableNameFromSQL: RawUTF8;
begin
  if (fQueryTableNameFromSQL='') and (fQuerySQL<>'') then
    fQueryTableNameFromSQL := GetTableNameFromSQLSelect(fQuerySQL,true);
  result := fQueryTableNameFromSQL;
end;

function TSQLTable.FieldPropFromTables(const PropName: RawUTF8;
  out PropInfo: TSQLPropInfo; out TableIndex: integer): TSQLFieldType;
  procedure SearchInQueryTables(aPropName: PUTF8Char; aTableIndex: integer);
  begin
    if IsRowID(aPropName) then begin
      result := sftInteger;
      PropInfo := nil;
      TableIndex := aTableIndex;
      exit;
    end else
    if fQueryTables[aTableIndex]<>nil then begin
      PropInfo := fQueryTables[aTableIndex].RecordProps.Fields.ByName(aPropName);
      if PropInfo<>nil then begin
        result := PropInfo.SQLFieldTypeStored;
        if result<>sftUnknown then
          TableIndex := aTableIndex;
        exit;
      end;
      result := sftUnknown;
    end;
  end;
var i,t: integer;
begin
  TableIndex := -1;
  result := sftUnknown;
  if fQueryTableIndexFromSQL=-2 then begin
    fQueryTableIndexFromSQL := -1;
    if (fQueryTables<>nil) and (QueryTableNameFromSQL<>'') then
      for i := 0 to length(fQueryTables)-1 do
        if IdemPropNameU(fQueryTables[i].SQLTableName,fQueryTableNameFromSQL) then begin
          fQueryTableIndexFromSQL := i;
          break;
        end;
  end;
  if fQueryTableIndexFromSQL>=0 then begin
    SearchInQueryTables(pointer(PropName),fQueryTableIndexFromSQL);
    if result<>sftUnknown then
      exit;
  end;
  if length(fQueryTables)=1 then
    SearchInQueryTables(pointer(PropName),0)
  else begin
    i := PosExChar('.',PropName)-1;
    if i<0 then // no 'ClassName.PropertyName' format: find first exact property name
      for t := 0 to high(fQueryTables) do begin
        SearchInQueryTables(pointer(PropName),t);
        if result<>sftUnknown then
          exit;
      end
    else // handle property names as 'ClassName.PropertyName'
      for t := 0 to high(fQueryTables) do
        if fQueryTables[t]<>nil then // avoid GPF
        if IdemPropNameU(fQueryTables[t].RecordProps.SQLTableName,pointer(PropName),i) then begin
          SearchInQueryTables(@PropName[i+2],t);
          exit;
        end;
  end;
end;

procedure TSQLTable.SetFieldType(Field: integer; FieldType: TSQLFieldType;
   FieldTypeInfo: pointer; FieldSize,FieldTableIndex: integer);
begin
  if (self=nil) or (cardinal(Field)>=cardinal(FieldCount)) then
    exit;
  if fFieldType=nil then
    InitFieldTypes else
    if Field>=length(fFieldType) then
      SetLength(fFieldType,Field+1); // e.g. from TSQLTableWritable.AddField
  with fFieldType[Field] do begin
    ContentType := FieldType;
    ContentSize := FieldSize;
    ContentTypeInfo := nil;
    if FieldTypeInfo<>nil then
      case FieldType of
      sftEnumerate:
        if (PTypeInfo(FieldTypeInfo)^.Kind=tkEnumeration) then
          ContentTypeInfo := PTypeInfo(FieldTypeInfo)^.EnumBaseType;
      sftSet:
        if (PTypeInfo(FieldTypeInfo)^.Kind=tkSet) then
          ContentTypeInfo := PTypeInfo(FieldTypeInfo)^.SetEnumType;
      sftBlobDynArray:
        ContentTypeInfo := FieldTypeInfo;
      {$ifndef NOVARIANTS}
      sftNullable: begin
        ContentTypeInfo := FieldTypeInfo;
        ContentType := NullableTypeToSQLFieldType(FieldTypeInfo);
        if ContentType=sftUnknown then
          ContentType := sftNullable;
      end;
      {$endif NOVARIANTS}
      end;
    {$ifndef NOVARIANTS}
    if ContentType in [sftVariant,sftNullable] then
      ContentDB := ftUnknown else // ftUTF8/ftNull are not precise enough
    {$endif NOVARIANTS}
      ContentDB := SQLFIELDTYPETODBFIELDTYPE[ContentType];
    TableIndex := FieldTableIndex;
  end;
end;

procedure TSQLTable.SetFieldType(const FieldName: RawUTF8; FieldType: TSQLFieldType;
   FieldTypeInfo: pointer; FieldSize: integer);
begin
  SetFieldType(FieldIndex(FieldName),FieldType,FieldTypeInfo,FieldSize);
end;

const
  DBTOFIELDTYPE: array[TSQLDBFieldType] of TSQLFieldType  = (sftUnknown,
    sftUnknown,sftInteger,sftFloat,sftCurrency,sftDateTime,sftUTF8Text,sftBlob);

procedure TSQLTable.SetFieldTypes(const DBTypes: TSQLDBFieldTypeDynArray);
var f: integer;
begin
  if length(DBTypes)<>FieldCount then
    raise ESQLTableException.CreateUTF8('%.SetFieldTypes(DBTypes?)',[self]);
  for f := 0 to FieldCount-1 do
    SetFieldType(f,DBTOFIELDTYPE[DBTypes[f]]);
end;

function TSQLTable.GetRowCount: integer;
begin
  if self=nil then
    result := 0 else
    result := fRowCount;
end;

procedure TSQLTable.InitFieldTypes;
var f,i,len: integer;
    sft: TSQLFieldType;
    info: pointer;
    prop: TSQLPropInfo;
    size,tableindex: integer;
    U: PPUTF8Char;
    guessed: boolean;
    tlog: TTimeLog;
begin
  if Assigned(fQueryColumnTypes) and (FieldCount<>length(fQueryColumnTypes)) then
    raise ESQLTableException.CreateUTF8('%.CreateWithColumnTypes() called with % '+
      'column types, whereas the result has % columns',
      [self,length(fQueryColumnTypes),FieldCount]);
  SetLength(fFieldType,FieldCount);
  for f := 0 to FieldCount-1 do begin
    prop := nil;
    info := nil;
    size := -1;
    tableindex := -1;
    guessed := false;
    // init fFieldType[] from fQueryTables/fQueryColumnTypes[]
    if Assigned(fQueryColumnTypes) then
      sft := fQueryColumnTypes[f] else
    if Assigned(QueryTables) then begin // retrieve column info from field name
      sft := FieldPropFromTables(fResults[f],prop,tableindex);
      if prop<>nil then begin
        if prop.InheritsFrom(TSQLPropInfoRTTI) then
          info := TSQLPropInfoRTTI(prop).PropType;
        size := prop.FieldWidth;
      end;
    end else
      sft := sftUnknown;
    if sft=sftUnknown then
      // not found in fQueryTables/fQueryColumnTypes[]: guess from content
      if IsRowID(fResults[f]) then
        sft := sftInteger else begin
        guessed := true;
        if f in fFieldParsedAsString then  begin
          // the parser identified string values -> check if was sftDateTime
          sft := sftUTF8Text;
          U := @fResults[FieldCount+f];
          for i := 1 to fRowCount do
            if U^=nil then  // search for a non void column
              inc(U,FieldCount) else begin
              len := StrLen(U^);
              tlog := Iso8601ToTimeLogPUTF8Char(U^,len);
              if tlog<>0 then
                if (len in [8,10]) and (cardinal(tlog shr 26)-1800<300) then
                  sft := sftDateTime else // e.g. YYYYMMDD date (Y=1800..2100)
                if len>=15 then
                  sft := sftDateTime; // e.g. YYYYMMDDThhmmss date/time value
              break;
            end;
        end else begin
          U := @fResults[FieldCount+f];
          for i := 1 to fRowCount do begin
            sft := UTF8ContentNumberType(U^);
            inc(U,FieldCount);
            if sft=sftUnknown then
              continue else // null -> search for a non void column
            if sft=sftInteger then // may be a floating point with no decimal
              if FieldTypeIntegerDetectionOnAllRows then
                continue else
                // we only checked the first field -> best guess...
                sft := sftCurrency;
            break; // found a non-integer content (e.g. sftFloat/sftUtf8Text)
          end;
        end;
      end;
    SetFieldType(f,sft,info,size,tableindex);
    if guessed then
      fFieldType[f].ContentDB := ftUnknown; // may fail on some later row
  end;
end;

function TSQLTable.FieldType(Field: integer): TSQLFieldType;
begin
  if (self<>nil) and (cardinal(Field)<cardinal(FieldCount)) then begin
    if fFieldType=nil then
      InitFieldTypes;
    result := fFieldType[Field].ContentType;
  end else
    result := sftUnknown;
end;

function TSQLTable.FieldType(Field: integer; out FieldTypeInfo: PSQLTableFieldType): TSQLFieldType;
begin
  if (self<>nil) and (cardinal(Field)<cardinal(FieldCount)) then begin
    if fFieldType=nil then
      InitFieldTypes;
    FieldTypeInfo := @fFieldType[Field];
    result := FieldTypeInfo^.ContentType;
  end else begin
    FieldTypeInfo := nil;
    result := sftUnknown;
  end;
end;

function TSQLTable.Get(Row, Field: integer): PUTF8Char;
begin
  if (self=nil) or (fResults=nil) or (cardinal(Row)>cardinal(fRowCount)) or
     (cardinal(Field)>=cardinal(FieldCount)) then // cardinal() -> test <0
    result := nil else
    result := fResults[Row*FieldCount+Field];
end;

function TSQLTable.GetU(Row,Field: integer): RawUTF8;
var P: PUTF8Char;
begin
  if (self=nil) or (fResults=nil) or (cardinal(Row)>cardinal(fRowCount)) or
     (cardinal(Field)>=cardinal(FieldCount)) then // cardinal() -> test <0
    result := '' else begin
    P := fResults[Row*FieldCount+Field];
    FastSetString(Result,P,StrLen(P));
  end;
end;

function TSQLTable.Get(Row: integer; const FieldName: RawUTF8): PUTF8Char;
begin
  result := Get(Row,FieldIndex(FieldName));
end;

function TSQLTable.GetU(Row: integer; const FieldName: RawUTF8): RawUTF8;
begin
  result := GetU(Row,FieldIndex(FieldName));
end;

function TSQLTable.GetA(Row, Field: integer): WinAnsiString;
begin
  result := Utf8ToWinAnsi(Get(Row,Field));
end;

function TSQLTable.GetAsInteger(Row, Field: integer): integer;
begin
  result := GetInteger(Get(Row,Field));
end;

function TSQLTable.GetAsInteger(Row: integer; const FieldName: RawUTF8): integer;
begin
  result := GetInteger(Get(Row,FieldIndex(FieldName)));
end;

function TSQLTable.GetAsInt64(Row, Field: integer): Int64;
begin
  SetInt64(Get(Row,Field),result);
end;

function TSQLTable.GetAsInt64(Row: integer; const FieldName: RawUTF8): Int64;
begin
  SetInt64(Get(Row,FieldIndex(FieldName)),result);
end;

function TSQLTable.GetAsFloat(Row,Field: integer): TSynExtended;
begin
  result := GetExtended(Get(Row,Field));
end;

function TSQLTable.GetAsFloat(Row: integer; const FieldName: RawUTF8): TSynExtended;
begin
  result := GetExtended(Get(Row,FieldIndex(FieldName)));
end;

function TSQLTable.GetAsCurrency(Row,Field: integer): currency;
begin
  result := StrToCurrency(Get(Row,Field));
end;

function TSQLTable.GetAsCurrency(Row: integer; const FieldName: RawUTF8): currency;
begin
  result := StrToCurrency(Get(Row,FieldIndex(FieldName)));
end;

function TSQLTable.GetAsDateTime(Row,Field: integer): TDateTime;
var P: PUTF8Char;
begin
  result := 0;
  if Row=0 then
    exit; // header
  P := Get(Row,Field);
  if P=nil then
    exit;
  case FieldType(Field) of
  sftCurrency,sftFloat:
    result := GetExtended(P);
  sftInteger, // TSQLTable.InitFieldTypes may have recognized an integer
  sftTimeLog, sftModTime, sftCreateTime:
    result := TimeLogToDateTime(GetInt64(P));
  sftUnixTime:
    result := UnixTimeToDateTime(GetInt64(P));
  sftUnixMSTime:
    result := UnixMSTimeToDateTime(GetInt64(P));
  else // sftDateTime and any other kind will try from ISO-8601 text
    result := Iso8601ToDateTimePUTF8Char(P);
  end;
end;

function TSQLTable.GetAsDateTime(Row: integer; const FieldName: RawUTF8): TDateTime;
begin
  result := GetAsDateTime(Row,FieldIndex(FieldName));
end;

function TSQLTable.GetS(Row, Field: integer): shortstring;
begin
  UTF8ToShortString(result,Get(Row,Field));
end;

function TSQLTable.GetString(Row, Field: integer): string;
var U: PUTF8Char;
begin
  U := Get(Row,Field);
  if U=nil then
    result := '' else
    {$ifdef UNICODE}
    UTF8DecodeToUnicodeString(U,StrLen(U),result);
    {$else}
    CurrentAnsiConvert.UTF8BufferToAnsi(U,StrLen(U),RawByteString(result));
    {$endif}
end;

function TSQLTable.GetSynUnicode(Row,Field: integer): SynUnicode;
var U: PUTF8Char;
begin
  result := '';
  U := Get(Row,Field);
  if U<>nil then
    UTF8ToSynUnicode(U,StrLen(U),result);
end;

function TSQLTable.GetCaption(Row, Field: integer): string;
begin
  GetCaptionFromPCharLen(Get(Row,Field),result);
end;

function BlobToTSQLRawBlob(P: PUTF8Char): TSQLRawBlob;
begin
  BlobToTSQLRawBlob(P,result);
end;

procedure BlobToTSQLRawBlob(P: PUTF8Char; var result: TSQLRawBlob);
var Len, LenHex: integer;
begin
  result := '';
  Len := StrLen(P);
  if Len=0 then
    exit;
  if Len>=3 then
    if (P[0] in ['x','X']) and (P[1]='''') and (P[Len-1]='''') then begin
      // BLOB literals are string literals containing hexadecimal data and
      // preceded by a single "x" or "X" character. For example: X'53514C697465'
      LenHex := (Len-3) shr 1;
      SetLength(result,LenHex);
      if SynCommons.HexToBin(@P[2],pointer(result),LenHex) then
        exit; // valid hexa data
    end else
    if (PInteger(P)^ and $00ffffff=JSON_BASE64_MAGIC) and
       Base64ToBinSafe(@P[3],Len-3,RawByteString(result)) then
      exit; // safe decode Base-64 content ('\uFFF0base64encodedbinary')
  // TEXT format
  SetString(result,PAnsiChar(P),Len);
end;

function BlobToTSQLRawBlob(const Blob: RawByteString): TSQLRawBlob;
var Len, LenHex: integer;
    P: PUTF8Char;
begin
  result := '';
  if Blob='' then
    exit;
  Len := length(Blob);
  P := pointer(Blob);
  if Len>=3 then
    if (P[0] in ['x','X']) and (P[1]='''') and (P[Len-1]='''') then begin
      // BLOB literals are string literals containing hexadecimal data and
      // preceded by a single "x" or "X" character. For example: X'53514C697465'
      LenHex := (Len-3) shr 1;
      SetLength(result,LenHex);
      if SynCommons.HexToBin(@P[2],pointer(result),LenHex) then
        exit; // valid hexa data
    end else
    if (PInteger(P)^ and $00ffffff=JSON_BASE64_MAGIC) and
       Base64ToBinSafe(@P[3],Len-3,RawByteString(result)) then
      exit; // safe decode Base-64 content ('\uFFF0base64encodedbinary')
  // TEXT format
  result := Blob;
end;

function BlobToStream(P: PUTF8Char): TStream;
begin
  Result := TRawByteStringStream.Create(BlobToTSQLRawBlob(P));
end;

function BlobToBytes(P: PUTF8Char): TBytes;
var Len, LenResult: integer;
begin
  result := nil;
  Len := StrLen(P);
  if Len=0 then
    exit;
  if Len>=3 then
    if (P[0] in ['x','X']) and (P[1]='''') and (P[Len-1]='''') then begin
      // BLOB literals format
      LenResult := (Len-3)shr 1;
      SetLength(Result,LenResult);
      if SynCommons.HexToBin(@P[2],pointer(Result),LenResult) then
        exit; // valid hexa data
    end else
    if (PInteger(P)^ and $00ffffff=JSON_BASE64_MAGIC) and IsBase64(@P[3],Len-3) then begin
      // Base-64 encoded content ('\uFFF0base64encodedbinary')
      inc(P,3);
      dec(Len,3);
      LenResult := Base64ToBinLength(pointer(P),len);
      SetLength(Result,LenResult);
      if LenResult>0 then
        Base64Decode(pointer(P),pointer(Result),Len shr 2);
      exit;
    end;
  // TEXT format
  SetLength(Result,Len);
  MoveFast(P^,pointer(Result)^,Len);
end;

function TSQLRawBlobToBlob(const RawBlob: TSQLRawBlob): RawUTF8;
// BLOB literals are string literals containing hexadecimal data and
//  preceded by a single "x" or "X" character. For example: X'53514C697465'
begin
  result := TSQLRawBlobToBlob(pointer(RawBlob),length(RawBlob));
end;

function TSQLRawBlobToBlob(RawBlob: pointer; RawBlobLength: integer): RawUTF8;
// BLOB literals are string literals containing hexadecimal data and
//  preceded by a single "x" or "X" character. For example: X'53514C697465'
var P: PAnsiChar;
begin
  result := '';
  if RawBlobLength<>0 then begin
    SetLength(result,RawBlobLength*2+3);
    P := pointer(result);
    P[0] := 'X';
    P[1] := '''';
    BinToHex(RawBlob,P+2,RawBlobLength);
    P[RawBlobLength*2+2] := '''';
  end;
end;

function isBlobHex(P: PUTF8Char): boolean;
// BLOB literals are string literals containing hexadecimal data and
// preceded by a single "x" or "X" character. For example: X'53514C697465'
var Len: integer;
begin
  if P=nil then begin
    result := false;
    exit;
  end;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if (P[0] in ['x','X']) and (P[1]='''') then begin
    Len := (StrLen(P)-3) shr 1;
    result := (P[Len-1]='''') and SynCommons.HexToBin(@P[2],nil,Len);
    exit;
  end else begin
    result := false;
    exit;
  end;
end;

function TSQLTable.GetBlob(Row, Field: integer): TSQLRawBlob;
begin
  result := BlobToTSQLRawBlob(Get(Row,Field));
end;

function TSQLTable.GetBytes(Row,Field: integer): TBytes;
begin
  result := BlobToBytes(Get(Row,Field));
end;

function TSQLTable.GetStream(Row,Field: integer): TStream;
begin
  result := BlobToStream(Get(Row,Field));
end;

function TSQLTable.GetDateTime(Row, Field: integer): TDateTime;
begin
  result := Iso8601ToDateTimePUTF8Char(Get(Row,Field),0)
end;

function TSQLTable.GetRowValues(Field: integer; out Values: TRawUTF8DynArray): integer;
var i: integer;
    U: PPUTF8Char;
begin
  result := 0;
  if (self=nil) or (cardinal(Field)>cardinal(FieldCount)) or (fRowCount=0) then
    exit;
  SetLength(Values,fRowCount);
  U := @fResults[FieldCount+Field]; // start reading after first Row (= Field Names)
  for i := 0 to fRowCount-1 do begin
    FastSetString(Values[i],U^,StrLen(U^));
    inc(U,FieldCount); // go to next row
  end;
  result := fRowCount;
end;

function TSQLTable.GetRowValues(Field: integer; out Values: TInt64DynArray): integer;
var i: integer;
    U: PPUTF8Char;
begin
  result := 0;
  if (self=nil) or (cardinal(Field)>cardinal(FieldCount)) or (fRowCount=0) then
    exit;
  SetLength(Values,fRowCount);
  U := @fResults[FieldCount+Field]; // start reading after first Row (= Field Names)
  for i := 0 to fRowCount-1 do begin
    SetInt64(U^,Values[i]);
    inc(U,FieldCount); // go to next row
  end;
  result := fRowCount;
end;

function TSQLTable.GetRowLengths(Field: integer; var LenStore: TSynTempBuffer): integer;
var len: PInteger;
    i: integer;
    U: PPUTF8Char;
begin
  result := 0;
  if (self=nil) or (cardinal(Field)>cardinal(FieldCount)) or (fRowCount=0) then begin
    LenStore.buf := nil; // avoid GPF in LenStore.Done
    exit;
  end;
  U := @fResults[FieldCount+Field]; // start reading after first Row (= Field Names)
  len := LenStore.Init(fRowCount*SizeOf(len^));
  for i := 1 to fRowCount do begin
    len^ := StrLen(U^);
    inc(result,len^);
    inc(len);
    inc(U,FieldCount); // go to next row
  end;
end;

function TSQLTable.GetRowValues(Field: integer; const Sep,Head,Trail: RawUTF8): RawUTF8;
var i, L, SepLen: integer;
    U: PPUTF8Char;
    P: PUTF8Char;
    len: PInteger;
    tmp: TSynTempBuffer;
begin
  L := GetRowLengths(Field,tmp);
  if L=0 then begin
    result := Head+Trail;
    exit;
  end;
  SepLen := length(Sep);
  inc(L,length(Head)+SepLen*(fRowCount-1)+length(Trail));
  FastSetString(result,nil,L);
  P := AppendRawUTF8ToBuffer(pointer(result),Head);
  U := @fResults[FieldCount+Field]; // start reading after first Row (= Field Names)
  len := tmp.buf;
  for i := 2 to fRowCount do begin
    MoveFast(U^^,P^,len^);
    inc(P,len^);
    if SepLen>0 then begin
      MoveSmall(pointer(Sep),P,SepLen);
      inc(P,SepLen);
    end;
    inc(len);
    inc(U,FieldCount); // go to next row
  end;
  MoveFast(U^^,P^,len^); // last row without Sep
  if Trail<>'' then
    MoveFast(pointer(Trail)^,P[len^],length(Trail));
  tmp.Done;
end;

procedure TSQLTable.GetJSONValues(W: TJSONWriter; RowFirst, RowLast, IDBinarySize: integer);
var U: PPUTF8Char;
    f,r: PtrInt;
    i64: Int64;
label nostr,str;
begin
  if (self=nil) or (FieldCount<=0) or (fRowCount<=0) then begin
    W.Add('[',']');
    exit;
  end;
  // check range
  if RowLast=0 then
    RowLast := fRowCount else
  if RowLast>fRowCount then
    RowLast := fRowCount;
  if RowFirst<=0 then
    RowFirst := 1; // start reading after first Row (Row 0 = Field Names)
  // get col names and types
  if fFieldType=nil then
    InitFieldTypes;
  SetLength(W.ColNames,FieldCount);
  for f := 0 to FieldCount-1 do begin
    W.ColNames[f] := fResults[f]; // first Row is field Names
    if not Assigned(OnExportValue) then
      if (f=fFieldIndexID) and (IDBinarySize>0) then
        W.ColNames[f] := 'id'; // ajax-friendly
  end;
  W.AddColumns(RowLast-RowFirst+1); // write or init field names (see JSON Expand)
  if W.Expand then
    W.Add('[');
  // write rows data
  U := @fResults[FieldCount*RowFirst];
  for r := RowFirst to RowLast do begin
    if W.Expand then
      W.Add('{');
    for f := 0 to FieldCount-1 do begin
      if W.Expand then
        W.AddString(W.ColNames[f]); // '"'+ColNames[]+'":'
      if Assigned(OnExportValue) then
        W.AddString(OnExportValue(self,r,f,false)) else
      if (IDBinarySize>0) and (f=fFieldIndexID) then begin
        SetInt64(U^,i64);
        W.AddBinToHexDisplayQuoted(@i64,IDBinarySize);
      end else
      if U^=nil then
        W.AddShort('null') else
      case fFieldType[f].ContentDB of
        ftInt64,ftDouble,ftCurrency:
nostr:      W.AddNoJSONEscape(U^,StrLen(U^));
        ftDate,ftUTF8,ftBlob: begin
str:      W.Add('"');
          W.AddJSONEscape(U^);
          W.Add('"');
        end;
        else if IsStringJSON(U^) then // fast and safe enough
          goto str else
          goto nostr;
      end;
      W.Add(',');
      inc(U); // points to next value
    end;
    W.CancelLastComma;
    if W.Expand then begin
      W.Add('}',',');
      if r<>RowLast then
        W.AddCR; // make expanded json more human readable
    end else
      W.Add(',');
  end;
  W.EndJSONObject(1,0,false); // "RowCount": set by W.AddColumns() above
end;

procedure TSQLTable.GetJSONValues(JSON: TStream; Expand: boolean;
  RowFirst, RowLast, IDBinarySize: integer);
var W: TJSONWriter;
    tmp: TTextWriterStackBuffer;
begin
  W := TJSONWriter.Create(JSON,Expand,false,nil,0,@tmp);
  try
    GetJSONValues(W,RowFirst,RowLast,IDBinarySize);
    W.FlushFinal;
  finally
    W.Free;
  end;
end;

function TSQLTable.GetJSONValues(Expand: boolean; IDBinarySize, BufferSize: integer): RawUTF8;
var W: TJSONWriter;
    tmp: TTextWriterStackBuffer;
begin
  if BufferSize<SizeOf(tmp) then
    W := TJSONWriter.CreateOwnedStream(tmp) else
    W := TJSONWriter.CreateOwnedStream(BufferSize);
  try
    W.Expand := Expand;
    GetJSONValues(W,0,0,IDBinarySize); // create JSON data in MS
    W.SetText(result);
  finally
    W.Free;
  end;
end;

procedure TSQLTable.GetCSVValues(Dest: TStream; Tab: boolean; CommaSep: AnsiChar;
  AddBOM: boolean; RowFirst,RowLast: integer);
var U: PPUTF8Char;
    F,R,FMax: integer;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  if (self=nil) or (FieldCount<=0) or (fRowCount<=0) then
    exit;
  if (RowLast=0) or (RowLast>fRowCount) then
    RowLast := fRowCount;
  if RowFirst<0 then
    RowFirst := 0;
  W := TTextWriter.Create(Dest,@temp,SizeOf(temp));
  try
    if AddBOM then
      W.AddShort(#$ef#$bb#$bf); // add UTF-8 Byte Order Mark
    if Tab then
      CommaSep := #9;
    FMax := FieldCount-1;
    U := @fResults[RowFirst*FieldCount];
    for R := RowFirst to RowLast do
      for F := 0 to FMax do begin
        if Assigned(OnExportValue) then
          W.AddString(OnExportValue(self,R,F,false)) else
        if Tab or not IsStringJSON(U^) then
          W.AddNoJSONEscape(U^,StrLen(U^)) else begin
          W.Add('"');
          W.AddNoJSONEscape(U^,StrLen(U^));
          W.Add('"');
        end;
        if F=FMax then
          W.AddCR else
          W.Add(CommaSep);
        inc(U); // points to next value
      end;
    W.FlushFinal;
  finally
    W.Free;
  end;
end;

function TSQLTable.GetCSVValues(Tab: boolean; CommaSep: AnsiChar;
  AddBOM: boolean; RowFirst,RowLast: integer): RawUTF8;
var MS: TRawByteStringStream;
begin
  MS := TRawByteStringStream.Create;
  try
    GetCSVValues(MS,Tab,CommaSep,AddBOM,RowFirst,RowLast);
    result := MS.DataString;
  finally
    MS.Free;
  end;
end;

procedure TSQLTable.GetMSRowSetValues(Dest: TStream; RowFirst,RowLast: integer);
const FIELDTYPE_TOXML: array[TSQLDBFieldType] of RawUTF8 = (
  // ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency,
     '','',' dt:type="i8"',' dt:type="float"',' dt:type="number" rs:dbtype="currency"',
  // ftDate, ftUTF8, ftBlob
     ' dt:type="dateTime"',' dt:type="string"',' dt:type="bin.hex"');
var W: TTextWriter;
    f,r: integer;
    U: PPUTF8Char;
begin
  W := TTextWriter.Create(Dest,32768);
  try
    W.AddShort('<xml xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882" '+
      'xmlns:dt="uuid:C2F41010-65B3-11d1-A29F-00AA00C14882" '+
      'xmlns:rs="urn:schemas-microsoft-com:rowset" xmlns:z="#RowsetSchema">');
    if (self<>nil) and ((FieldCount>0) or (fRowCount>0)) then begin
      // retrieve normalized field names and types
      if length(fFieldNames)<>fFieldCount then
        InitFieldNames;
      if fFieldType=nil then
        InitFieldTypes;
      // check range
      if RowLast=0 then
        RowLast := fRowCount else
      if RowLast>fRowCount then
        RowLast := fRowCount;
      if RowFirst<=0 then
        RowFirst := 1; // start reading after first Row (Row 0 = Field Names)
      // write schema from col names and types
      W.AddShort('<s:Schema id="RowsetSchema"><s:ElementType name="row" content="eltOnly">');
      for f := 0 to FieldCount-1 do begin
        W.AddShort('<s:AttributeType name="f');
        W.Add(f);
        W.AddShort('" rs:name="');
        W.AddString(fFieldNames[f]);
        W.Add('"');
        W.AddString(FIELDTYPE_TOXML[fFieldType[f].ContentDB]);
        W.Add('/','>');
      end;
      W.AddShort('</s:ElementType></s:Schema>');
      // write rows data
      U := @fResults[FieldCount*RowFirst];
      W.AddShort('<rs:data>');
      for r := RowFirst to RowLast do begin
        W.AddShort('<z:row ');
        for f := 0 to FieldCount-1 do begin
          if U^<>nil then begin
            W.Add('f');
            W.Add(f);
            W.Add('=','"');
            W.AddXmlEscape(U^);
            W.Add('"',' ');
          end;
          inc(U); // points to next value
        end;
        W.Add('/','>');
      end;
      W.AddShort('</rs:data>');
    end;
    W.AddShort('</xml>');
    W.FlushFinal;
  finally
    W.Free;
  end;
end;

function TSQLTable.GetMSRowSetValues: RawUTF8;
var MS: TRawByteStringStream;
begin
  MS := TRawByteStringStream.Create;
  try
    GetMSRowSetValues(MS,1,RowCount);
    result := MS.DataString;
  finally
    MS.Free;
  end;
end;

function TSQLTable.GetODSDocument(withColumnTypes: boolean): RawByteString;
const
  ODSmimetype: RawUTF8 = 'application/vnd.oasis.opendocument.spreadsheet';
  ODSContentHeader: RawUTF8 = '<office:document-content office:version="1.2" xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0"'+
  ' xmlns:text="urn:oasis:names:tc:opendocument:xmlns:text:1.0" xmlns:table="urn:oasis:names:tc:opendocument:xmlns:table:1.0"'+
  ' xmlns:meta="urn:oasis:names:tc:opendocument:xmlns:meta:1.0" ><office:body><office:spreadsheet><table:table table:name="Sheet1">'+
  '<table:table-column table:number-columns-repeated="';
  ODSContentFooter = '</table:table><table:named-expressions/></office:spreadsheet></office:body></office:document-content>';
  ODSstyles: RawUTF8 = XMLUTF8_HEADER+'<office:document-styles xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0" office:version="1.2"></office:document-styles>';
  ODSmeta: RawUTF8 = XMLUTF8_HEADER+'<office:document-meta xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0" office:version="1.2"></office:document-meta>';
  ODSsettings: RawUTF8 = XMLUTF8_HEADER+'<office:document-settings xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0" office:version="1.2"></office:document-settings>';
  ODSmanifest: RawUTF8 = XMLUTF8_HEADER+'<manifest:manifest xmlns:manifest="urn:oasis:names:tc:opendocument:xmlns:manifest:1.0"'+
  ' manifest:version="1.2"><manifest:file-entry manifest:full-path="/" manifest:version="1.2" manifest:media-type="application/vnd.oasis.opendocument.spreadsheet"/>'+
  '<manifest:file-entry manifest:full-path="meta.xml" manifest:media-type="text/xml"/><manifest:file-entry manifest:full-path="settings.xml" manifest:media-type="text/xml"/>'+
  '<manifest:file-entry manifest:full-path="content.xml" manifest:media-type="text/xml"/><manifest:file-entry manifest:full-path="styles.xml" manifest:media-type="text/xml"/></manifest:manifest>';
var Zip: TZipWriteToStream;
    Dest: TRawByteStringStream;
    content: RawUTF8;
    W: TTextWriter;
    U: PPUTF8Char;
    r,f: integer;
begin
  Dest := TRawByteStringStream.Create;
  try
    Zip := TZipWriteToStream.Create(Dest);
    try
      Zip.AddStored('mimetype',pointer(ODSmimetype),length(ODSmimetype));
      Zip.AddDeflated('styles.xml',pointer(ODSstyles),length(ODSstyles));
      Zip.AddDeflated('meta.xml',pointer(ODSmeta),length(ODSmeta));
      Zip.AddDeflated('settings.xml',pointer(ODSsettings),length(ODSsettings));
      Zip.AddDeflated('META-INF/manifest.xml',pointer(ODSmanifest),length(ODSmanifest));
      W := TTextWriter.CreateOwnedStream(65536);
      try
        W.AddShort(XMLUTF8_HEADER);
        W.AddString(ODSContentHeader);
        W.Add(FieldCount);
        W.AddShort('" />');
        if (self<>nil) and ((FieldCount>0) or (fRowCount>0)) then begin
          if withColumnTypes and (fFieldType=nil) then
            InitFieldTypes;
          U := pointer(fResults);
          for r := 0 to fRowCount do begin
            W.AddShort('<table:table-row>');
            if withColumnTypes and (r>0) then begin
              for f := 0 to FieldCount-1 do begin
                W.AddShort('<table:table-cell office:value-type="');
                case fFieldType[f].ContentDB of
                  ftInt64,ftDouble,ftCurrency: begin
                    W.AddShort('float" office:value="');
                    W.AddXmlEscape(U^);
                    W.AddShort('" />');
                  end;
                  ftDate: begin
                    W.AddShort('date" office:date-value="');
                    W.AddXmlEscape(U^);
                    W.AddShort('" />');
                  end;
                  else begin //ftUnknown,ftNull,ftUTF8,ftBlob:
                    W.AddShort('string"><text:p>');
                    W.AddXmlEscape(U^);
                    W.AddShort('</text:p></table:table-cell>');
                  end;
                end;
                inc(U); // points to next value
              end;
            end else
              for f := 0 to FieldCount-1 do begin
                W.AddShort('<table:table-cell office:value-type="string"><text:p>');
                W.AddXmlEscape(U^);
                W.AddShort('</text:p></table:table-cell>');
                inc(U);
              end;
            W.AddShort('</table:table-row>');
          end;
        end;
        W.AddShort(ODSContentFooter);
        W.SetText(content);
      finally
        W.Free;
      end;
      Zip.AddDeflated('content.xml',pointer(content),length(content));
    finally
      Zip.Free;
    end;
    result := Dest.DataString;
  finally
    Dest.Free;
  end;
end;

procedure TSQLTable.GetHtmlTable(Dest: TTextWriter);
var R,F: integer;
    U: PPUTF8Char;
begin
  Dest.AddShort('<table>'#10);
  U := pointer(fResults);
  for R := 0 to fRowCount do begin
    Dest.AddShort('<tr>');
    for F := 0 to FieldCount-1 do begin
      if R=0 then
        Dest.AddShort('<th>') else
        Dest.AddShort('<td>');
      if Assigned(OnExportValue) and (R>0) then
        Dest.AddHtmlEscapeUTF8(OnExportValue(self,R,F,true),hfOutsideAttributes) else
        Dest.AddHtmlEscape(U^,hfOutsideAttributes);
      if R=0 then
        Dest.AddShort('</th>') else
        Dest.AddShort('</td>');
      inc(U); // points to next value
    end;
    Dest.AddShort('</tr>'#10);
  end;
  Dest.AddShort('</table>');
end;

function TSQLTable.GetHtmlTable(const Header: RawUTF8): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    W.AddShort('<html>');
    W.AddString(Header);
    W.AddShort('<body>'#10);
    GetHtmlTable(W);
    W.AddShort(#10'</body></html>');
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TSQLTable.GetW(Row, Field: integer): RawUnicode;
begin
  result := UTF8DecodeToRawUnicode(Get(Row,Field),0);
end;

function TSQLTable.GetWP(Row, Field: integer; Dest: PWideChar; MaxDestChars: cardinal): integer;
var P: PUTF8Char;
begin
  P := Get(Row,Field);
  result := UTF8ToWideChar(Dest,P,MaxDestChars,0) shr 1; // bytes div 2
end;

function TSQLTable.LengthW(Row, Field: integer): integer;
begin // nil -> fast calculate unicode length, without any memory allocation
  result := Utf8ToUnicodeLength(Get(Row,Field));
end;

function UTF8CompareCurr64(P1,P2: PUTF8Char): PtrInt;
var V1,V2: Int64;
begin // faster than UTF8CompareDouble() for pure decimal (no exponent) values
  V1 := StrToCurr64(P1);
  V2 := StrToCurr64(P2);
  if V1<V2 then
    result := -1 else
    if V1=V2 then
      result := 0 else
      result := +1;
end;

function UTF8CompareBoolean(P1,P2: PUTF8Char): PtrInt;
label Z,P,N;
begin // assume 0 is FALSE, anything else is true
  if P1=P2  then goto Z else
  if P1=nil then goto P else
  if P2=nil then goto N else
  if (P1^=#0) or (PWord(P1)^=ord('0')) then
    if (P2^=#0) or (PWord(P2)^=ord('0')) then begin
Z:    result := 0;  // P1=false P2=false
      exit;
    end else begin
N:    result := -1; // P1=false P2=true
      exit;
    end else
    if (P2^<>#0) and (PWord(P2)^<>ord('0')) then
      goto Z        // P1=true P2=true
    else begin
P:    result := 1;  // P1=true P2=false
      exit;
    end;
end;

function UTF8CompareInt32(P1,P2: PUTF8Char): PtrInt;
var V1,V2: PtrInt;
begin
  if P1=P2 then begin
    result := 0;
    exit;
  end;
  V1 := GetInteger(P1);
  V2 := GetInteger(P2);
  if V1<V2 then
    result := -1 else
    if V1=V2 then
      result := 0 else
      result := +1;
end;

function UTF8CompareUInt32(P1,P2: PUTF8Char): PtrInt;
var V1,V2: PtrUInt;
begin
  if P1=P2 then begin
    result := 0;
    exit;
  end;
  V1 := GetCardinal(P1);
  V2 := GetCardinal(P2);
  if V1<V2 then
    result := -1 else
    if V1=V2 then
      result := 0 else
      result := +1;
end;

function UTF8CompareRecord(P1,P2: PUTF8Char): PtrInt;
var V1,V2: Int64;
    T1,T2: cardinal;
begin
  if P1=P2 then begin
    result := 0;
    exit;
  end;
  SetInt64(P1,V1);
  SetInt64(P2,V2);
  if V1=V2 then
    result := 0 else begin
    // special RecordRef / TRecordReference INTEGER sort
    T1 := V1 and 63;  // first sort by Table order
    T2 := V2 and 63;
    if T1<T2 then
      result := -1 else
      if T1>T2 then
        result := +1 else
        // we have T1=T2 -> same Table -> sort by ID
        if V1<V2 then
          result := -1 else
          if V1=V2 then
            result := 0 else
            result := +1;
  end;
end;

function UTF8CompareInt64(P1,P2: PUTF8Char): PtrInt;
var V1,V2: Int64;
begin
  if P1=P2 then begin
    result := 0;
    exit;
  end;
  SetInt64(P1,V1);
  SetInt64(P2,V2);
  if V1<V2 then
    result := -1 else
    if V1=V2 then
      result := 0 else
      result := +1;
end;

function UTF8CompareDouble(P1,P2: PUTF8Char): PtrInt;
var V1,V2: TSynExtended;
    Err: integer;
label er;
begin
  if P1=P2 then begin
    result := 0;
    exit;
  end;
  v1 := GetExtended(P1,Err);
  if Err<>0 then begin
er: result := UTF8IComp(P1,P2);
    exit;
  end;
  V2 := GetExtended(P2,Err);
  if Err<>0 then goto er;
  if V1<V2 then // we don't care about exact = for a sort: Epsilon check is slow
    result := -1 else
    result := +1;
end;

function UTF8CompareISO8601(P1,P2: PUTF8Char): PtrInt;
var V1,V2: TDateTime;
begin
  if P1=P2 then begin
    result := 0;
    exit;
  end;
  Iso8601ToDateTimePUTF8CharVar(P1,0,V1);
  Iso8601ToDateTimePUTF8CharVar(P2,0,V2);
  if (V1=0) or (V2=0) then // any invalid date -> compare as strings
    result := StrComp(P1,P2) else
    if SameValue(V1,V2,1/MSecsPerDay) then
      result := 0 else
      if V1<V2 then
        result := -1 else
        result := +1;
end;

var
  /// simple wrapper to UTF-8 compare function for the SQLite3 field datatypes
  // - used internaly for field sorting (see TSQLTable.SortFields() method)
  // and for default User Interface Query (see TSQLRest.QueryIsTrue() method)
  SQLFieldTypeComp: array[TSQLFieldType] of TUTF8Compare  =
   (nil,                  // unknown
    nil,    // AnsiText will be set to AnsiIComp in initialization block below
    {$ifdef USENORMTOUPPER}
    UTF8IComp,           // UTF8Text, 8 bits case insensitive compared
    {$else}
    nil,    // UTF8Text will be set to AnsiIComp in initialization block below
    {$endif}
    UTF8CompareUInt32,   // Enumerate
    UTF8CompareUInt32,   // Set
    UTF8CompareInt64,    // Integer
    UTF8CompareInt64,    // ID
    UTF8CompareRecord,   // Record
    UTF8CompareBoolean,  // Boolean
    UTF8CompareDouble,   // Float
    UTF8CompareISO8601,  // TDateTime
    UTF8CompareInt64,    // TTimeLog
    UTF8CompareCurr64,   // Currency
    nil,                 // Object (TEXT serialization)
    {$ifndef NOVARIANTS}
    nil,                 // Variant (TEXT serialization)
    nil,                 // TNullable*
    {$endif NOVARIANTS}
    nil,                 // Blob
    nil,                 // BlobDynArray
    nil,                 // BlobCustom
    nil,                 // UTF8Custom
    nil,
    UTF8CompareInt64,    // TModTime
    UTF8CompareInt64,    // TCreateTime
    UTF8CompareInt64,    // TID
    UTF8CompareInt64,    // TRecordVersion
    UTF8CompareInt64,    // TSessionUserID
    UTF8CompareISO8601,  // TDateTimeMS
    UTF8CompareInt64,    // TUnixTime
    UTF8CompareInt64);   // TUnixMSTime

type
  /// a static object is used for smaller recursive stack size and faster code
  // - these special sort implementation do the comparison first by the
  // designed field, and, if the field value is identical, the ID value is
  // used (it will therefore sort by time all identical values)
  // - code generated is very optimized: stack and memory usage, CPU registers
  // prefered, multiplication avoided to calculate memory position from index,
  // hand tuned assembler...
  {$ifdef USERECORDWITHMETHODS}TUTF8QuickSort = record
    {$else}TUTF8QuickSort = object{$endif}
  public
    // sort parameters
    Results: PPUtf8CharArray;
    IDColumn: PPUtf8CharArray;
    Params: TSQLTableSortParams;
    CurrentRow: PtrInt;
    // avoid multiplications to calculate data memory position from index
    FieldCountNextPtr, FieldFirstPtr, FieldIDPtr: PtrUInt;
    // temp vars (avoid stack usage):
    PID: Int64;
    PP, CI, CJ: PPUTF8Char;
    I, J: PtrInt;
    /// recursively perform the sort
    procedure Sort(L, R: Integer);
    /// compare value at index I with pivot value
    // - sort by ID if values are identical
    function CompI: integer; {$ifdef HASINLINE}inline;{$endif}
    /// compare value at index J with pivot value
    // - sort by ID if values are identical
    function CompJ: integer; {$ifdef HASINLINE}inline;{$endif}
    /// set the pivot value
    procedure SetPP(aPP: PPUTF8Char; aP: PtrInt);
  end;

procedure TUTF8QuickSort.SetPP(aPP: PPUTF8Char; aP: PtrInt);
begin
  PP := aPP;
  // PID must be updated every time PP is modified
  if Assigned(IDColumn) then
    SetInt64(IDColumn[aP],PID) else
    SetInt64(PPUTF8Char(PtrUInt(aPP)-FieldIDPtr)^,PID);
end;

function TUTF8QuickSort.CompI: integer;
var i64: Int64;
begin
  result := Params.Comp(CI^,PP^);
  if result=0 then begin
    // same value -> sort by ID
    if Assigned(IDColumn) then
      SetInt64(IDColumn[I],i64) else
      SetInt64(PPUTF8Char(PtrUInt(CI)-FieldIDPtr)^,i64);
    if i64<PID then
      result := -1 else
    if i64<>PID then
      result := +1;
  end;
end;

function TUTF8QuickSort.CompJ: integer;
var i64: Int64;
begin
  result := Params.Comp(CJ^,PP^);
  if result=0 then begin
    // same value -> sort by ID
    if Assigned(IDColumn) then
      SetInt64(IDColumn[J],i64) else
      SetInt64(PPUTF8Char(PtrUInt(CJ)-FieldIDPtr)^,i64);
    if i64<PID then
      result := -1 else
    if i64<>PID then
      result := +1;
  end;
end;

procedure ExchgFields(P1,P2: PPointer; FieldCount: PtrUInt);
{$ifdef CPUX86} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=P1 edx=P2 ecx=FieldCount
        push    esi
        push    edi
@1:     mov     esi, [eax]
        mov     edi, [edx]
        mov     [edx], esi
        mov     [eax], edi
        add     eax, 4
        add     edx, 4
        dec     ecx
        jnz     @1
        pop     edi
        pop     esi
end;
{$else} inline;
var p: pointer;
begin
  repeat
    p := P1^;
    P1^ := P2^;
    P2^ := p;
    inc(P1);
    inc(P2);
    dec(FieldCount);
  until FieldCount=0;
end;
{$endif CPUX86}

procedure ExchgPointer(p1,p2: PPointer); {$ifdef HASINLINE}inline;{$endif}
var p: pointer;
begin
  p := p2^;
  p2^ := p1^;
  p1^ := p;
end;

procedure TUTF8QuickSort.Sort(L, R: Integer);
var P: PtrInt;
begin
  if @Params.Comp<>nil then
  repeat
    I := L;
    CI := @Results[I*Params.FieldCount+Params.FieldIndex];
    J := R;
    CJ := @Results[J*Params.FieldCount+Params.FieldIndex];
    P := ((I+J) shr 1);
    SetPP(@Results[P*Params.FieldCount+Params.FieldIndex],P);
    repeat
      // this loop has no multiplication -> most of the time is spent in compIJ
      if Params.Asc then begin // ascending order comparison
        while compI<0 do begin
          inc(I);
          inc(PByte(CI),FieldCountNextPtr); // next row
        end;
        while compJ>0 do begin
          dec(J);
          dec(PByte(CJ),FieldCountNextPtr); // previous row
        end;
      end else begin // descending order comparison
        while compI>0 do begin
          inc(I);
          inc(PByte(CI),FieldCountNextPtr); // next row
        end;
        while compJ<0 do begin
          dec(J);
          dec(PByte(CJ),FieldCountNextPtr); // previous row
        end;
      end;
      if I<=J then begin
        if I<>J then begin // swap elements
          if CurrentRow=J then // update current row number
            CurrentRow := I else
          if CurrentRow=I then
            CurrentRow := J;
          // full row exchange
          ExchgFields(pointer(PtrUInt(CI)-FieldFirstPtr),pointer(PtrUInt(CJ)-FieldFirstPtr),
            Params.FieldCount); // exchange PUTF8Char for whole I,J rows
          if Assigned(IDColumn) then // exchange hidden ID column also
            ExchgPointer(@IDColumn[I],@IDColumn[J]);
        end;
        if PP=CI then
          SetPP(CJ,J) else
        if PP=CJ then
          SetPP(CI,I);
        inc(I);
        dec(J);
        inc(PByte(CI),FieldCountNextPtr);
        dec(PByte(CJ),FieldCountNextPtr);
      end else
        break;
    until I>J;
    if J - L < R - I then begin // use recursion only for smaller range
      P := I; // I,J will be overriden in QuickSort() call
      if L < J then
        Sort(L, J);
      L := P;
    end else begin
      P := J;
      if I < R then
        Sort(I, R);
      R := P
    end;
  until L >= R;
end;

procedure TSQLTable.SortFields(const FieldName: RawUTF8; Asc: boolean;
  PCurrentRow: PInteger; FieldType: TSQLFieldType; CustomCompare: TUTF8Compare);
begin
  SortFields(FieldIndex(FieldName),Asc,PCurrentRow,FieldType,CustomCompare);
end;

procedure TSQLTable.SortFields(Field: integer; Asc: boolean; PCurrentRow: PInteger;
  FieldType: TSQLFieldType; CustomCompare: TUTF8Compare);
var quicksort: TUTF8QuickSort; // fast static object for sorting
begin
  if (FieldCount=0) or (Cardinal(Field)>=cardinal(FieldCount)) then
    exit;
  if FieldType=sftUnknown then // guess the field type from first row
    FieldType := self.FieldType(Field);
  // store sorting parameters for re-sort in TSQLTableJSON.FillFrom()
  if Assigned(CustomCompare) then
    fSortParams.Comp := CustomCompare else begin
    fSortParams.Comp := SQLFieldTypeComp[FieldType];
    if @fSortParams.Comp=nil then
      exit;
  end;
  fSortParams.FieldType := FieldType;
  fSortParams.FieldCount := FieldCount;
  fSortParams.FieldIndex := Field;
  fSortParams.Asc := Asc;
  // this sort routine is very fast, thanks to the dedicated static object
  quicksort.Params := fSortParams;
  quicksort.Results := fResults;
  quicksort.IDColumn := @fIDColumn[0];
  quicksort.FieldCountNextPtr := FieldCount*SizeOf(PtrInt);
  quicksort.FieldFirstPtr := Field*SizeOf(PtrInt);
  if fFieldIndexID<0 then // if no ID colum, assume first
    quicksort.FieldIDPtr := quicksort.FieldFirstPtr else
    quicksort.FieldIDPtr := (Field-fFieldIndexID)*SizeOf(PtrInt);
  if PCurrentRow=nil then
    quicksort.CurrentRow := -1 else
    quicksort.CurrentRow := PCurrentRow^;
  if fRowCount>1 then // ignore first row = field names -> (1,RowCount)
    quicksort.Sort(1,fRowCount);
  if PCurrentRow<>nil then
    PCurrentRow^ := quicksort.CurrentRow;
end;

function TSQLTable.SearchFieldSorted(const Value: RawUTF8; FieldIndex: integer;
  CustomCompare: TUTF8Compare): integer;
begin
  result := SearchFieldSorted(pointer(Value),FieldIndex,CustomCompare);
end;

function TSQLTable.SearchFieldSorted(Value: PUTF8Char; FieldIndex: integer;
  CustomCompare: TUTF8Compare): integer;
var L,R,cmp: integer;
begin
  if (self<>nil) and (Value<>nil) and (fRowCount>0) and
     (cardinal(FieldIndex)<cardinal(fFieldCount)) then begin
    if not Assigned(CustomCompare) then
      CustomCompare := fSortParams.Comp;
    if Assigned(CustomCompare) then begin // fast binary search
      L := 1;
      R := fRowCount;
      repeat
        result := (L+R) shr 1;
        cmp := CustomCompare(fResults[result*fFieldCount+FieldIndex],Value);
        if cmp=0 then
          exit;
        if cmp<0 then
          L := result+1 else
          R := result-1;
      until L>R;
      result := 0;
    end else
      result := SearchFieldEquals(Value,FieldIndex);
  end else
    result := 0;
end;

type
  {$ifdef USERECORDWITHMETHODS}TUTF8QuickSortMulti = record
    {$else}TUTF8QuickSortMulti = object{$endif}
  public
    Results: PPUtf8CharArray;
    IDColumn: PPUtf8CharArray;
    FieldCount: integer;
    IndexMax: integer;
    Index: array of record
      ndx: integer;
      Comp: TUTF8Compare;
      Desc: boolean;
    end;
    // used for row content comparison
    function Compare(A,B: integer): integer;
    /// recursively perform the sort
    procedure Sort(L, R: Integer);
  end;

function TUTF8QuickSortMulti.Compare(A,B: integer): integer;
var i: PtrInt;
begin
  result := 0;
  for i := 0 to IndexMax do
   with Index[i] do begin
     if ndx>=0 then
       result := Comp(Results[A*FieldCount+ndx],Results[B*FieldCount+ndx]) else
       // Fields[].ndx=-1 for hidden ID column
       result := GetInt64(IDColumn[A])-GetInt64(IDColumn[B]);
     if result<>0 then begin
       if Desc then
         result := -result; // descending order -> inverse comparison
       exit;
     end;
   end;
end;

procedure TUTF8QuickSortMulti.Sort(L, R: Integer);
var I,J,P: integer;
begin
  if L<R then
  repeat
    I := L;
    J := R;
    P := (L+R) shr 1;
    repeat
      while Compare(I,P)<0 do inc(I);
      while Compare(J,P)>0 do dec(J);
      if I<=J then begin
        if I<>J then begin // swap elements
          ExchgFields(pointer(PtrUInt(@Results[I*FieldCount])),
            pointer(PtrUInt(@Results[J*FieldCount])),FieldCount);
          if Assigned(IDColumn) then // update hidden ID column also
            ExchgPointer(@IDColumn[I],@IDColumn[J]);
        end;
        if P=I then
          P := J else
        if P=J then
          P := I;
        inc(I);
        dec(J);
      end;
    until I>J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        Sort(L, J);
      L := I;
    end else begin
      if I < R then
        Sort(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TSQLTable.SortFields(const Fields: array of integer;
  const Asc: array of boolean; const CustomCompare: array of TUTF8Compare);
var quicksort: TUTF8QuickSortMulti;
    i: integer;
begin
  if (self=nil) or (fRowCount<=1) or (FieldCount<=0) or (length(Fields)=0) then
    exit;
  quicksort.FieldCount := FieldCount;
  quicksort.IndexMax := high(Fields);
  SetLength(quicksort.Index,quicksort.IndexMax+1);
  for i := 0 to quicksort.IndexMax do
  with quicksort.Index[i] do begin
    if i<=high(CustomCompare) then
      Comp := CustomCompare[i];
    ndx := Fields[i];
    if ndx<0 then begin // Fields[]=-1 for ID column
      if not Assigned(fIDColumn) then begin // leave ndx<0 for hidden ID
        ndx := fFieldIndexID;  // use the ID column
        if ndx<0 then
          exit; // no ID column available
        if @Comp=nil then
          Comp := @UTF8CompareInt64;
      end;
      continue;
    end;
    if @Comp=nil then
      Comp := SortCompare(ndx);
    if @Comp=nil then
      exit; // impossible to sort this kind of field (or invalid field index)
  end;
  for i := 0 to high(Asc) do
    if (i<=quicksort.IndexMax) and not Asc[i] then
      quicksort.Index[i].Desc := true;
  quicksort.Results := fResults;
  quicksort.IDColumn := @fIDColumn[0];
  quicksort.Sort(1,fRowCount); // ignore first row = field names -> (1,RowCount)
end;

function TSQLTable.SortCompare(Field: integer): TUTF8Compare;
begin
  result := SQLFieldTypeComp[FieldType(Field)];
end;

procedure TSQLTable.Assign(source: TSQLTable);
begin
  fResults := source.fResults;
  fRowCount := source.fRowCount;
  fFieldCount := source.fFieldCount;
end;

constructor TSQLTable.Create(const aSQL: RawUTF8);
begin
  fQuerySQL := aSQL;
  fFieldIndexID := -1;
  fQueryTableIndexFromSQL := -2; // indicates not searched
end;

constructor TSQLTable.CreateFromTables(const Tables: array of TSQLRecordClass;
  const aSQL: RawUTF8);
var n: integer;
begin
  Create(aSQL);
  n := length(Tables);
  if n>0 then begin
    SetLength(fQueryTables,n);
    MoveFast(Tables[0],fQueryTables[0],n*SizeOf(TClass));
  end;
end;

constructor TSQLTable.CreateWithColumnTypes(const ColumnTypes: array of TSQLFieldType;
  const aSQL: RawUTF8);
begin
  Create(aSQL);
  SetLength(fQueryColumnTypes,length(ColumnTypes));
  MoveFast(ColumnTypes[0],fQueryColumnTypes[0],length(ColumnTypes)*SizeOf(TSQLFieldType));
end;

destructor TSQLTable.Destroy;
begin
  fOwnedRecords.Free;
  inherited Destroy;
end;

function TSQLTable.QueryRecordType: TSQLRecordClass;
begin
  if (self<>nil) and (pointer(fQueryTables)<>nil) then
      result := fQueryTables[0] else
      result := nil;
end;

function TSQLTable.NewRecord(RecordType: TSQLRecordClass): TSQLRecord;
begin
  result := nil;
  if self=nil then
    exit;
  if RecordType=nil then begin
    RecordType := QueryRecordType;
    if RecordType=nil then
      exit;
  end;
  result := RecordType.Create;
  if fOwnedRecords=nil then
    fOwnedRecords := TSynObjectList.Create;
  fOwnedRecords.Add(result);
end;

{$ifdef ISDELPHI2010} // Delphi 2009/2010 generics are buggy
function TSQLTable.ToObjectList<T>: TObjectList<T>;
var R,Item: TSQLRecord;
    row: PPUtf8Char;
    i: integer;
    {$ifdef ISDELPHIXE3}rec: PSQLRecordArray;{$endif}
begin
  result := TObjectList<T>.Create; // TObjectList<T> will free each T instance
  if (self=nil) or (fRowCount=0) then
    exit;
  R := TSQLRecordClass(T).Create;
  try
    R.FillPrepare(self);
    row := @fResults[FieldCount]; // row^ points to first row of data
    {$ifdef ISDELPHIXE3}
    result.Count := fRowCount; // faster than manual Add()
    rec := pointer(result.List);
    for i := 0 to fRowCount-1 do begin
      Item := TSQLRecordClass(T).Create;
      rec[i] := Item;
    {$else}
    for i := 1 to fRowCount do begin
      Item := TSQLRecordClass(T).Create;
      Result.Add(Item);
    {$endif}
      R.fFill.Fill(pointer(row),Item);
      Item.fInternalState := fInternalState; // set InternalState property
      Inc(row,FieldCount); // next data row
    end;
  finally
    R.Free;
  end;
end;
{$endif}

procedure TSQLTable.ToObjectList(DestList: TObjectList; RecordType: TSQLRecordClass);
var R: TSQLRecord;
    row: PPUtf8Char;
    rec: PSQLRecord;
    i: integer;
begin
  if DestList=nil then
    exit;
  DestList.Clear;
  if (self=nil) or (fRowCount=0) then
    exit;
  if RecordType=nil then begin
    RecordType := QueryRecordType;
    if RecordType=nil then
      exit;
  end;
  R := RecordType.Create;
  try
    R.FillPrepare(self);
    DestList.Count := fRowCount; // faster than manual Add()
    rec := pointer(DestList.List);
    row := @fResults[FieldCount]; // row^ points to first row of data
    for i := 1 to fRowCount do begin
      rec^ := RecordType.Create; // TObjectList will own and free each instance
      R.fFill.Fill(pointer(row),rec^);
      rec^.fInternalState := fInternalState; // set InternalState property
      inc(rec);
      inc(row,FieldCount); // next data row
    end;
  finally
    R.Free;
  end;
end;

function TSQLTable.ToObjArray(var ObjArray; RecordType: TSQLRecordClass): boolean;
var R: TSQLRecord;
    Row: PPUtf8Char;
    i: integer;
    arr: TSQLRecordObjArray absolute ObjArray;
begin
  result := false;
  ObjArrayClear(arr);
  if self=nil then
    exit;
  if RecordType=nil then begin
    RecordType := QueryRecordType;
    if RecordType=nil then
      exit;
  end;
  result := true;
  if fRowCount=0 then
    exit;
  R := RecordType.Create;
  try
    R.FillPrepare(self);
    SetLength(arr,fRowCount); // faster than manual ObjArrayAdd()
    Row := @fResults[FieldCount]; // Row^ points to first row of data
    for i := 0 to fRowCount-1 do begin
      arr[i] := RecordType.Create;
      R.fFill.Fill(pointer(Row),arr[i]);
      Inc(Row,FieldCount); // next data row
    end;
  finally
    R.Free;
  end;
end;

function TSQLTable.ToObjectList(RecordType: TSQLRecordClass): TObjectList;
begin
  result := TObjectList.Create;
  ToObjectList(result,RecordType);
end;

function TSQLTable.Step(SeekFirst: boolean; RowVariant: PVariant): boolean;
begin
  result := false;
  if (self=nil) or (fRowCount<=0) then
    exit; // nothing to iterate over
  if SeekFirst then
    fStepRow := 1 else
    if fStepRow>=fRowCount then
      exit else
      inc(fStepRow);
  result := true;
{$ifndef NOVARIANTS}
  if RowVariant=nil then
    exit;
  if SQLTableRowVariantType=nil then
    SQLTableRowVariantType := SynRegisterCustomVariantType(TSQLTableRowVariant);
  if (PVarData(RowVariant)^.VType=SQLTableRowVariantType.VarType) and
     (PSQLTableRowVariantData(RowVariant)^.VTable=self) and
     (PSQLTableRowVariantData(RowVariant)^.VRow<0) then
    exit; // already initialized -> quick exit
  VarClear(RowVariant^);
  PSQLTableRowVariantData(RowVariant)^.VType := SQLTableRowVariantType.VarType;
  PSQLTableRowVariantData(RowVariant)^.VTable := self;
  PSQLTableRowVariantData(RowVariant)^.VRow := -1; // follow fStepRow
{$endif NOVARIANTS}
end;

function TSQLTable.FieldBuffer(FieldIndex: Integer): PUTF8Char;
begin
  if (self=nil) or (cardinal(FieldIndex)>=cardinal(fFieldCount)) then
    raise ESQLTableException.CreateUTF8('%.FieldBuffer(%): invalid index',
      [self,FieldIndex]);
  if (fStepRow=0) or (fStepRow>fRowCount) then
    raise ESQLTableException.CreateUTF8('%.FieldBuffer(%): no previous Step',
      [self,FieldIndex]);
  result := fResults[fStepRow*FieldCount+FieldIndex];
end;

function TSQLTable.FieldBuffer(const FieldName: RawUTF8): PUTF8Char;
var i: integer;
begin
  i := FieldIndex(FieldName);
  if i<0 then
    raise ESQLTableException.CreateUTF8('%.FieldBuffer(%): unknown field',
      [self,FieldName]);
  if (fStepRow=0) or (fStepRow>fRowCount) then
    raise ESQLTableException.CreateUTF8('%.FieldBuffer(%): no previous Step',
      [self,FieldName]);
  result := fResults[fStepRow*FieldCount+i];
end;

function TSQLTable.FieldAsInteger(FieldIndex: Integer): Int64;
begin
  SetInt64(FieldBuffer(FieldIndex),result);
end;

function TSQLTable.FieldAsInteger(const FieldName: RawUTF8): Int64;
begin
  SetInt64(FieldBuffer(FieldName),result);
end;

function TSQLTable.FieldAsFloat(FieldIndex: Integer): TSynExtended;
begin
  result := GetExtended(FieldBuffer(FieldIndex));
end;

function TSQLTable.FieldAsFloat(const FieldName: RawUTF8): TSynExtended;
begin
  result := GetExtended(FieldBuffer(FieldName));
end;

function TSQLTable.FieldAsRawUTF8(FieldIndex: Integer): RawUTF8;
var buf: PUTF8Char;
begin
  buf := FieldBuffer(FieldIndex);
  FastSetString(result,buf,StrLen(buf));
end;

function TSQLTable.FieldAsRawUTF8(const FieldName: RawUTF8): RawUTF8;
var buf: PUTF8Char;
begin
  buf := FieldBuffer(FieldName);
  FastSetString(result,buf,StrLen(buf));
end;

function TSQLTable.FieldAsString(FieldIndex: Integer): String;
var buf: PUTF8Char;
begin
  buf := FieldBuffer(FieldIndex);
  UTF8DecodeToString(buf,StrLen(buf),result);
end;

function TSQLTable.FieldAsString(const FieldName: RawUTF8): String;
var buf: PUTF8Char;
begin
  buf := FieldBuffer(FieldName);
  UTF8DecodeToString(buf,StrLen(buf),result);
end;

{$ifndef NOVARIANTS}
function TSQLTable.Field(FieldIndex: integer): variant;
begin
  if (self=nil) or (cardinal(FieldIndex)>=cardinal(fFieldCount)) then
    raise ESQLTableException.CreateUTF8('%.Field(%): invalid index',
      [self,FieldIndex]);
  if (fStepRow=0) or (fStepRow>fRowCount) then
    raise ESQLTableException.CreateUTF8('%.Field(%): no previous Step',
      [self,FieldIndex]);
  GetVariant(fStepRow,FieldIndex,result);
end;

function TSQLTable.Field(const FieldName: RawUTF8): variant;
var i: integer;
begin
  i := FieldIndex(FieldName);
  if i<0 then
    raise ESQLTableException.CreateUTF8('%.Field(%): unknown field',
      [self,FieldName]);
  result := Field(i);
end;
{$endif}

function TSQLTable.CalculateFieldLengthMean(var aResult: TIntegerDynArray;
  FromDisplay: boolean=false): integer;
procedure CalculateEnumerates(F: integer; P: PEnumType);
var R, i, n: integer;
    EnumCounts: array of integer; // slow GetCaption() will be called once
    U: PPUTF8Char;
begin
  if P=nil then
    exit; // no a true enumerate field
  // 1. count of every possible enumerated value into EnumCounts[]
  SetLength(EnumCounts,P^.MaxValue+1);
  U := @fResults[FieldCount+F]; // start reading after first Row (= Field Names)
  for R := 1 to fRowCount do begin
    n := GetInteger(U^);
    if n<=P^.MaxValue then
      // update count of every enumerated value
      inc(EnumCounts[n]) else
      // GetCaption(invalid index) displays first one
      inc(EnumCounts[0]);
    inc(U,FieldCount); // points to next row
  end;
  // 2. update aResult[F] with displayed caption text length
  n := 0;
  for i := 0 to P^.MaxValue do
    if EnumCounts[i]<>0 then
      inc(n,length(P^.GetCaption(i))*EnumCounts[i]);
  aResult[F] := n; // store displayed total length
end;
var R,F,n: integer;
    U: PPUTF8Char;
    Tot: cardinal;
begin
  SetLength(aResult,FieldCount);
  if FromDisplay and (length(fFieldLengthMean)=FieldCount) then begin
    MoveFast(fFieldLengthMean[0],aResult[0],FieldCount*SizeOf(integer));
    result := fFieldLengthMeanSum;
    exit;
  end;
  if fRowCount=0 then begin
    // no data: calculate field length from first row (i.e. Field Names)
    U := @fResults[0];
    for F := 0 to FieldCount-1 do begin
      inc(aResult[F],Utf8FirstLineToUnicodeLength(U^));  // count
      inc(U); // points to next value
    end;
    Tot := 1;
  end else begin
    if fFieldType=nil then
      InitFieldTypes;
    U := @fResults[FieldCount]; // start reading after first Row
    for R := 1 to fRowCount do // sum all lengths by field
      for F := 0 to FieldCount-1 do begin
        case fFieldType[F].ContentType of
        sftInteger, sftBlob, sftBlobCustom, sftUTF8Custom, sftRecord,
        sftRecordVersion, sftID, sftTID, sftSet, sftCurrency:
          inc(aResult[F],8);
        else inc(aResult[F],Utf8FirstLineToUnicodeLength(U^));
        end;
        inc(U); // points to next value
      end;
    if Assigned(fQueryTables) then begin
      // aResult[] must be recalculated from captions, if exists
      for F := 0 to FieldCount-1 do
      with fFieldType[F] do
        case ContentType of
        sftEnumerate:
          CalculateEnumerates(F,ContentTypeInfo);
        end;
    end;
    Tot := fRowCount;
  end;
  result := 0;
  for F := 0 to FieldCount-1 do begin
    n := cardinal(aResult[F]) div Tot; // Mean = total/count
    if n=0 then n := 1;  // none should be 0
    aResult[F] := n;
    inc(result,n); // fast calculate mean sum
  end;
end;

function TSQLTable.FieldLengthMean(Field: integer): cardinal;
begin
  if (self=nil) or (cardinal(Field)>=cardinal(FieldCount)) or (fResults=nil) then
    result := 0 else begin
    if fFieldLengthMean=nil then
      // if not already calculated, do it now
      fFieldLengthMeanSum := CalculateFieldLengthMean(fFieldLengthMean);
    result := fFieldLengthMean[Field];
  end;
end;

function TSQLTable.FieldLengthMeanSum: cardinal;
begin
  if self=nil then
    result := 0 else begin
    if fFieldLengthMean=nil then
      FieldLengthMean(0); // initialize fFieldLengthMean[] and fFieldLengthMeanSum
    result := fFieldLengthMeanSum;
  end;
end;

function TSQLTable.FieldLengthMax(Field: integer; NeverReturnsZero: boolean): cardinal;
var i: integer;
    len: cardinal;
    U: PPUTF8Char;
begin
  result := 0;
  if (self<>nil) and (cardinal(Field)<cardinal(FieldCount)) then begin
    if fFieldType=nil then
      InitFieldTypes;
    with fFieldType[Field] do
    if ContentSize>=0 then
      // return already computed value
      result := ContentSize else begin
      if (ContentTypeInfo<>nil) and (ContentType=sftEnumerate) then begin
        // compute maximum size from available captions
        for i := 0 to PEnumType(ContentTypeInfo)^.MaxValue do begin
          len := length(PEnumType(ContentTypeInfo)^.GetCaption(i));
          if len>result then
            result := len;
        end;
      end else begin
        // compute by reading all data rows
        U := @fResults[FieldCount+Field];
        for i := 1 to fRowCount do begin
          len := StrLen(U^);
          if len>result then
            result := len;
          inc(U,FieldCount);
        end;
      end;
      ContentSize := result;
    end;
  end;
  if (result=0) and NeverReturnsZero then
    result := 1; // minimal not null length
end;

function TSQLTable.FieldTable(Field: integer): TSQLRecordClass;
begin
  if (self=nil) or (cardinal(Field)>=cardinal(FieldCount)) or (fQueryTables=nil) then
    result := nil else begin
    if fFieldType=nil then
      InitFieldTypes;
    Field := fFieldType[Field].TableIndex;
    if Field<0 then
      result := nil else
      result := fQueryTables[Field];
  end;
end;

procedure TSQLTable.SetFieldLengthMean(const Lengths: array of cardinal);
var F: integer;
    n: cardinal;
begin
  if (self=nil) or (length(Lengths)<>FieldCount) then
    exit;
  if fFieldLengthMean=nil then // if not already calculated, allocate array
    SetLength(fFieldLengthMean,FieldCount);
  fFieldLengthMeanSum := 0;
  for F := 0 to FieldCount-1 do begin
    n := Lengths[F];
    if n=0 then n := 1;  // none should be 0
    fFieldLengthMean[F] := n;
    inc(fFieldLengthMeanSum,n); // fast calculate mean sum
  end;
end;

procedure TSQLTable.FieldLengthMeanIncrease(aField, aIncrease: integer);
begin
  if (self=nil) or (cardinal(aField)>=cardinal(FieldCount)) then
    exit; // avoid GPF
  if fFieldLengthMean=nil then
    FieldLengthMean(0); // initialize fFieldLengthMean[] and fFieldLengthMeanSum
  inc(fFieldLengthMean[aField],aIncrease);
  inc(fFieldLengthMeanSum,aIncrease);
end;

function TSQLTable.SearchValue(const UpperValue: RawUTF8;
  StartRow, FieldIndex: integer; Client: TObject; Lang: TSynSoundExPronunciation;
  UnicodeComparison: boolean): integer;
var U: PPUTF8Char;
    Kind: TSQLFieldType;
    Search: PAnsiChar;
    UpperUnicode: RawUnicode;
    UpperUnicodeLen: integer;
    info: PSQLTableFieldType;
    Val64: Int64;
    ValTimeLog: TTimelogBits absolute Val64;
    i,err: integer;
    EnumValue: RawUTF8;
    s: string;
    P: PShortString;
    EnumValues: set of 0..63;
    Soundex: TSynSoundEx;
    CL: TSQLRest absolute Client;
    tmp: array[0..23] of AnsiChar;
begin
  result := 0;
  if (self=nil) or (StartRow<=0) or (StartRow>fRowCount) or (UpperValue='') or
     (cardinal(FieldIndex)>=cardinal(FieldCount)) then
    exit;
  Search := pointer(UpperValue);
  if Search^='%' then begin
    inc(Search);
    if Search^='%' then begin
      inc(Search);
      if Search^='%' then begin
        inc(Search);
        Lang := sndxSpanish;
      end else
        Lang := sndxFrench;
    end else
      Lang := sndxEnglish;
  end;
  if ((Lang<>sndxNone) and not Soundex.Prepare(Search,Lang)) then
    exit;
  result := StartRow;
  Kind := FieldType(FieldIndex,info);
  U := @fResults[FieldCount*StartRow+FieldIndex];
  // search in one specified field value
  if (Kind=sftEnumerate) and (info.ContentTypeInfo<>nil) then begin
    // for enumerates: first search in all available values
    Int64(EnumValues) := 0;
    P := @PEnumType(info.ContentTypeInfo)^.NameList;
    for i := 0 to PEnumType(info.ContentTypeInfo)^.MaxValue do begin
      EnumValue := TrimLeftLowerCaseShort(P);
      GetCaptionFromPCharLen(pointer(EnumValue),s);
      StringToUTF8(s,EnumValue);
      if ((Lang<>sndxNone) and SoundEx.UTF8(pointer(EnumValue))) or
         ((Lang=sndxNone) and FindUTF8(pointer(EnumValue),Search)) then
        include(EnumValues,i);
      inc(PByte(P),ord(P^[0])+1);
    end;
    // then search directly from the INTEGER value
    if Int64(EnumValues)<>0 then
    while cardinal(result)<=cardinal(fRowCount) do begin
      i := GetInteger(U^,err);
      if (err=0) and (i in EnumValues) then
        exit; // we found a matching field
      inc(U,FieldCount); // ignore all other fields -> jump to next row data
      inc(Result);
    end;
    result := 0; // not found
    exit;
  end;
  // special cases: conversion from INTEGER to text before search
  if Kind in [sftTimeLog,sftModTime,sftCreateTime,sftUnixTime,sftUnixMSTime] then
    while cardinal(result)<=cardinal(fRowCount) do begin
      SetInt64(U^,Val64);
      if Val64<>0 then begin
        case Kind of
        sftUnixTime:
          ValTimeLog.FromUnixTime(Val64);
        sftUnixMSTime: // seconds resolution is enough for value search
          ValTimeLog.FromUnixMSTime(Val64);
        end;
        tmp[ValTimeLog.Text(tmp,true,' ')] := #0;
        if FindAnsi(tmp,Search) then
          exit;
      end;
      inc(U,FieldCount); // ignore all other fields -> jump to next row data
      inc(Result);
    end
  else
  if ((Kind in [sftRecord,sftID,sftTID,sftSessionUserID]) and
     (Client<>nil) and Client.InheritsFrom(TSQLRest) and (CL.Model<>nil)) then
    while cardinal(result)<=cardinal(fRowCount) do begin
      SetInt64(U^,Val64);
      if Val64<>0 then begin
        if Kind=sftRecord then
          EnumValue := RecordRef(Val64).Text(CL.Model) else
          EnumValue := U^; // sftID/sftTID -> display ID number -> no sounded
        if Lang=sndxNone then begin
          if FindUTF8(pointer(EnumValue),Search) then exit;
        end else
          if SoundEx.UTF8(pointer(EnumValue)) then exit;
      end;
      inc(U,FieldCount); // ignore all other fields -> jump to next row data
      inc(Result);
    end
  else
  // by default, search as UTF-8 encoded text
  if Lang<>sndxNone then begin
    while cardinal(result)<=cardinal(fRowCount) do
    if SoundEx.UTF8(U^) then
      exit else begin
      inc(U,FieldCount); // ignore all other fields -> jump to next row data
      inc(Result);
    end;
  end else
  if UnicodeComparison then begin
    // slowest but always accurate Unicode comparison
    UpperUnicode := UTF8DecodeToRawUnicodeUI(RawUTF8(Search),@UpperUnicodeLen);
    while cardinal(result)<=cardinal(fRowCount) do
    if FindUnicode(pointer(Utf8DecodeToRawUnicode(U^,0)),
       pointer(UpperUnicode),UpperUnicodeLen) then
      exit else begin
      inc(U,FieldCount); // ignore all other fields -> jump to next row data
      inc(Result);
    end
  end else
    // default fast Win1252 search
    while cardinal(result)<=cardinal(fRowCount) do
    if FindUTF8(U^,Search) then
      exit else begin
      inc(U,FieldCount); // ignore all other fields -> jump to next row data
      inc(Result);
    end;
  result := 0; // not found
end;

function TSQLTable.SearchValue(const UpperValue: RawUTF8;
  StartRow: integer; FieldIndex: PInteger; Client: TObject; Lang: TSynSoundExPronunciation;
  UnicodeComparison: boolean): integer;
var F, Row: integer;
begin
  result := 0;
  if (self=nil) or (StartRow<=0) or (StartRow>fRowCount) or (UpperValue='') then
    exit;
  // search in all fields values
  for F := 0 to FieldCount-1 do begin
    Row := SearchValue(UpperValue,StartRow,F,Client,Lang,UnicodeComparison);
    if (Row<>0) and ((result=0) or (Row<result)) then begin
      if FieldIndex<>nil then
        FieldIndex^ := F;
      result := Row;
    end;
  end;
end;

function TSQLTable.SearchFieldEquals(const Value: RawUTF8; FieldIndex, StartRow: integer;
  CaseSensitive: boolean): integer;
begin
  result := SearchFieldEquals(pointer(Value),FieldIndex,StartRow,CaseSensitive);
end;

function TSQLTable.SearchFieldEquals(Value: PUTF8Char; FieldIndex, StartRow: integer;
  CaseSensitive: boolean): integer;
var U: PPUTF8Char;
begin
  if (self<>nil) and (Value<>nil) and (cardinal(FieldIndex)<cardinal(fFieldCount)) then begin
    U := @fResults[FieldCount*StartRow+FieldIndex];
    if CaseSensitive then
      for result := StartRow to fRowCount do
        if StrComp(U^,Value)=0 then
          exit else
          inc(U,FieldCount) else
      for result := StartRow to fRowCount do
        if UTF8IComp(U^,Value)=0 then
          exit else
          inc(U,FieldCount);
  end;
  result := 0;
end;

function TSQLTable.SearchFieldIdemPChar(const Value: RawUTF8; FieldIndex, StartRow: integer): integer;
var U: PPUTF8Char;
    up: RawUTF8;
begin
  if (self<>nil) and (Value<>'') and (cardinal(FieldIndex)<cardinal(fFieldCount)) then begin
    UpperCaseCopy(Value,up);
    U := @fResults[FieldCount*StartRow+FieldIndex];
    for result := StartRow to fRowCount do
      if IdemPChar(U^,pointer(up)) then
        exit else
        inc(U,FieldCount);
  end;
  result := 0;
end;

{$ifndef NOVARIANTS}

function TSQLTable.GetVariant(Row, Field: integer): Variant;
begin
  GetVariant(Row,Field,result);
end;

procedure TSQLTable.GetVariant(Row,Field: integer; var result: variant);
var aType: TSQLFieldType;
    info: PSQLTableFieldType;
    U: PUTF8Char;
begin
  if Row=0 then // Field Name
    RawUTF8ToVariant(GetU(0,Field),result) else begin
    aType := FieldType(Field,info);
    U := Get(Row,Field);
    ValueVarToVariant(U,StrLen(U),aType,TVarData(result),true,info.ContentTypeInfo);
  end;
end;

function TSQLTable.GetValue(const aLookupFieldName,aLookupValue,aValueFieldName: RawUTF8): variant;
var f,r,v: integer;
begin
  SetVariantNull(result);
  f := FieldIndex(aLookupFieldName);
  v := FieldIndex(aValueFieldName);
  if (f<0) or (v<0) then
    exit;
  r := SearchFieldEquals(aLookupValue,f);
  if r>0 then
    GetVariant(r,v,Result);
end;

{$endif NOVARIANTS}

function TSQLTable.ExpandAsString(Row, Field: integer; Client: TObject;
  out Text: string; const CustomFormat: string): TSQLFieldType;
var info: PSQLTableFieldType;
    err: integer;
    Value: Int64;
    ValueTimeLog: TTimeLogBits absolute Value;
    ValueDateTime: TDateTime;
    Ref: RecordRef absolute Value;
label IsDateTime;
begin // Text was already forced to '' because was defined as "out" parameter
  if Row=0 then begin // Field Name
    result := sftUnknown;
    Text := GetCaption(0,Field);
    exit;
  end;
  result := FieldType(Field,info);
  case result of
  sftDateTime, sftDateTimeMS: begin
   Value := Iso8601ToTimeLogPUTF8Char(Get(Row,Field),0);
IsDateTime:
    if Value<>0 then begin
      {$ifndef LVCL}
      if CustomFormat<>'' then begin
        Text := FormatDateTime(CustomFormat,ValueTimeLog.ToDateTime);
        if Text<>CustomFormat then
          exit; // valid conversion
      end;
      {$endif LVCL}
      Text := ValueTimeLog.i18nText;
      exit;
    end;
  end;
  sftBlob:
    Text := '???';
  sftFloat:
    if CustomFormat<>'' then
    try
      if pos('%',CustomFormat)>0 then
        Text := Format(CustomFormat,[GetExtended(Get(Row,Field))])
        {$ifndef LVCL} else
        Text := FormatFloat(CustomFormat,GetExtended(Get(Row,Field)))
        {$endif LVCL};
      exit;
    except
      on {$ifdef LVCL}Exception{$else}EConvertError{$endif} do
        Text := '';
    end;
  sftCurrency:
    if CustomFormat<>'' then
    try
      if pos('%',CustomFormat)>0 then
        Text := Format(CustomFormat,[StrToCurrency(Get(Row,Field))])
        {$ifndef LVCL} else
        Text := FormatCurr(CustomFormat,StrToCurrency(Get(Row,Field)))
        {$endif};
      exit;
    except
      on {$ifdef LVCL}Exception{$else}EConvertError{$endif} do
        Text := '';
    end;
  sftEnumerate, sftSet, sftRecord, sftID, sftTID, sftRecordVersion, sftSessionUserID,
  sftTimeLog, sftModTime, sftCreateTime, sftUnixTime, sftUnixMSTime: begin
    Value := GetInt64(Get(Row,Field),err);
    if err<>0 then
      // not an integer -> to be displayed as sftUTF8Text
      result := sftUTF8Text else
    case result of
      sftEnumerate:
        if info.ContentTypeInfo<>nil then begin
          Text := PEnumType(info.ContentTypeInfo)^.GetCaption(Value);
          exit;
        end;
      sftTimeLog, sftModTime, sftCreateTime:
        goto IsDateTime;
      sftUnixTime: begin
        ValueTimeLog.FromUnixTime(Value);
        goto IsDateTime;
      end;
      sftUnixMSTime:
        if Value<>0 then begin
          ValueDateTime := UnixMSTimeToDateTime(Value);
          {$ifndef LVCL}
          if CustomFormat<>'' then begin
            Text := FormatDateTime(CustomFormat,ValueDateTime);
            if Text<>CustomFormat then
              exit; // valid conversion
          end;
          {$endif LVCL}
          Text := DateTimeToi18n(ValueDateTime);
          exit;
        end;
{      sftID, sftTID, sftSet, sftRecordVersion:
        result := sftUTF8Text; // will display INTEGER field as number }
      sftRecord:
        if (Value<>0) and
           (Client<>nil) and Client.InheritsFrom(TSQLRest) then // 'TableName ID'
          Text := {$ifdef UNICODE}Ansi7ToString{$endif}(Ref.Text(TSQLRest(Client).Model)) else
          result := sftUTF8Text; // display ID number if no table model
    end;
  end;
  end;
  if Text='' then
    // returns the value as text by default
    Text := GetString(Row,Field);
end;

function TSQLTable.ExpandAsSynUnicode(Row,Field: integer; Client: TObject; out Text: SynUnicode): TSQLFieldType;
var s: string;
begin
  result := ExpandAsString(Row,Field,Client,s);
  StringToSynUnicode(s,Text);
end;

function TSQLTable.GetTimeLog(Row, Field: integer; Expanded: boolean;
  FirstTimeChar: AnsiChar): RawUTF8;
var Value: TTimeLogBits;
begin
  SetInt64(Get(Row,Field),Value.Value);
  result := Value.Text(Expanded,FirstTimeChar);
end;


{$ifndef NOVARIANTS}

{ TSQLTableRowVariant }

function TSQLTableRowVariant.IntGet(var Dest: TVarData;
  const Instance: TVarData; Name: PAnsiChar; NameLen: PtrInt): boolean;
var r,f: integer;
    rv: TSQLTableRowVariantData absolute Instance;
begin
  if rv.VTable=nil then
    raise ESQLTableException.CreateUTF8('Invalid %.% call',[self,Name]);
  r := rv.VRow;
  if r<0 then begin
    r := rv.VTable.fStepRow;
    if (r=0) or (r>rv.VTable.fRowCount) then
      raise ESQLTableException.CreateUTF8('%.%: no previous Step',[self,Name]);
  end;
  f := rv.VTable.FieldIndex(PUTF8Char(Name));
  result := f>=0;
  if f>=0 then
    rv.VTable.GetVariant(r,f,Variant(Dest));
end;

procedure TSQLTableRowVariant.Cast(var Dest: TVarData; const Source: TVarData);
begin
  CastTo(Dest,Source,VarType);
end;

procedure TSQLTableRowVariant.CastTo(var Dest: TVarData;
  const Source: TVarData; const AVarType: TVarType);
var r: integer;
    tmp: variant; // use a temporary TDocVariant for the conversion
begin
  if AVarType=VarType then begin
    RaiseCastError;
  end else begin
    if Source.VType<>VarType then
      RaiseCastError;
    r := TSQLTableRowVariantData(Source).VRow;
    if r<0 then
      r := TSQLTableRowVariantData(Source).VTable.fStepRow;
    TSQLTableRowVariantData(Source).VTable.ToDocVariant(r,tmp);
    if AVarType=DocVariantVType then begin
      VarClear(variant(Dest));
      TDocVariantData(Dest) := TDocVariantData(tmp);
    end else
      RawUTF8ToVariant(VariantSaveJSON(tmp),Dest,AVarType);
  end;
end;

procedure TSQLTableRowVariant.ToJSON(W: TTextWriter; const Value: variant;
  Escape: TTextWriterKind);
var r: integer;
    tmp: variant; // write row via a TDocVariant
begin
  r := TSQLTableRowVariantData(Value).VRow;
  if r<0 then
    r := TSQLTableRowVariantData(Value).VTable.fStepRow;
  TSQLTableRowVariantData(Value).VTable.ToDocVariant(r,tmp);
  W.AddVariant(tmp,Escape);
end;


{ TObjectVariant }

var
  ObjectVariantType: TCustomVariantType;

class procedure TObjectVariant.New(var V: Variant; Obj: TObject);
begin
  VarClear(V);
  if ObjectVariantType=nil then
    ObjectVariantType := SynRegisterCustomVariantType(TObjectVariant);
  TVarData(V).VType := ObjectVariantType.VarType;
  TVarData(V).VPointer := Obj;
end;

procedure TObjectVariant.ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind);
begin
  W.WriteObject(TVarData(Value).VPointer);
end;

const
  _INTGETOBJECTPROPINFO_ID = pointer(1);

function IntGetObjectPropInfo(o: TObject; Name: pointer; NameLen: PtrInt): PPropInfo;
begin
  if (o=nil) or (Name=nil) then
    raise EObjectVariant.CreateUTF8('Invalid TObjectVariant.% call',[Name]);
  result := ClassFieldPropWithParentsFromUTF8(PPointer(o)^,Name,NameLen);
  if (result=nil) and IsRowID(Name,NameLen) and o.InheritsFrom(TSQLRecord) then
    result := _INTGETOBJECTPROPINFO_ID;
end;

function TObjectVariant.IntGet(var Dest: TVarData; const Instance: TVarData;
  Name: PAnsiChar; NameLen: PtrInt): boolean;
var info: PPropInfo;
    o: TObject;
begin
  o := Instance.VPointer;
  info := IntGetObjectPropInfo(o,Name,NameLen);
  result := info<>nil;
  if info<>nil then
    if info=_INTGETOBJECTPROPINFO_ID then
      variant(Dest) := TSQLRecord(o).IDValue else
    if info^.PropType^.Kind=tkClass then
      New(Variant(Dest),info^.GetObjProp(o)) else
      info^.GetVariant(o,Variant(Dest));
end;

function TObjectVariant.IntSet(const Instance, Value: TVarData;
  Name: PAnsiChar; NameLen: PtrInt): boolean;
var info: PPropInfo;
    o: TObject;
begin
  o := Instance.VPointer;
  info := IntGetObjectPropInfo(o,Name,NameLen);
  if info=nil then
    result := false else begin
    if info=_INTGETOBJECTPROPINFO_ID then
      VariantToInt64(Variant(Value),PInt64(@TSQLRecord(o).fID)^) else
      info^.SetFromVariant(o,Variant(Value));
    result := true;
  end;
end;

{$endif NOVARIANTS}


procedure Base64MagicToBlob(Base64: PUTF8Char; var result: RawUTF8);
begin
  // do not escape the result: returns e.g. X'53514C697465'
  result := TSQLRawBlobToBlob(Base64ToBin(PAnsiChar(Base64),StrLen(Base64)));
end;


{ TJSONObjectDecoder }

const
  EndOfJSONField = [',',']','}',':'];

procedure GetJSONArrayOrObject(P: PUTF8Char; out PDest: PUTF8Char;
  EndOfObject: PUTF8Char; var result: RawUTF8);
var Beg: PUTF8Char;
begin
  PDest := nil;
  Beg := P;
  P := GotoNextJSONObjectOrArray(P); // quick go to end of array of object
  if P=nil then begin
    result := '';
    exit;
  end;
  if EndOfObject<>nil then
    EndOfObject^ := P^;
  PDest := P+1;
  FastSetString(result,Beg,P-Beg);
end;

procedure GetJSONArrayOrObjectAsQuotedStr(P: PUTF8Char; out PDest: PUTF8Char;
  EndOfObject: PUTF8Char; var result: RawUTF8);
var Beg: PUTF8Char;
begin
  result := '';
  PDest := nil;
  Beg := P;
  P := GotoNextJSONObjectOrArray(P); // quick go to end of array of object
  if P=nil then
    exit;
  if EndOfObject<>nil then
    EndOfObject^ := P^;
  P^ := #0; // so Beg will be a valid ASCIIZ string
  PDest := P+1;
  QuotedStr(Beg,'''',result);
end;

procedure TJSONObjectDecoder.Decode(var P: PUTF8Char; const Fields: TRawUTF8DynArray;
  Params: TJSONObjectDecoderParams; const RowID: TID; ReplaceRowIDWithID: boolean);
var EndOfObject: AnsiChar;

  procedure GetSQLValue(ndx: PtrInt);
  var wasString: boolean;
      res: PUTF8Char;
      resLen, c: integer;
  begin
    res := P;
    if res=nil then begin
      FieldTypeApproximation[ndx] := ftaNull;
      FieldValues[ndx] := NULL_STR_VAR;
      exit;
    end;
    while res^ in [#1..' '] do inc(res);
    if (PInteger(res)^=NULL_LOW) and
       (res[4] in [#0,#9,#10,#13,' ',',','}',']'])  then begin
      /// GetJSONField('null') returns '' -> check here to make a diff with '""'
      FieldTypeApproximation[ndx] := ftaNull;
      FieldValues[ndx] := NULL_STR_VAR;
      inc(res,4);
      while res^ in [#1..' '] do inc(res);
      if res^=#0 then
        P := nil else begin
        EndOfObject := res^;
        res^ := #0;
        P := res+1;
      end;
    end else begin
      // first check if nested object or array
      case res^ of // handle JSON {object} or [array] in P
      '{': begin // will work e.g. for custom variant types
        FieldTypeApproximation[ndx] := ftaObject;
        if params=pNonQuoted then
          GetJSONArrayOrObject(res,P,@EndOfObject,FieldValues[ndx]) else
          GetJSONArrayOrObjectAsQuotedStr(res,P,@EndOfObject,FieldValues[ndx]);
      end;
      '[': begin // will work e.g. for custom variant types
        FieldTypeApproximation[ndx] := ftaArray;
        if params=pNonQuoted then
          GetJSONArrayOrObject(res,P,@EndOfObject,FieldValues[ndx]) else
          GetJSONArrayOrObjectAsQuotedStr(res,P,@EndOfObject,FieldValues[ndx]);
      end;
      else begin
        // handle JSON string, number or false/true in P
        res := GetJSONField(res,P,@wasString,@EndOfObject,@resLen);
        if wasString then begin
          c := PInteger(res)^ and $00ffffff;
          if c=JSON_BASE64_MAGIC then begin
            FieldTypeApproximation[ndx] := ftaBlob;
            case Params of
            pInlined: // untouched -> recognized as BLOB in SQLParamContent()
              QuotedStr(res,'''',FieldValues[ndx]);
{            pQuoted: // \uFFF0base64encodedbinary -> 'X''hexaencodedbinary'''
              // if not inlined, it can be used directly in INSERT/UPDATE statements
              Base64MagicToBlob(res+3,FieldValues[ndx]);
            pNonQuoted:}
            else // returned directly as RawByteString
              Base64ToBin(PAnsiChar(res)+3,resLen-3,RawByteString(FieldValues[ndx]));
            end;
          end else begin
            if c=JSON_SQLDATE_MAGIC then begin
              FieldTypeApproximation[ndx] := ftaDate;
              inc(res,3); // ignore \uFFF1 magic marker
            end else
              FieldTypeApproximation[ndx] := ftaString;
            // regular string content
            if Params=pNonQuoted then
              // returned directly as RawUTF8
              FastSetString(FieldValues[ndx],res,resLen) else
              { escape SQL strings, cf. the official SQLite3 documentation:
                "A string is formed by enclosing the string in single quotes (').
                 A single quote within the string can be encoded by putting two
                 single quotes in a row - as in Pascal." }
              QuotedStr(res,'''',FieldValues[ndx]);
          end;
        end else
          if res=nil then begin
            FieldTypeApproximation[ndx] := ftaNull;
            FieldValues[ndx] := NULL_STR_VAR;
          end else // avoid GPF, but will return invalid SQL
          // non string params (numeric or false/true) are passed untouched
          if PInteger(res)^=FALSE_LOW then begin
            FieldValues[ndx] := SmallUInt32UTF8[0];
            FieldTypeApproximation[ndx] := ftaBoolean;
          end else
          if PInteger(res)^=TRUE_LOW then begin
            FieldValues[ndx] := SmallUInt32UTF8[1];
            FieldTypeApproximation[ndx] := ftaBoolean;
          end else begin
            FastSetString(FieldValues[ndx],res,resLen);
            FieldTypeApproximation[ndx] := ftaNumber;
          end;
      end;
      end;
    end;
  end;

var FN: PUTF8Char;
    F, FNlen: integer;
    FieldIsRowID: Boolean;
begin
  FieldCount := 0;
  DecodedRowID := 0;
  DecodedFieldTypesToUnnest := nil;
  FillCharFast(FieldTypeApproximation,SizeOf(FieldTypeApproximation),ord(ftaNumber{TID}));
  InlinedParams := Params;
  if pointer(Fields)=nil then begin
    // get "COL1"="VAL1" pairs, stopping at '}' or ']'
    DecodedFieldNames := @FieldNames;
    if RowID>0 then begin // insert explicit RowID
      if ReplaceRowIDWithID then
        FieldNames[0] := 'ID' else
        FieldNames[0] := 'RowID';
      Int64ToUtf8(RowID,FieldValues[0]);
      FieldCount := 1;
      DecodedRowID := RowID;
    end;
    repeat
      if P=nil then
        break;
      FN := GetJSONPropName(P,@FNlen);
      if (FN=nil) or (P=nil) then
        break; // invalid JSON field name
      FieldIsRowID := IsRowId(FN);
      if FieldIsRowID then
        if RowID>0 then begin
          GetJSONField(P,P,nil,@EndOfObject); // ignore this if explicit RowID
          if EndOfObject in [#0,'}',']'] then
            break else continue;
        end else
        if ReplaceRowIDWithID then begin
          FN := 'ID';
          FNlen := 2;
        end;
      FastSetString(FieldNames[FieldCount],FN,FNlen);
      GetSQLValue(FieldCount); // update EndOfObject
      if FieldIsRowID then
        SetID(FieldValues[FieldCount],DecodedRowID);
      inc(FieldCount);
      if FieldCount=MAX_SQLFIELDS then
        raise EParsingException.Create('Too many inlines in TJSONObjectDecoder');
    until EndOfObject in [#0,'}',']'];
  end else begin
    // get "VAL1","VAL2"...
    if P=nil then
      exit;
    if RowID>0 then
      raise EParsingException.Create('TJSONObjectDecoder(expanded) won''t handle RowID');
    if length(Fields)>MAX_SQLFIELDS then
      raise EParsingException.Create('Too many inlines in TJSONObjectDecoder');
    DecodedFieldNames := pointer(Fields);
    FieldCount := length(Fields);
    for F := 0 to FieldCount-1 do
      GetSQLValue(F); // update EndOfObject
  end;
end;

procedure TJSONObjectDecoder.Decode(const JSON: RawUTF8; const Fields: TRawUTF8DynArray;
  Params: TJSONObjectDecoderParams; const RowID: TID; ReplaceRowIDWithID: Boolean);
var tmp: TSynTempBuffer;
    P: PUTF8Char;
begin
  tmp.Init(JSON);
  try
    P := tmp.buf;
    if P<>nil then
      while P^ in [#1..' ','{','['] do inc(P);
    Decode(P,Fields,Params,RowID,ReplaceRowIDWithID);
  finally
    tmp.Done;
  end;
end;

function TJSONObjectDecoder.SameFieldNames(const Fields: TRawUTF8DynArray): boolean;
var i: integer;
begin
  result := false;
  if length(Fields)<>FieldCount then
    exit;
  for i := 0 to FieldCount-1 do
    if not IdemPropNameU(Fields[i],FieldNames[i]) then
      exit;
  result := true;
end;

procedure TJSONObjectDecoder.AssignFieldNamesTo(var Fields: TRawUTF8DynArray);
var i: integer;
begin
  SetLength(Fields,FieldCount);
  for i := 0 to FieldCount-1 do
    Fields[i] := FieldNames[i];
end;

{$ifdef ISDELPHI20062007}
  {$WARNINGS OFF} // circument Delphi 2007 false positive warning
{$endif}

const
  PG_FT: array[TSQLDBFieldType] of string[9] = (
    'int4', 'text', 'int8', 'float8', 'numeric', 'timestamp', 'text', 'bytea');

function TJSONObjectDecoder.EncodeAsSQLPrepared(const TableName: RawUTF8;
  Occasion: TSQLOccasion; const UpdateIDFieldName: RawUTF8;
  BatchOptions: TSQLRestBatchOptions): RawUTF8;
var F: integer;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    case Occasion of
    soUpdate: begin
      if FieldCount=0 then
        raise EORMException.Create('Invalid EncodeAsSQLPrepared(0)');
      W.AddShort('update ');
      W.AddString(TableName);
      if DecodedFieldTypesToUnnest<>nil then begin
        // PostgreSQL bulk update via nested array binding
        W.AddShort(' as t set ');
        for F := 0 to FieldCount-1 do begin
          W.AddString(DecodedFieldNames^[F]);
          W.AddShort('=v.');
          W.AddString(DecodedFieldNames^[F]);
          W.Add(',');
        end;
        W.CancelLastComma;
        W.AddShort(' from ( select');
        for F := 0 to FieldCount-1 do begin
          W.AddShort(' unnest(?::');
          W.AddShort(PG_FT[DecodedFieldTypesToUnnest^[F]]);
          W.AddShort('[]),');
        end;
        W.AddShort(' unnest(?::int8[]) ) as v('); // last param is ID
        for F := 0 to FieldCount-1 do begin
          W.AddString(DecodedFieldNames^[F]);
          W.Add(',');
        end;
        W.AddString(UpdateIDFieldName);
        W.AddShort(') where t.');
        W.AddString(UpdateIDFieldName);
        W.AddShort('=v.');
        W.AddString(UpdateIDFieldName);
      end else begin
        // regular UPDATE statement
        W.AddShort(' set ');
        for F := 0 to FieldCount-1 do begin // append 'COL1=?,COL2=?'
          W.AddString(DecodedFieldNames^[F]);
          W.AddShort('=?,');
        end;
        W.CancelLastComma;
        W.AddShort(' where ');
        W.AddString(UpdateIDFieldName);
        W.Add('=','?'); // last param is ID
      end;
    end;
    soInsert: begin
      if boInsertOrIgnore in BatchOptions then
        W.AddShort('insert or ignore into ') else
      if boInsertOrReplace in BatchOptions then
        W.AddShort('insert or replace into ') else
        W.AddShort('insert into ');
      W.AddString(TableName);
      if FieldCount=0 then
        W.AddShort(' default values') else begin
        W.Add(' ','(');
        for F := 0 to FieldCount-1 do begin // append 'COL1,COL2'
          W.AddString(DecodedFieldNames^[F]);
          W.Add(',');
        end;
        W.CancelLastComma;
        W.AddShort(') values (');
        if DecodedFieldTypesToUnnest<>nil then
          // PostgreSQL bulk insert via nested array binding
          for F := 0 to FieldCount-1 do begin
            W.AddShort('unnest(?::');
            W.AddShort(PG_FT[DecodedFieldTypesToUnnest^[F]]);
            W.AddShort('[]),');
          end else
          // regular INSERT statement
          W.AddStrings('?,',FieldCount);
        W.CancelLastComma;
        W.Add(')');
      end;
    end;
    else
      raise EORMException.CreateUTF8('Unexpected EncodeAsSQLPrepared(%)',[ord(Occasion)]);
    end;
    W.SetText(result);
  finally
    W.Free;
  end;
end;

{$ifdef ISDELPHI20062007}
  {$WARNINGS ON}
{$endif}

function TJSONObjectDecoder.EncodeAsSQL(Update: boolean): RawUTF8;
var F: integer;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
  procedure AddValue;
  begin
    if InlinedParams=pInlined then
      W.AddShort(':(');
    W.AddString(FieldValues[F]);
    if InlinedParams=pInlined then
      W.AddShort('):,') else
      W.Add(',');
  end;
begin
  result := '';
  if FieldCount=0 then
    exit;
  W := TTextWriter.CreateOwnedStream(temp);
  try
    if Update then begin
      for F := 0 to FieldCount-1 do // append 'COL1=...,COL2=...'
      if not IsRowID(pointer(DecodedFieldNames^[F])) then begin
        W.AddString(DecodedFieldNames^[F]);
        W.Add('=');
        AddValue;
      end;
      W.CancelLastComma;
    end else begin // returns ' (COL1,COL2) VALUES ('VAL1',VAL2)'
      W.Add(' ','(');
      for F := 0 to FieldCount-1 do begin // append 'COL1,COL2'
        W.AddString(DecodedFieldNames^[F]);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.AddShort(') VALUES (');
      for F := 0 to FieldCount-1 do
        AddValue;
      W.CancelLastComma;
      W.Add(')');
    end;
    W.SetText(result);
  finally
    W.Free;
  end;
end;

procedure TJSONObjectDecoder.EncodeAsJSON(out result: RawUTF8);
var F: integer;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  if FieldCount=0 then
    exit;
  W := TTextWriter.CreateOwnedStream(temp);
  try
    W.Add('{');
    for F := 0 to FieldCount-1 do begin
      W.AddFieldName(DecodedFieldNames^[F]);
      if FieldTypeApproximation[F] in [ftaBlob,ftaDate,ftaString] then
        if InlinedParams=pNonQuoted then
          W.AddJSONString(FieldValues[F]) else
          W.AddQuotedStringAsJSON(FieldValues[F]) else
        W.AddString(FieldValues[F]);
      W.Add(',');
    end;
    W.CancelLastComma;
    W.Add('}');
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TJSONObjectDecoder.FindFieldName(const FieldName: RawUTF8): integer;
begin
  for result := 0 to FieldCount-1 do
    if IdemPropNameU(FieldNames[result],FieldName) then
      exit;
  result := -1;
end;

procedure TJSONObjectDecoder.AddFieldValue(const FieldName,FieldValue: RawUTF8;
  FieldType: TJSONObjectDecoderFieldType);
begin
  if FieldCount=MAX_SQLFIELDS then
    raise EParsingException.CreateUTF8('Too many fields for TJSONObjectDecoder.AddField(%) max=%',
      [FieldName,MAX_SQLFIELDS]);
  FieldNames[FieldCount] := FieldName;
  FieldValues[FieldCount] := FieldValue;
  FieldTypeApproximation[FieldCount] := FieldType;
  inc(FieldCount);
end;

const
  FROMINLINED: array[boolean] of TJSONObjectDecoderParams = (
    pQuoted, pInlined);

function GetJSONObjectAsSQL(var P: PUTF8Char; const Fields: TRawUTF8DynArray;
  Update, InlinedParams: boolean; RowID: TID; ReplaceRowIDWithID: Boolean): RawUTF8;
var Decoder: TJSONObjectDecoder;
begin
  Decoder.Decode(P,Fields,FROMINLINED[InlinedParams],RowID,ReplaceRowIDWithID);
  result := Decoder.EncodeAsSQL(Update);
end;

function GetJSONObjectAsSQL(const JSON: RawUTF8; Update, InlinedParams: boolean;
 RowID: TID; ReplaceRowIDWithID: Boolean): RawUTF8;
var Decoder: TJSONObjectDecoder;
begin
  Decoder.Decode(JSON,nil,FROMINLINED[InlinedParams],RowID,ReplaceRowIDWithID);
  result := Decoder.EncodeAsSQL(Update);
end;

function Expect(var P: PUTF8Char; Value: PUTF8Char; ValueLen: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}
var i: PtrInt;
begin // ValueLen is at least 8 bytes long
  result := false;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if PPtrInt(P)^=PPtrInt(Value)^ then begin
    for i := SizeOf(PtrInt) to ValueLen - 1 do
      if P[i]<>Value[i] then
        exit;
    inc(P,ValueLen);
    result := true;
  end;
end;

function GetJSONIntegerVar(var P: PUTF8Char): PtrInt;
var c: PtrUInt;
begin
  while (P^<=' ') and (P^<>#0) do inc(P);
  c := byte(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break;
      result := result*10+PtrInt(c);
      inc(P);
    until false;
  end;
end;

function GetJSONInt64Var(var P: PUTF8Char): Int64;
var c: PtrUInt;
begin
  while (P^<=' ') and (P^<>#0) do inc(P);
  c := byte(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break;
      result := result*10+Int64(c);
      inc(P);
    until false;
  end;
end;

const
  FIELDCOUNT_PATTERN: PUTF8Char = '{"fieldCount":'; // 14 chars
  ROWCOUNT_PATTERN: PUTF8Char =   ',"rowCount":';   // 12 chars
  VALUES_PATTERN: PUTF8Char =     ',"values":[';    // 11 chars

function UnJSONFirstField(var P: PUTF8Char): RawUTF8;
// expand=true: [ {"col1":val11} ] -> val11
// expand=false: { "fieldCount":1,"values":["col1",val11] } -> vall11
begin
  result := '';
  if P=nil then exit;
  if Expect(P,FIELDCOUNT_PATTERN,14) then begin
    // not expanded format
    if GetJSONIntegerVar(P)<>1 then
      exit; // wrong field count
    while P^<>'[' do if P^=#0 then exit else inc(P); // go to ["col1"
    inc(P); // go to "col1"
  end else begin
    // expanded format
    while P^<>'[' do if P^=#0 then exit else inc(P); // need an array of objects
    repeat inc(P); if P^=#0 then exit; until P^='{'; // go to object begining
  end;
  if GetJSONPropName(P)<>nil then // ignore field name
    result := GetJSONField(P,P); // get field value
end;

function IsNotAjaxJSON(P: PUTF8Char): Boolean;
begin
  result := Expect(P,FIELDCOUNT_PATTERN,14);
end;

function NotExpandedBufferRowCountPos(P,PEnd: PUTF8Char): PUTF8Char;
var i: integer;
begin
  result := nil;
  if (PEnd<>nil) and (PEnd-P>24) then
    for i := 1 to 24 do // search for "rowCount": at the end of the JSON buffer
    case PEnd[-i] of
    ']',',':
      exit;
    ':': begin
      if CompareMemFixed(PEnd-i-11,pointer(ROWCOUNT_PATTERN),11) then
        result := PEnd-i+1;
      exit;
    end;
    end;
end;

function IsNotExpandedBuffer(var P: PUTF8Char; PEnd: PUTF8Char;
  var FieldCount,RowCount: integer): boolean;
  procedure GetRowCountNotExpanded(P: PUTF8Char);
  begin
    RowCount := 0;
    repeat
      // get a row
      P := GotoNextJSONItem(P,FieldCount);
      if P=nil then exit; // unexpected end
      inc(RowCount);
    until P[-1]=']'; // end of array
    if P^ in ['}',','] then begin // expected formated JSON stream
      if RowCount>0 then
        dec(RowCount); // first Row = field names -> data in rows 1..RowCount
    end else
      RowCount := -1; // bad format -> no data
  end;
var RowCountPos: PUTF8Char;
begin
  if not Expect(P,FIELDCOUNT_PATTERN,14) then begin
    result := false;
    exit;
  end;
  FieldCount := GetJSONIntegerVar(P);
  if Expect(P,ROWCOUNT_PATTERN,12) then
    RowCount := GetJSONIntegerVar(P) else begin
    RowCountPos := NotExpandedBufferRowCountPos(P,PEnd);
    if RowCountPos=nil then
      RowCount := -1 else // mark "rowCount":.. not available
      RowCount := GetCardinal(RowCountPos);
  end;
  result := (FieldCount<>0) and Expect(P,VALUES_PATTERN,11);
  if result and (RowCount<0) then
    GetRowCountNotExpanded(P); // returns RowCount=-1 if P^ is invalid
end;

function StartWithQuotedID(P: PUTF8Char; out ID: TID): boolean;
begin
  if PCardinal(P)^ and $ffffdfdf=
      ord('I')+ord('D')shl 8+ord('"')shl 16+ord(':')shl 24 then begin
    SetID(P+4,ID);
    result := ID>0;
    exit;
  end else
  if (PCardinalArray(P)^[0] and $dfdfdfdf=
       ord('R')+ord('O')shl 8+ord('W')shl 16+ord('I')shl 24) and
     (PCardinalArray(P)^[1] and $ffffdf=
       ord('D')+ord('"')shl 8+ord(':')shl 16) then begin
    SetID(P+7,ID);
    result := ID>0;
    exit;
  end;
  ID := 0;
  result := false;
end;

function StartWithID(P: PUTF8Char; out ID: TID): boolean;
begin
  if PCardinal(P)^ and $ffdfdf=
      ord('I')+ord('D')shl 8+ord(':')shl 16 then begin
    SetID(P+3,ID);
    result := ID>0;
    exit;
  end else
  if (PCardinalArray(P)^[0] and $dfdfdfdf=
       ord('R')+ord('O')shl 8+ord('W')shl 16+ord('I')shl 24) and
     (PCardinalArray(P)^[1] and $ffdf=ord('D')+ord(':')shl 8) then begin
    SetID(P+6,ID);
    result := ID>0;
    exit;
  end;
  ID := 0;
  result := false;
end;

function JSONGetID(P: PUTF8Char; out ID: TID): Boolean;
begin
  if (P<>nil) and
     NextNotSpaceCharIs(P,'{') then
     if NextNotSpaceCharIs(P,'"') then
       result := StartWithQuotedID(P,ID) else
       result := StartWithID(P,ID) else begin
    ID := 0;
    result := false;
  end;
end;

function JSONGetObject(var P: PUTF8Char; ExtractID: PID;
  var EndOfObject: AnsiChar; KeepIDField: boolean): RawUTF8;
var Beg, PC: PUTF8Char;
begin
  result := '';
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^<>'{' then
    exit;
  Beg := P;
  P := GotoNextJSONObjectOrArray(Beg);
  if (P<>nil) and not (P^ in EndOfJSONField) then
    P := nil;
  if P<>nil then begin
    EndOfObject := P^;
    inc(P); // ignore end of object, i.e. ',' or ']'
    if ExtractID<>nil then
      if JSONGetID(Beg,ExtractID^) and not KeepIDField then begin
        PC := PosChar(Beg,','); // ignore the '"ID":203,' pair
        if PC=nil then
          exit;
        PC^ := '{';
        FastSetString(result,PC,P-PC-1);
        exit;
      end;
    FastSetString(result,Beg,P-Beg-1);
  end;
end;


{ TSQLTableJSON }

function TSQLTableJSON.PrivateCopyChanged(aJSON: PUTF8Char; aLen: integer): boolean;
var Hash: cardinal;
begin
  Hash := crc32c(0,pointer(aJSON),aLen);
  result := (fPrivateCopyHash=0) or (Hash=0) or (Hash<>fPrivateCopyHash);
  if not result then
    exit;
  FastSetString(fPrivateCopy,aJSON,aLen+16); // +16 for SSE4.2 read-ahead
  fPrivateCopyHash := Hash;
end;

function TSQLTableJSON.ParseAndConvert(Buffer: PUTF8Char; BufferLen: integer): boolean;
  function GetFieldCountExpanded(P: PUTF8Char): integer;
  var EndOfObject: AnsiChar;
  begin
    result := 0;
    repeat
      P := GotoNextJSONItem(P,2,@EndOfObject); // ignore Name+Value items
      if P=nil then begin // unexpected end
        result := 0;
        exit;
      end;
      inc(result);
      if EndOfObject='}' then break; // end of object
    until false;
  end;
var i, max, nfield, nrow, resmax, f: integer;
    EndOfObject: AnsiChar;
    P: PUTF8Char;
    wasString: Boolean;
begin
  result := false; // error on parsing
  fFieldIndexID := -1;
  if (self=nil) or (Buffer=nil) then
    exit;
  // go to start of object
  P := GotoNextNotSpace(Buffer);
  if IsNotExpandedBuffer(P,Buffer+BufferLen,fFieldCount,fRowCount) then begin
    // A. Not Expanded (more optimized) format as array of values
(* {"fieldCount":9,"values":["ID","Int","Test","Unicode","Ansi","ValFloat","ValWord",
    "ValDate","Next",0,0,"abcde+?ef+?+?","abcde+?ef+?+?","abcde+?ef+?+?",
    3.14159265300000E+0000,1203,"2009-03-10T21:19:36",0,..],"rowCount":20} *)
    // 1. check RowCount and DataLen
    if fRowCount<0 then begin // IsNotExpanded() notified wrong input
      fRowCount := 0; // may occur if P^ content was invalid
      exit;
    end;
    // 2. initialize and fill fResults[] PPUTF8CharArray memory
    max := (fRowCount+1)*FieldCount;
    SetLength(fJSONResults,max);
    fResults := @fJSONResults[0];
    // unescape+zeroify JSONData + fill fResults[] to proper place
    dec(max);
    f := 0;
    for i := 0 to max do begin
      // get a field
      fJSONResults[i] := GetJSONFieldOrObjectOrArray(P,@wasString,nil,true);
      if (P=nil) and (i<>max) then
        exit; // failure (GetRowCountNotExpanded should have detected it)
      if i>=FieldCount then begin
        if wasString then
          Include(fFieldParsedAsString,f); // mark column was "string"
        inc(f);
        if f=FieldCount then
          f := 0; // check all rows
      end;
    end;
  end else begin
    // B. Expanded format as array of objects (each with field names)
(* [{"ID":0,"Int":0,"Test":"abcde+?ef+?+?","Unicode":"abcde+?ef+?+?","Ansi":
    "abcde+?ef+?+?","ValFloat": 3.14159265300000E+0000,"ValWord":1203,
    "ValDate":"2009-03-10T21:19:36","Next":0},{..}] *)
    // 1. get fields count from first row
    while P^<>'[' do if P^=#0 then exit else inc(P); // need an array of objects
    repeat inc(P); if P^=#0 then exit; until P^ in ['{',']']; // go to object beginning
    if P^=']' then begin // [] -> void data
      result := true;
      exit;
    end;
    inc(P);
    nfield := GetFieldCountExpanded(P);
    if nField=0 then
      exit; // invalid data for first row
    // 2. get values (assume fields are always the same as in the first object)
    max := nfield; // index to start storing values in fResults[]
    resmax := nfield*2;
    SetLength(fJSONResults,resmax); // space for field names + 1 data row
    nrow := 0;
    repeat // let fJSONResults[] point to unescaped+zeroified JSON values
      for f := 0 to nfield-1 do begin
        if nrow=0 then // get field name from 1st Row
          fJSONResults[f] := GetJSONPropName(P) else
          P := GotoNextJSONItem(P);  // ignore field name for later rows
          // warning: field order if not checked, and should be as expected
        if max>=resmax then begin // check space inside loop for GPF security
          resmax := NextGrow(resmax);
          SetLength(fJSONResults,resmax); // enough space for more rows
        end;
        if P=nil then break; // normal end: no more field name
        fJSONResults[max] := GetJSONFieldOrObjectOrArray(P,@wasString,@EndOfObject,true);
        if P=nil then begin
          nfield := 0;
          break; // unexpected end
        end;
        if wasString then // mark column was "string"
          Include(fFieldParsedAsString,f);
        if (EndOfObject='}') and (f<nfield-1) then begin
          inc(max,nfield-f);
          break; // allow some missing fields in the input object
        end;
        inc(max);
      end;
      if P=nil then
        break; // unexpected end
      if EndOfObject<>'}' then
        break; // data field layout is not consistent: should never happen
      inc(nrow);
      while (P^<>'{') and (P^<>']') do // go to next object beginning
        if P^=#0 then
          exit else
          inc(P);
      if P^=']' then
        break else
        inc(P); // jmp '{'
    until false;
    if max<>(nrow+1)*nfield then begin // field count must be the same for all objects
      fFieldCount := 0;
      fRowCount := 0;
      exit; // data field layout is not consistent: should never happen
    end;
    // 3. save field pointers to fResults[]
    SetLength(fJSONResults,max); // resize to exact size
    fResults := @fJSONResults[0];
    fFieldCount := nfield;
    fRowCount := nrow;
  end;
  for i := 0 to fFieldCount-1 do
    if IsRowID(fResults[i]) then begin
      fFieldIndexID := i;
      break;
    end;
  result := true; // if we reached here, means successfull conversion from P^
end;

function TSQLTableJSON.UpdateFrom(const aJSON: RawUTF8; var Refreshed: boolean;
  PCurrentRow: PInteger): boolean;
var len: Integer;
begin
  len := length(aJSON);
  if PrivateCopyChanged(pointer(aJSON),len) then
    if ParseAndConvert(pointer(fPrivateCopy),len) then begin
     // parse success from new aJSON data -> need some other update?
     if Assigned(fIDColumn) then begin
       // ID column was hidden -> do it again
       Finalize(fIDColumn);
       IDColumnHide;
     end;
     with fSortParams do
       if FieldCount<>0 then
         // TSQLTable.SortFields() was called -> do it again
         SortFields(FieldIndex,Asc,PCurrentRow,FieldType);
     Refreshed := true;
     result := true;
    end else
      // parse error
      result := false else
    // data didn't change (fPrivateCopyHash checked)
    result := true;
end;

constructor TSQLTableJSON.Create(const aSQL: RawUTF8; JSONBuffer: PUTF8Char; JSONBufferLen: integer);
begin // don't raise exception on error parsing
  inherited Create(aSQL);
  ParseAndConvert(JSONBuffer,JSONBufferLen);
end;

constructor TSQLTableJSON.Create(const aSQL, aJSON: RawUTF8);
var len: integer;
begin
  len := length(aJSON);
  FastSetString(fPrivateCopy,pointer(aJSON),len+16); // +16 for SSE4.2 read-ahead
  Create(aSQL,pointer(fPrivateCopy),len);
end;

constructor TSQLTableJSON.CreateFromTables(const Tables: array of TSQLRecordClass;
  const aSQL: RawUTF8; JSONBuffer: PUTF8Char; JSONBufferLen: integer);
begin // don't raise exception on error parsing
  inherited CreateFromTables(Tables,aSQL);
  ParseAndConvert(JSONBuffer,JSONBufferLen);
end;

constructor TSQLTableJSON.CreateFromTables(const Tables: array of TSQLRecordClass;
  const aSQL, aJSON: RawUTF8);
var len: integer;
begin
  len := length(aJSON);
  FastSetString(fPrivateCopy,pointer(aJSON),len+16);
  CreateFromTables(Tables,aSQL,pointer(fPrivateCopy),len);
end;

constructor TSQLTableJSON.CreateWithColumnTypes(const ColumnTypes: array of TSQLFieldType;
  const aSQL: RawUTF8; JSONBuffer: PUTF8Char; JSONBufferLen: integer);
begin // don't raise exception on error parsing
  inherited CreateWithColumnTypes(ColumnTypes,aSQL);
  ParseAndConvert(JSONBuffer,JSONBufferLen);
end;

constructor TSQLTableJSON.CreateWithColumnTypes(const ColumnTypes: array of TSQLFieldType;
  const aSQL, aJSON: RawUTF8);
var len: integer;
begin
  len := length(aJSON);
  FastSetString(fPrivateCopy,pointer(aJSON),len+16);
  CreateWithColumnTypes(ColumnTypes,aSQL,pointer(fPrivateCopy),len);
end;


{ TSQLTableWritable }

function TSQLTableWritable.AddField(const FieldName: RawUTF8): integer;
var prev: TPUTF8CharDynArray;
    rowlen,i: integer;
    S,D: PByte;
begin
  if (FieldName='') or (FieldIndex(FieldName)>=0) then
    raise ESQLTableException.CreateUTF8('%.AddField(%) invalid fieldname',[self,FieldName]);
  result := fFieldCount;
  inc(fFieldCount);
  SetLength(fFieldNames,fFieldCount);
  fFieldNames[result] := FieldName;
  fFieldNameOrder := nil;
  prev := fJSONResults;
  fJSONResults := nil;
  SetLength(fJSONResults,(fRowCount+1)*fFieldCount);
  fResults := pointer(fJSONResults);
  S := pointer(prev);
  D := pointer(fJSONResults);
  rowlen := result*SizeOf(pointer);
  MoveFast(S^,D^,rowlen);
  inc(S,rowlen);
  inc(D,rowlen);
  PPUTF8Char(D)^ := pointer(FieldName);
  inc(D,SizeOf(pointer));
  for i := 1 to fRowCount do begin
    MoveFast(S^,D^,rowlen);
    inc(S,rowlen);
    inc(D,rowlen+SizeOf(pointer)); // leave new field value as D^=nil
  end;
end;

procedure TSQLTableWritable.Update(Row: integer; const FieldName, Value: RawUTF8);
begin
  Update(Row,FieldIndexExisting(FieldName),Value);
end;

procedure TSQLTableWritable.Update(Row, Field: integer; const Value: RawUTF8);
var U: PPUTF8Char;
begin
  if (self=nil) or (fResults=nil) or (Row<=0) or (Row>fRowCount) or
     (cardinal(Field)>=cardinal(FieldCount)) then
    exit;
  U := @fResults[Row*FieldCount+Field];
  if (U^=nil) or (StrComp(U^,pointer(Value))<>0) then
    if fNewValuesInterning<>nil then
      U^ := pointer(fNewValuesInterning.Unique(Value)) else begin
      AddRawUTF8(fNewValues,fNewValuesCount,Value);
      U^ := pointer(Value);
    end;
end;

function TSQLTableWritable.AddField(const FieldName: RawUTF8;
  FieldType: TSQLFieldType; FieldTypeInfo: pointer; FieldSize: integer): integer;
begin
  result := AddField(FieldName);
  SetFieldType(result,FieldType,FieldTypeInfo,FieldSize);
end;

function TSQLTableWritable.AddField(const FieldName: RawUTF8;
  FieldTable: TSQLRecordClass; const FieldTableName: RawUTF8=''): integer;
var prop: TSQLPropInfo;
    nfo: pointer;
begin
  result := AddField(FieldName);
  if FieldTable=nil then
    exit;
  with FieldTable.RecordProps.Fields do
    if FieldTableName<>'' then
      prop := ByRawUTF8Name(FieldTableName) else
      prop := ByRawUTF8Name(FieldName);
  if prop = nil then
    exit;
  if prop.InheritsFrom(TSQLPropInfoRTTI) then
    nfo := TSQLPropInfoRTTI(prop).PropType else
    nfo := nil;
  SetFieldType(result,prop.SQLFieldTypeStored,nfo,prop.FieldWidth,
    PtrArrayAddOnce(fQueryTables,FieldTable));
end;

{$ifndef NOVARIANTS}
procedure TSQLTableWritable.Update(Row: integer; const FieldName: RawUTF8;
  const Value: variant);
begin
  Update(Row,FieldIndexExisting(FieldName),Value);
end;

procedure TSQLTableWritable.Update(Row, Field: integer; const Value: variant);
var U: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(Value,U,wasString);
  Update(Row,Field,U);
end;
{$endif NOVARIANTS}

procedure TSQLTableWritable.Join(From: TSQLTable; const FromKeyField, KeyField: RawUTF8);
var fk,dk,f,i,k,ndx: integer;
    n,fn: RawUTF8;
    info: PSQLTableFieldType;
    new: TIntegerDynArray;
begin
  dk := FieldIndexExisting(KeyField);
  SetLength(new,FieldCount);
  fk := From.FieldIndexExisting(FromKeyField);
  From.SortFields(fk); // faster merge with O(log(n)) binary search
  for f := 0 to From.FieldCount-1 do // add From fields (excluding FromKeyField)
    if f<>fk then begin
      n := From.FieldNames[f];
      fn := n;
      if FieldIndex(fn)>=0 then // ensure unique name
        for i := 2 to 100 do begin
          fn := n+SmallUInt32UTF8[i];
          if FieldIndex(fn)<0 then
            break;
        end;
      if From.FieldType(f,info)=sftUnknown then  // set TSQLTableFieldType
        i := AddField(fn) else
        if info.TableIndex>=0 then
          i := AddField(fn,From.QueryTables[info.TableIndex],n) else begin
          i := AddField(fn);
          if i>=length(fFieldType) then
            SetLength(fFieldType,i+1);
          fFieldType[i] := info^;
        end;
      new[f] := i;
    end;
  ndx := FieldCount;
  for i := 1 to fRowCount do begin // merge data
    k := From.SearchFieldSorted(fResults[ndx+dk],fk);
    if k>0 then begin
      k := k*From.FieldCount;
      for f := 0 to From.FieldCount-1 do
        if f<>fk then
          fResults[ndx+new[f]] := From.fResults[k+f]; // fast PUTF8Char copy
    end;
    inc(ndx,FieldCount);
  end;
end;


{ TINIWriter }

procedure TINIWriter.WriteObject(Value: TObject; const SubCompName: RawUTF8;
  WithSection, RawUTF8DynArrayAsCSV: boolean);
var CT: TClass;
    P: PPropInfo;
    Obj: TObject;
    i: integer;
begin
  if Value<>nil then begin
    if WithSection then
      // new TObject.ClassName is UnicodeString (Delphi 20009) -> inline code with
      // vmtClassName = UTF-8 encoded text stored in a shortstring = -44
      Add(#13#10'[%]'#13#10,[ClassNameShort(Value)^]);
    CT := Value.ClassType;
    repeat
      for i := 1 to InternalClassPropInfo(CT,P) do begin
        if P^.PropType^.Kind=tkClass then begin // recursive serialization
          Obj := P^.GetObjProp(Value);
          if (Obj<>nil) and ClassHasPublishedFields(PPointer(Obj)^) then
            WriteObject(Obj,SubCompName+ToUTF8(P^.Name)+'.',false);
        end else begin // regular properties
          Add('%%=%'#13#10,[SubCompName,P^.Name]);
          P^.GetToText(Value,self,RawUTF8DynArrayAsCSV,twNone);
          AddCR;
        end;
        P := P^.Next;
      end;
      CT := GetClassParent(CT);
    until CT=TObject;
  end;
end;

function UTF8ContentNumberType(P: PUTF8Char): TSQLFieldType;
begin
  if (P=nil) or ((PInteger(P)^=ord('n')+ord('u')shl 8+ord('l')shl 16+
                 ord('l')shl 24) and (P[4]=#0)) then
    result := sftUnknown else
    case TextToVariantNumberType(P) of
    varInt64:    result := sftInteger;
    varDouble:   result := sftFloat;
    varCurrency: result := sftCurrency;
    else         result := sftUTF8Text;
    end;
end;

function UTF8ContentType(P: PUTF8Char): TSQLFieldType;
var c,len: integer;
begin
  if P<>nil then begin
    while (P^<=' ') and (P^<>#0) do inc(P);
    if (PInteger(P)^=NULL_LOW) and (P[4]=#0) then
       result := sftUnknown else
      // don't check for 'false' or 'true' here, since their UTF-8 value is 0/1
      if P^ in ['-','0'..'9'] then
      case TextToVariantNumberType(P) of
      varInt64:    result := sftInteger;
      varDouble:   result := sftFloat;
      varCurrency: result := sftCurrency;
      else begin
        len := StrLen(P);
        if (len>15) and (Iso8601ToTimeLogPUTF8Char(P,len)<>0) then
          result := sftDateTime else
          result := sftUTF8Text;
      end;
      end else begin
        c := PInteger(P)^ and $00ffffff;
        if (c=JSON_BASE64_MAGIC) or ((P^='''') and isBlobHex(P)) then
          result := sftBlob else
        if c=JSON_SQLDATE_MAGIC then
          result := sftDateTime else
          result := sftUTF8Text;
      end;
  end else
    result := sftUnknown;
end;


{ TPropInfo }

function TPropInfo.ClassFromJSON(Instance: TObject; From: PUTF8Char;
  var Valid: boolean; Options: TJSONToObjectOptions): PUTF8Char;
var Field: ^TObject;
    {$ifndef FPC}tmp: TObject;{$endif}
begin
  valid := false;
  result := nil;
  if (@self=nil) or (PropType^.Kind<>tkClass) or (Instance=nil) then
    exit;
  if SetterIsField then
    // setter to field -> direct in-memory access
    Field := SetterAddr(Instance) else
  {$ifndef FPC}
  if WriteIsDefined and not (j2oSetterNoCreate in Options) then begin
    // it is a setter method -> create a temporary object
    tmp := PropType^.ClassCreate;
    try
      result := JSONToObject(tmp,From,Valid,nil,Options);
      if not Valid then
        FreeAndNil(tmp) else begin
        SetOrdProp(Instance,PtrInt(tmp)); // PtrInt(tmp) is OK for CPU64
        if j2oSetterExpectsToFreeTempInstance in Options then
          FreeAndNil(tmp);
      end;
    except
      on Exception do
        tmp.Free;
    end;
    exit;
  end else
  {$endif FPC}
  if GetterIsField then
    // no setter -> use direct in-memory access from getter (if available)
    Field := GetterAddr(Instance) else
    // no setter, nor direct field offset -> impossible to set the instance
    exit;
  result := JSONToObject(Field^,From,Valid,nil,Options);
end;

function TPropInfo.GetOrdValue(Instance: TObject): PtrInt;
begin
  if (Instance<>nil) and (@self<>nil) and (PropType^.Kind in
      [tkInteger,tkEnumeration,tkSet,{$ifdef FPC}tkBool,{$endif}tkClass]) then
    result := GetOrdProp(Instance) else
    result := -1;
end;

function TPropInfo.GetInt64Value(Instance: TObject): Int64;
begin
  if (Instance<>nil) and (@self<>nil) then
  case PropType^.Kind of
    tkInteger,tkEnumeration,tkSet,tkChar,tkWChar,tkClass{$ifdef FPC},tkBool{$endif}:
      result := GetOrdProp(Instance);
    tkInt64{$ifdef FPC},tkQWord{$endif}:
      result := GetInt64Prop(Instance);
    else result := 0;
  end else
    result := 0;
end;

function TPropInfo.GetCurrencyValue(Instance: TObject): Currency;
begin
  if (Instance<>nil) and (@self<>nil) and (PropType^.Kind=tkFloat) then
    if {$ifdef HASINLINE}PropType^.FloatType{$else}
       PFloatType(@PropType^.Name[ord(PropType^.Name[0])+1])^{$endif}=ftCurr then
      result := GetCurrencyProp(Instance) else
      result := GetFloatProp(Instance) else
    result := 0;
end;

function TPropInfo.GetDoubleValue(Instance: TObject): double;
begin
  if (Instance<>nil) and (@self<>nil) and (PropType^.Kind=tkFloat) then
     result := GetFloatProp(Instance) else
     result := 0;
end;

procedure TPropInfo.SetDoubleValue(Instance: TObject; const Value: double);
begin
  if (Instance<>nil) and (@self<>nil) and (PropType^.Kind=tkFloat) then
    SetFloatProp(Instance,Value);
end;

function TPropInfo.GetDynArray(Instance: TObject): TDynArray;
begin
  result.Init(TypeInfo,GetFieldAddr(Instance)^);
end;

procedure TPropInfo.GetDynArray(Instance: TObject; var result: TDynArray);
begin
  result.Init(TypeInfo,GetFieldAddr(Instance)^);
end;

function TPropInfo.DynArrayIsObjArray: boolean;
begin
  if PropType^.Kind=tkDynArray then
    result := ObjArraySerializers.Find(TypeInfo)<>nil else
    result := false;
end;

function TPropInfo.DynArrayIsObjArrayInstance: PClassInstance;
begin
  if PropType^.Kind<>tkDynArray then
    result := nil else
    result := TJSONSerializer.RegisterObjArrayFindType(TypeInfo);
end;

procedure TPropInfo.GetLongStrValue(Instance: TObject; var result: RawUTF8);
var tmp: RawByteString;
    WS: WideString;
    {$ifdef HASVARUSTRING}US: UnicodeString;{$endif}
    cp: integer;
begin
  if (Instance<>nil) and (@self<>nil) then
  case PropType^.Kind of
  {$ifdef FPC}tkLStringOld,{$endif} tkLString: begin
    GetLongStrProp(Instance,tmp);
    if tmp='' then
      result := '' else begin
      cp := PropType^.AnsiStringCodePage;
      case cp of
        CP_UTF8:       result := tmp;
        CP_SQLRAWBLOB: result := TSQLRawBlobToBlob(TSQLRawBlob(tmp));
        else           result := TSynAnsiConvert.Engine(cp).AnsiToUTF8(tmp);
      end;
    end;
  end;
  {$ifdef HASVARUSTRING}
  tkUString: begin
    GetUnicodeStrProp(Instance,US);
    RawUnicodeToUtf8(pointer(US),length(US),result);
  end;
  {$endif HASVARUSTRING}
  tkWString: begin
    GetWideStrProp(Instance,WS);
    RawUnicodeToUtf8(pointer(WS),length(WS),result);
  end;
  else result := '';
  end
  else result := '';
end;

procedure TPropInfo.GetRawByteStringValue(Instance: TObject; var Value: RawByteString);
begin
  if (Instance<>nil) and (@self<>nil) and
     (PropType^.Kind in [{$ifdef FPC}tkLStringOld,{$endif}tkLString]) then
    GetLongStrProp(Instance,Value) else
    Value := '';
end;

procedure TPropInfo.SetLongStrValue(Instance: TObject; const Value: RawUTF8);
  procedure HandleAnsiString(Instance: TObject; const Value: RawUTF8; cp: integer);
  var tmp: RawByteString;
  begin
    if cp=CP_SQLRAWBLOB then
      tmp := BlobToTSQLRawBlob(Value) else
      tmp := TSynAnsiConvert.Engine(cp).UTF8ToAnsi(Value);
    {$ifdef FPC}
    // an FPC quirck ... and Alf work-around ... ;-)
    if cp=CP_UTF16 then begin
      Setlength(tmp,length(tmp)+1);
      tmp[length(tmp)] := #0;
    end;
    {$endif}
    SetLongStrProp(Instance,tmp);
  end;
  {$ifdef HASVARUSTRING}
  procedure HandleUnicode(Instance: TObject; const Value: RawUTF8);
  begin
    SetUnicodeStrProp(Instance,UTF8DecodeToUnicodeString(Value));
  end;
  {$endif}
  procedure HandleWideString(Instance: TObject; const Value: RawUTF8);
  begin
    SetWideStrProp(Instance,UTF8ToWideString(Value));
  end;
var cp: integer;
begin
  if (Instance<>nil) and (@self<>nil) then
  case PropType^.Kind of
  {$ifdef FPC}tkLStringOld,{$endif}tkLString: begin
    if Value<>'' then begin
      cp := PropType^.AnsiStringCodePage;
      if cp=CP_UTF8 then
        SetLongStrProp(Instance,Value) else
        HandleAnsiString(Instance,Value,cp);
    end else
      SetLongStrProp(Instance,'');
  end;
  {$ifdef HASVARUSTRING}
  tkUString:
    HandleUnicode(Instance,Value);
  {$endif}
  tkWString:
    HandleWideString(Instance,Value);
  end;
end;

procedure TPropInfo.CopyLongStrProp(Source,Dest: TObject);
var tmp: RawByteString;
begin
  GetLongStrProp(Source,tmp);
  SetLongStrProp(Dest,tmp);
end;

{$ifndef NOVARIANTS}
procedure TPropInfo.SetFromVariant(Instance: TObject; const Value: variant);
var i: integer;
    i64: Int64;
    u: RawUTF8;
    d: double;
    c: PClassInstance;
begin
  if (Instance<>nil) and (@self<>nil) then
  case PropType^.Kind of
  tkInteger,tkEnumeration,tkSet,tkChar,tkWChar{$ifdef FPC},tkBool{$endif}:
    if VariantToInteger(Value,i) then
      SetOrdProp(Instance,i) else
    if VariantToUTF8(Value,u) then begin
      if PropType^.Kind=tkEnumeration then
        i := PropType^.EnumBaseType^.GetEnumNameValue(pointer(u),length(u)) else
        i := UTF8ToInteger(u,-1);
      if i>=0 then
        SetOrdProp(Instance,i)
    end;
  tkInt64{$ifdef FPC},tkQWord{$endif}:
    if VariantToInt64(Value,i64) or (VariantToUTF8(Value,u) and ToInt64(u,i64)) then
      SetInt64Prop(Instance,i64);
  {$ifdef HASVARUSTRING}tkUString,{$endif}
  tkLString, tkWString {$ifdef FPC},tkLStringOld{$endif}:
    if VariantToUTF8(Value,u) then
      SetLongStrValue(Instance,u);
  tkFloat:
    if VariantToDouble(Value,d) or (VariantToUTF8(Value,u) and ToDouble(u,d)) then
      SetFloatProp(Instance,d);
  tkVariant:
    SetVariantProp(Instance,Value);
  tkClass:
    DocVariantToObject(_Safe(Value)^,GetObjProp(Instance));
  tkDynArray: begin
    c := TJSONSerializer.RegisterObjArrayFindType(TypeInfo);
    if c<>nil then
      DocVariantToObjArray(_Safe(Value)^,GetFieldAddr(Instance)^,c) else begin
      U := _Safe(Value)^.ToJSON;
      GetDynArray(Instance).LoadFromJSON(pointer(U));
    end;
  end;
  {$ifdef PUBLISHRECORD}
  tkRecord{$ifdef FPC},tkObject{$endif}: begin
    VariantSaveJSON(Value,twJSONEscape,u);
    RecordLoadJSON(GetFieldAddr(Instance)^,pointer(u),TypeInfo);
  end;
  {$endif}
  end;
end;

procedure TPropInfo.GetVariant(Instance: TObject; var Dest: variant);
var i: PtrInt;
    U: RawUTF8;
begin
  if (Instance<>nil) and (@self<>nil) then
  case PropType^.Kind of
  tkInteger,tkEnumeration,tkSet,tkChar,tkWChar{$ifdef FPC},tkBool{$endif}: begin
    i := GetOrdProp(Instance);
    case PropType^.Kind of
    tkInteger,tkSet: Dest := integer(i);
    tkChar: Dest := AnsiChar(i);
    tkWChar: Dest := WideChar(i);
    {$ifdef FPC}
    tkBool: Dest := boolean(i);
    tkEnumeration: Dest := integer(i);
    {$else}
    tkEnumeration:
      if TypeInfo=system.TypeInfo(boolean) then
        Dest := boolean(i) else
        Dest := integer(i);
    {$endif FPC}
    end;
  end;
  tkInt64{$ifdef FPC},tkQWord{$endif}:
    Dest := GetInt64Prop(Instance);
  tkLString,tkWString{$ifdef HASVARUSTRING},tkUString{$endif}{$ifdef FPC},tkLStringOld{$endif}: begin
    GetLongStrValue(Instance,U);
    RawUTF8ToVariant(U,Dest);
  end;
  tkFloat: Dest := GetFloatProp(Instance);
  tkVariant: GetVariantProp(Instance,Dest);
  tkClass: ObjectToVariant(GetObjProp(Instance),Dest);
  tkDynArray: begin
    GetDynArray(Instance).SaveToJSON(U); // works for T*ObjArray and records
    TDocVariantData(Dest).InitJSONInPlace(pointer(U),JSON_OPTIONS_FAST);
  end;
  else VarClear(Dest);
  end;
end;

{$endif NOVARIANTS}

procedure TPropInfo.SetFromText(Instance: TObject; const Text: RawUTF8;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean);
{$ifndef NOVARIANTS}var tmp: variant;{$endif}
begin
  if (Instance<>nil) and (@self<>nil) then
  case PropType^.Kind of
  tkChar,tkWChar:
    if Text<>'' then
     SetOrdProp(Instance,ord(Text[1]));
  tkInteger,tkEnumeration,tkSet{$ifdef FPC},tkBool{$endif}:
    SetOrdProp(Instance,GetIntegerDef(pointer(Text),DefaultOr0));
  tkInt64{$ifdef FPC},tkQWord{$endif}:
    SetInt64Prop(Instance,GetInt64(pointer(Text)));
  tkLString,{$ifdef FPC}tkLStringOld,{$endif}{$ifdef HASVARUSTRING}tkUString,{$endif}tkWString:
    SetLongStrValue(Instance,Text);
  tkFloat:
    if PropType^.FloatType=ftCurr then
      SetCurrencyProp(Instance,StrToCurrency(pointer(Text))) else
      SetFloatProp(Instance,GetExtended(pointer(Text)));
  {$ifndef NOVARIANTS}
  tkVariant: begin
    if TryCustomVariants<>nil then
      GetVariantFromJSON(pointer(Text),TextToVariantNumberType(pointer(Text))=varString,
        tmp,TryCustomVariants,{allowdouble=}true) else
      RawUTF8ToVariant(Text,tmp);
    SetVariantProp(Instance,tmp);
  end;
  {$endif NOVARIANTS}
  tkDynArray:
    if Text<>'' then
      if IsRawUTF8DynArray(TypeInfo) and (Text[1]<>'[') then
        CSVToRawUTF8DynArray(pointer(Text),PRawUTF8DynArray(GetFieldAddr(Instance))^) else
        GetDynArray(Instance).LoadFromJSON(pointer(Text)); // T*ObjArray and records
  end;
end;

procedure TPropInfo.GetToText(Instance: TObject; WR: TTextWriter;
  RawUTF8DynArrayAsCSV: boolean; Escape: TTextWriterKind);
var i: integer;
    tmp: RawUTF8;
    a: PRawUTF8DynArray;
    da: TDynArray;
    {$ifndef NOVARIANTS}v: variant;{$endif}
begin
  if (Instance<>nil) and (@self<>nil) and (WR<>nil) then
  case PropType^.Kind of
  tkInteger,tkEnumeration,tkSet,tkChar,tkWChar{$ifdef FPC},tkBool{$endif}: begin
    i := GetOrdProp(Instance);
    case PropType^.Kind of
    tkChar:  WR.Add(AnsiChar(i));
    tkWChar: WR.AddNoJSONEscapeW(@i,1);
    else     WR.Add(i);
    end;
  end;
  tkInt64{$ifdef FPC},tkQWord{$endif}:
    WR.Add(GetInt64Prop(Instance));
  tkLString,{$ifdef FPC}tkLStringOld,{$endif}{$ifdef HASVARUSTRING}tkUString,{$endif}tkWString: begin
    GetLongStrValue(Instance,tmp);
    WR.Add(pointer(tmp),length(tmp),Escape);
  end;
  tkFloat:
    if PropType^.FloatType=ftCurr then
      WR.AddCurr64(GetCurrencyProp(Instance)) else
      WR.AddDouble(GetFloatProp(Instance));
  {$ifndef NOVARIANTS}
  tkVariant: begin
    GetVariantProp(Instance,v);
    WR.AddVariant(v,Escape);
  end;
  {$endif NOVARIANTS}
  tkDynArray: begin
    if RawUTF8DynArrayAsCSV and IsRawUTF8DynArray(TypeInfo) then begin
      a := GetFieldAddr(Instance);
      if (a<>nil) and (a^<>nil) then begin
        for i := 0 to length(a^)-1 do begin
          WR.AddString(a^[i]);
          WR.Add(',');
        end;
        WR.CancelLastComma;
      end;
    end else begin
      GetDynArray(Instance,da);
      WR.AddDynArrayJSON(da); // works for T*ObjArray and records
    end;
  end;
  end;
end;

procedure TPropInfo.SetDefaultValue(Instance: TObject; FreeAndNilNestedObjects: boolean);
var obj: TObject;
    da: TDynArray;
    {$ifdef PUBLISHRECORD}
    addr: pointer;
    {$endif}
begin
  if (Instance<>nil) and (@self<>nil) then
  case PropType^.Kind of
  tkInteger,tkEnumeration,tkSet,tkChar,tkWChar{$ifdef FPC},tkBool{$endif}:
    SetOrdProp(Instance,DefaultOr0);
  tkInt64{$ifdef FPC},tkQWord{$endif}:
    SetInt64Prop(Instance,0);
  tkLString{$ifdef FPC},tkLStringOld{$endif}:
    SetLongStrProp(Instance,'');
  {$ifdef HASVARUSTRING}
  tkUString:
    SetUnicodeStrProp(Instance,'');
  {$endif HASVARUSTRING}
  tkWString:
    SetWideStrProp(Instance,'');
  tkFloat:
    SetFloatProp(Instance,0);
  {$ifndef NOVARIANTS}
  tkVariant:
    SetVariantProp(Instance,SynCommons.Null);
  {$endif}
  tkClass: begin
    obj := GetObjProp(Instance);
    if obj<>nil then
      if FreeAndNilNestedObjects then begin
        SetOrdProp(Instance,0); // mimic FreeAndNil()
        obj.Free;
      end else
        ClearObject(obj,false);
  end;
  tkDynArray: begin
    GetDynArray(Instance,da);
    da.Count := 0; // will handle also any T*ObjArray
  end;
  {$ifdef PUBLISHRECORD}
  tkRecord{$ifdef FPC},tkObject{$endif}: begin
    addr := GetFieldAddr(Instance);
    RecordClear(addr^,TypeInfo);
    FillcharFast(addr^,TypeInfo^.RecordType^.Size,0);
  end;
  {$endif}
  end;
end;

function TPropInfo.GetGenericStringValue(Instance: TObject): string;
var tmp: RawUTF8;
begin
  if (Instance=nil) or (@self=nil) or not(PropType^.Kind in [{$ifdef FPC}tkLStringOld,{$endif}
     {$ifdef HASVARUSTRING}tkUString,{$endif} tkLString, tkWString]) then
    result := '' else begin
    GetLongStrValue(Instance,tmp);
    result := UTF8ToString(tmp);
  end;
end;

procedure TPropInfo.SetGenericStringValue(Instance: TObject; const Value: string);
begin
  if (Instance<>nil) and (@self<>nil) then
    case PropType^.Kind of
      {$ifdef FPC}tkLStringOld,{$endif}tkLString, tkWString:
         SetLongStrValue(Instance,StringToUtf8(Value));
      {$ifdef HASVARUSTRING}
       tkUString:
         SetUnicodeStrProp(Instance,UnicodeString(Value));
      {$endif}
    end;
end;

{$ifdef HASVARUSTRING}
function TPropInfo.GetUnicodeStrValue(Instance: TObject): UnicodeString;
begin
  if (Instance<>nil) and (@self<>nil) and (PropType^.Kind=tkUString) then
    GetUnicodeStrProp(Instance,result) else
    result := '';
end;

procedure TPropInfo.SetUnicodeStrValue(Instance: TObject; const Value: UnicodeString);
begin
  if (Instance<>nil) and (@self<>nil) and
     (PropType^.Kind=tkUString) then
    SetUnicodeStrProp(Instance,Value);
end;
{$endif HASVARUSTRING}

procedure TPropInfo.SetOrdValue(Instance: TObject; Value: PtrInt);
begin
  if (Instance<>nil) and (@self<>nil) and
     (PropType^.Kind in [
       tkInteger,tkEnumeration,tkSet,{$ifdef FPC}tkBool,{$endif}tkClass]) then
    SetOrdProp(Instance,Value);
end;

procedure TPropInfo.SetInt64Value(Instance: TObject; Value: Int64);
begin
  if (Instance<>nil) and (@self<>nil) then
  case PropType^.Kind of
    tkInteger,tkEnumeration,tkSet,tkChar,tkWChar,tkClass{$ifdef FPC},tkBool{$endif}:
      SetOrdProp(Instance,Value);
    tkInt64{$ifdef FPC}, tkQWord{$endif}:
      SetInt64Prop(Instance,Value);
  end;
end;

function TPropInfo.SameValue(Source: TObject; DestInfo: PPropInfo; Dest: TObject): boolean;

  {$ifndef NOVARIANTS}
  function CompareVariants: boolean;
  var VS,VD: Variant;
  begin
    GetVariantProp(Source,VS);
    DestInfo^.GetVariantProp(Dest,VD);
    result := VS=VD; // rely on Variants.pas comparison
  end;
  {$endif}
  function CompareStrings: Boolean;
  var US,UD: RawUTF8;
  begin
    GetLongStrValue(Source,US);
    DestInfo^.GetLongStrValue(Dest,UD);
    result := US=UD;
  end;

var kS,kD: TTypeKind;
    daS,daD: TDynArray;
    i: integer;
begin
  if Source=Dest then begin
    result := true;
    exit;
  end;
  result := false;
  if (Source=nil) or (Dest=nil) or (@self=nil) or (DestInfo=nil) then
    exit;
  kS := PropType^.Kind;
  kD := DestInfo^.PropType^.Kind;
  if kS in tkStringTypes then
    if kD in tkStringTypes then
      result := CompareStrings else
      exit else
  if kS in tkOrdinalTypes then
    if kD in tkOrdinalTypes then
      result := GetInt64Value(Source)=DestInfo^.GetInt64Value(Dest) else
      exit else
  if kS=kD then
    case KS of
    tkClass:
      result := ObjectEquals(GetObjProp(Source),DestInfo^.GetObjProp(Dest));
    tkFloat: begin
      if DestInfo^.PropType^.FloatType=PropType^.FloatType then
      case PropType^.FloatType of
      ftCurr: begin
        if GetterIsField and ((@self=DestInfo) or DestInfo^.GetterIsField) then
          result := PInt64(GetterAddr(Source))^=PInt64(DestInfo.GetterAddr(Dest))^ else
          result := GetCurrencyProp(Source)=DestInfo^.GetCurrencyProp(Dest);
        exit;
      end;
      ftDoub: begin
        if GetterIsField and ((@self=DestInfo) or DestInfo^.GetterIsField) then
          result := PInt64(GetterAddr(Source))^=PInt64(DestInfo.GetterAddr(Dest))^ else
          result := SynCommons.SameValue(GetDoubleProp(Source),DestInfo^.GetDoubleProp(Dest));
        exit;
      end;
      end;
      result := SynCommons.SameValueFloat(GetFloatProp(Source),DestInfo^.GetFloatProp(Dest));
    end;
    tkDynArray: begin
      GetDynArray(Source,daS);
      DestInfo^.GetDynArray(Dest,daD);
      if daS.Count=daD.Count then
        if DynArrayIsObjArray and
           ((@self=DestInfo) or DestInfo^.DynArrayIsObjArray) then begin
          for i := 0 to daS.Count-1 do
            if not ObjectEquals(PObjectArray(daS.Value^)[i],PObjectArray(daD.Value^)[i]) then
              exit;
          result := true;
        end else
          result := daD.Equals(daS);
    end;
    {$ifndef NOVARIANTS}
    tkVariant:
      result := CompareVariants;
    {$endif}
  end;
end;

function ClassFieldPropInstanceMatchingClass(
  aSearchedInstance: TObject; aSearchedClassType: TClass): TObject;
var P: PPropInfo;
begin
  result := aSearchedInstance;
  if (aSearchedInstance=nil) or
     aSearchedInstance.InheritsFrom(aSearchedClassType) then
    exit;
  P := ClassFieldPropWithParentsFromClassType(PPointer(aSearchedInstance)^,aSearchedClassType);
  if P<>nil then begin
    result := P^.GetObjProp(aSearchedInstance);
    if result=nil then
      result := aSearchedInstance;
  end;
end;

function TPropInfo.CopyToNewObject(aFrom: TObject): TObject;
var aClass: TClass;
    aInstance: TClassInstance;
begin
  if aFrom=nil then begin
    result := nil;
    exit;
  end;
  aClass := PropType^.ClassType^.ClassType;
  aInstance.Init(aClass);
  result := aInstance.CreateNew;
  try
    CopyObject(ClassFieldPropInstanceMatchingClass(aFrom,aClass),result);
  except
    FreeAndNil(result); // avoid memory leak if error during new instance copy
  end;
end;

procedure TPropInfo.CopyValue(Source, Dest: TObject; DestInfo: PPropInfo);
var Value: RawByteString;
    WS: WideString;
    {$ifdef HASVARUSTRING} US: UnicodeString; {$endif}
    {$ifndef NOVARIANTS} V: variant; {$endif}
    S,D: TObject;
    kS,kD: TTypeKind;
    ft: TSQLFieldType;
label i64, int, dst, obj, str;
begin
  if DestInfo=nil then
    DestInfo := @self;
  if (@self=nil) or (Source=nil) or (Dest=Source) or (Dest=nil) then
    exit;
  kS := PropType^.Kind;
  kD := DestInfo^.PropType^.Kind;
  case kS of
    {$ifdef FPC}tkBool,{$endif} tkEnumeration, tkInteger, tkSet, tkChar, tkWChar:
int:  if DestInfo=@Self then
        SetOrdProp(Dest,GetOrdProp(Source)) else
dst:  if kD in tkOrdinalTypes then // use Int64 to handle e.g. cardinal
        DestInfo^.SetInt64Value(Dest,GetInt64Value(Source));
    tkClass: begin
      ft := PropType^.ClassSQLFieldType;
      case ft of
        sftID: // TSQLRecord published properties (sftID)
          if TSQLRecord(Source).fFill.JoinedFields then
            // -> pre-allocated fields by Create*Joined()
            goto obj else
            // -> these are not class instances, but INTEGER reference to records
            goto int;
        sftMany, sftObject: begin
          // generic case: copy also class content (create instances)
  obj:    S := GetObjProp(Source);
          if (DestInfo=@self) or
             ((kD=tkClass) and (DestInfo^.PropType^.ClassSQLFieldType=ft)) then begin
            D := DestInfo.GetObjProp(Dest);
{$ifndef LVCL}
            if S.InheritsFrom(TCollection) then
              CopyCollection(TCollection(S),TCollection(D)) else
{$endif}    begin
              D.Free; // release previous D instance then set a new copy of S
              DestInfo.SetOrdProp(Dest,PtrInt(DestInfo^.CopyToNewObject(S)));
            end;
          end;
        end;
      end;
    end;
    tkInt64{$ifdef FPC}, tkQWord{$endif}:
      if DestInfo=@self then
        // works also with QWord, TID, TTimeLog, Double and Currency
i64:    SetInt64Prop(Dest,GetInt64Prop(Source)) else
        goto dst;
    tkFloat:
    if DestInfo=@self then
      if (PropType^.FloatType in [ftDoub,ftCurr]) and
         GetterIsField and SetterIsField then
        goto I64 else
        SetFloatProp(Dest,GetFloatProp(Source)) else
      if kD=tkFloat then
        DestInfo.SetFloatProp(Dest,GetFloatProp(Source));
    tkLString{$ifdef FPC},tkLStringOld{$endif}:
      if kD=kS then begin
        GetLongStrProp(Source,Value);
        DestInfo.SetLongStrProp(Dest,Value);
      end else
str:  if kD in tkStringTypes then begin
        GetLongStrValue(Source,RawUTF8(Value));
        DestInfo.SetLongStrValue(Dest,RawUTF8(Value));
      end;
    {$ifdef HASVARUSTRING}
    tkUString:
      if kD=tkUString then begin
        GetUnicodeStrProp(Source,US);
        DestInfo.SetUnicodeStrProp(Dest,US);
      end else
        goto str;
    {$endif}
    tkWString:
      if kD=tkWString then begin
        GetWideStrProp(Source,WS);
        DestInfo.SetWideStrProp(Dest,WS);
      end else
        goto str;
    tkDynArray:
      if (DestInfo=@self) or (TypeInfo=DestInfo.TypeInfo) then
        DestInfo.GetDynArray(Dest).Copy(GetDynArray(Source));
    tkRecord{$ifdef FPC},tkObject{$endif}:
      if (DestInfo=@self) or (TypeInfo=DestInfo.TypeInfo) then
        RecordCopy(DestInfo.GetFieldAddr(Dest)^,GetFieldAddr(Source)^,TypeInfo);
    {$ifndef NOVARIANTS}
    tkVariant:
      if kD=tkVariant then begin
        GetVariantProp(Source,V);
        DestInfo.SetVariantProp(Dest,V);
      end;
    {$endif}
  end; // note: tkString (shortstring) and tkInterface not handled
end;

function TPropInfo.IsBlob: boolean;
begin
  result := (@self<>nil) and (TypeInfo=system.TypeInfo(TSQLRawBlob));
end;

function TPropInfo.DefaultOr0: integer;
begin
  if Default=NO_DEFAULT then
    result := 0 else
    result := Default;
end;

function TPropInfo.IsDefaultOrVoid(Instance: TObject): boolean;
var p: PPointer;
begin
  case PropType^.Kind of
  tkInteger,tkEnumeration,tkSet,tkChar,tkWChar{$ifdef FPC},tkBool{$endif}:
    result := GetOrdProp(Instance)=DefaultOr0;
  tkFloat:
    result := GetFloatProp(Instance)=0;
  tkInt64{$ifdef FPC},tkQWord{$endif}:
    result := GetInt64Prop(Instance)=0;
  tkLString,{$ifdef HASVARUSTRING}tkUString,{$endif}{$ifdef FPC}tkLStringOld,{$endif}
  tkWString,tkDynArray,tkInterface: begin
    p := GetFieldAddr(Instance);
    result := (p<>nil) and (p^=nil);
  end;
  tkVariant: begin
    p := GetFieldAddr(Instance);
    result := (p<>nil) and VarDataIsEmptyOrNull(p);
  end;
  tkClass:
    result := IsObjectDefaultOrVoid(GetObjProp(Instance));
  else result := false;
  end;
end;

function TPropInfo.RetrieveFieldSize: integer;
begin
  case PropType^.Kind of
  tkInteger,tkEnumeration,tkSet,tkChar,tkWChar{$ifdef FPC},tkBool{$endif}:
    result := ORDTYPE_SIZE[PropType^.OrdType];
  tkFloat:
    case PropType^.FloatType of
    ftSingle:   result := 4;
    ftExtended: result := 10;
    else result := 8;
    end;
  tkLString,{$ifdef HASVARUSTRING}tkUString,{$endif}{$ifdef FPC}tkLStringOld,{$endif}
  tkWString,tkClass,tkInterface,tkDynArray:
    result := SizeOf(pointer);
  tkInt64{$ifdef FPC},tkQWord{$endif}: result := 8;
  tkVariant: result := SizeOf(variant);
  else result := 0;
  end;
end;

function FromOrdType(o: TOrdType; P: pointer): PtrInt;
  {$ifdef HASINLINE}inline;{$endif} // shared by GetOrdProp/GetEnumName
begin
  case o of
  otSByte: result := PShortInt(P)^;
  otSWord: result := PSmallInt(P)^;
  otSLong: result := PInteger(P)^;
  otUByte: result := PByte(P)^;
  otUWord: result := PWord(P)^;
  otULong: result := PCardinal(P)^;
  {$ifdef FPC_NEWRTTI} otSQWord, otUQWord: result := PInt64(P)^; {$endif}
  else result := 0; // should not happen
  end;
end;

procedure ToOrdType(o: TOrdType; P: pointer; Value: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}
begin
  case o of
  otUByte,otSByte: PByte(P)^ := Value;
  otUWord,otSWord: PWord(P)^ := Value;
  otULong,otSLong: PCardinal(P)^ := Value;
  {$ifdef FPC_NEWRTTI}otSQWord, otUQWord: PInt64(P)^ := Value;{$endif}
  end;
end;

function TPropInfo.IsStored(Instance: TObject): boolean;
type
  TGetProc = function: boolean of object;
  TGetIndexed = function(Index: integer): boolean of object;
var pt: byte;
    call: TMethod;
begin
  pt := {$ifdef FPC}(PropProcs shr 4)and 3{$else}PropWrap(StoredProc).Kind{$endif};
  if {$ifdef FPC}pt=ptConst{$else}(StoredProc and (not PtrInt($ff)))=0{$endif} then
    result := boolean(StoredProc) else begin
    case pt of
      ptField: begin
        result := PBoolean(PtrUInt(Instance)+StoredProc{$ifndef FPC}and $00ffffff{$endif})^;
        exit;
      end;
      ptVirtual:
        call.Code := PPointer(PPtrUInt(Instance)^+{$ifndef FPC}word{$endif}(StoredProc))^;
      else
        call.Code := pointer(StoredProc);
    end;
    call.Data := Instance;
    if {$ifdef FPC}(PropProcs shr 6)and 1{$else}Index{$endif}<>NO_INDEX then
      result := TGetIndexed(call)(Index) else
      result := TGetProc(call);
  end;
end;

function TPropInfo.GetObjProp(Instance: TObject): TObject;
type
  TGetProc = function: TObject of object;
  TGetIndexed = function(Index: Integer): TObject of object;
var call: TMethod;
begin
  case Getter(Instance,@call) of
    picField:   result := PObject(call.Data)^;
    picMethod:  result := TGetProc(call);
    picIndexed: result := TGetIndexed(call)(Index);
    else result := nil;
  end;
end;

function TPropInfo.GetOrdProp(Instance: TObject): PtrInt;
type
  TGetProc = function: Pointer of object; // pointer result is a PtrInt register
  TGetIndexed = function(Index: Integer): Pointer of object;
var call: TMethod;
begin
  case Getter(Instance,@call) of
    picField:   call.Code := PPointer(call.Data)^;
    picMethod:  call.Code := TGetProc(call);
    picIndexed: call.Code := TGetIndexed(call)(Index);
    else call.Code := nil; // call.Code is used to store the raw value
  end;
  if PropType^.Kind in [tkClass,tkDynArray,tkInterface] then
    result := PtrInt(call.Code) else
    result := FromOrdType({$ifdef HASINLINE}PropType^.OrdType{$else}
      POrdType(@PropType^.Name[ord(PropType^.Name[0])+1])^{$endif},@call.Code);
end;

procedure TPropInfo.SetOrdProp(Instance: TObject; Value: PtrInt);
type
  TSetProc = procedure(Value: PtrInt) of object;
  TSetIndexed = procedure(Index: integer; Value: PtrInt) of object;
var call: TMethod;
begin
  case Setter(Instance,@call) of
    picField:  if PropType^.Kind=tkClass then
                 PPTrInt(call.Data)^ := Value else
                 ToOrdType(PropType^.OrdType,call.Data,Value);
    picMethod:  TSetProc(call)(Value);
    picIndexed: TSetIndexed(call)(Index,Value);
  end;
end;

function TPropInfo.GetInt64Prop(Instance: TObject): Int64;
type
  TGetProc = function: Int64 of object;
  TGetIndexed = function(Index: Integer): Int64 of object;
var call: TMethod;
begin
  case Getter(Instance,@call) of
    picField:   result := PInt64(call.Data)^;
    picMethod:  result := TGetProc(call);
    picIndexed: result := TGetIndexed(call)(Index);
    else result := 0;
  end;
end;

procedure TPropInfo.SetInt64Prop(Instance: TObject; const Value: Int64);
type
  TSetProc = procedure(Value: Int64) of object;
  TSetIndexed = procedure(Index: integer; Value: Int64) of object;
var call: TMethod;
begin
  case Setter(Instance,@call) of
    picField:   PInt64(call.Data)^ := Value;
    picMethod:  TSetProc(call)(Value);
    picIndexed: TSetIndexed(call)(Index,Value);
  end;
end;

procedure TPropInfo.GetShortStrProp(Instance: TObject; var Value: RawByteString);
type
  TGetProc = function: ShortString of object;
  TGetIndexed = function(Index: Integer): ShortString of object;
var call: TMethod;
    tmp: ShortString;
begin
  case Getter(Instance,@call) of
    picField:   tmp := PShortString(call.Data)^;
    picMethod:  tmp := TGetProc(call);
    picIndexed: tmp := TGetIndexed(call)(Index);
    else tmp := '';
  end;
  ShortStringToAnsi7String(tmp,RawUTF8(Value));
end; // no SetShortStrProp() by now

procedure TPropInfo.GetLongStrProp(Instance: TObject; var Value: RawByteString);
  procedure SubProc(pic: TPropInfoCall; const call: TMethod);
  type
    TGetProc = function: RawByteString of object;
    TGetIndexed = function(Index: Integer): RawByteString of object;
  begin
    case pic of
      picMethod:  value := TGetProc(call);
      picIndexed: value := TGetIndexed(call)(Index);
      else value := '';
    end;
  end;
var pic: TPropInfoCall;
    call: TMethod;
begin
  pic := Getter(Instance,@call);
  if pic=picField then
    value := PRawByteString(call.Data)^ else
    SubProc(pic,call); // avoid try..finally
end;

procedure TPropInfo.SetLongStrProp(Instance: TObject; const Value: RawByteString);
type
  TSetProc = procedure(const Value: RawByteString) of object;
  TSetIndexed = procedure(Index: integer; const Value: RawByteString) of object;
var call: TMethod;
begin
  case Setter(Instance,@call) of
    picField:   PRawByteString(call.Data)^ := Value;
    picMethod:  TSetProc(call)(Value);
    picIndexed: TSetIndexed(call)(Index,Value);
  end;
end;

procedure TPropInfo.GetWideStrProp(Instance: TObject; var Value: WideString);
type
  TGetProc = function: WideString of object;
  TGetIndexed = function(Index: Integer): WideString of object;
var call: TMethod;
begin
  case Getter(Instance,@call) of
    picField:   value := PWideString(call.Data)^;
    picMethod:  value := TGetProc(call);
    picIndexed: value := TGetIndexed(call)(Index);
    else value := '';
  end;
end;

procedure TPropInfo.SetWideStrProp(Instance: TObject; const Value: WideString);
type
  TSetProc = procedure(const Value: WideString) of object;
  TSetIndexed = procedure(Index: integer; const Value: WideString) of object;
var call: TMethod;
begin
  case Setter(Instance,@call) of
    picField:   PWideString(call.Data)^ := Value;
    picMethod:  TSetProc(call)(Value);
    picIndexed: TSetIndexed(call)(Index,Value);
  end;
end;

{$ifdef HASVARUSTRING}
procedure TPropInfo.GetUnicodeStrProp(Instance: TObject; var Value: UnicodeString);
  procedure SubProc(pic: TPropInfoCall; const call: TMethod); // avoid try..finally
  type
    TGetProc = function: UnicodeString of object;
    TGetIndexed = function(Index: Integer): UnicodeString of object;
  begin
    case pic of
      picMethod:  Value := TGetProc(call);
      picIndexed: Value := TGetIndexed(call)(Index);
      else Value := '';
    end;
  end;
var pic: TPropInfoCall;
    call: TMethod;
begin
  pic := Getter(Instance,@call);
  if pic=picField then
    Value := PUnicodeString(call.Data)^ else
    SubProc(pic,call);
end;

procedure TPropInfo.SetUnicodeStrProp(Instance: TObject; const Value: UnicodeString);
type
  TSetProc = procedure(const Value: UnicodeString) of object;
  TSetIndexed = procedure(Index: integer; const Value: UnicodeString) of object;
var call: TMethod;
begin
  case Setter(Instance,@call) of
    picField:   PUnicodeString(call.Data)^ := Value;
    picMethod:  TSetProc(call)(Value);
    picIndexed: TSetIndexed(call)(Index,Value);
  end;
end;
{$endif HASVARUSTRING}

function TPropInfo.GetCurrencyProp(Instance: TObject): currency;
type
  TGetProc = function: currency of object;
  TGetIndexed = function(Index: Integer): currency of object;
var call: TMethod;
begin
  case Getter(Instance,@call) of
    picField:   result := PCurrency(call.Data)^;
    picMethod:  result := TGetProc(call);
    picIndexed: result := TGetIndexed(call)(Index);
    else result := 0;
  end;
end;

procedure TPropInfo.SetCurrencyProp(Instance: TObject; const Value: Currency);
type
  TSetProc = procedure(const Value: currency) of object;
  TSetIndexed = procedure(Index: integer; const Value: currency) of object;
var call: TMethod;
begin
  case Setter(Instance,@call) of
    picField:   PCurrency(call.Data)^ := Value;
    picMethod:  TSetProc(call)(Value);
    picIndexed: TSetIndexed(call)(Index,Value);
  end;
end;

function TPropInfo.GetDoubleProp(Instance: TObject): double;
type
  TGetProc = function: double of object;
  TGetIndexed = function(Index: Integer): double of object;
var call: TMethod;
begin
  case Getter(Instance,@call) of
    picField:   result := unaligned(PDouble(call.Data)^);
    picMethod:  result := TGetProc(call);
    picIndexed: result := TGetIndexed(call)(Index);
    else result := 0;
  end;
end;

procedure TPropInfo.SetDoubleProp(Instance: TObject; Value: Double);
type
  TSetProc = procedure(const Value: double) of object;
  TSetIndexed = procedure(Index: integer; const Value: double) of object;
var call: TMethod;
begin
  case Setter(Instance,@call) of
    picField:   unaligned(PDouble(call.Data)^) := Value;
    picMethod:  TSetProc(call)(Value);
    picIndexed: TSetIndexed(call)(Index,Value);
  end;
end;

function TPropInfo.GetFloatProp(Instance: TObject): double;
type
  TSingleProc = function: Single of object;
  TSingleIndexed = function(Index: Integer): Single of object;
  TDoubleProc = function: Double of object;
  TDoubleIndexed = function(Index: Integer): Double of object;
  TExtendedProc = function: Extended of object;
  TExtendedIndexed = function(Index: Integer): Extended of object;
  TCurrencyProc = function: Currency of object;
  TCurrencyIndexed = function(Index: Integer): Currency of object;
var call: TMethod;
    ft: TFloatType;
begin
  result := 0;
  ft := {$ifdef HASINLINE}PropType^.FloatType{$else}
    PFloatType(@PropType^.Name[ord(PropType^.Name[0])+1])^{$endif};
  case Getter(Instance,@call) of
    picField:
      case ft of
        ftSingle:    result := PSingle(call.Data)^;
        ftDoub:      result := unaligned(PDouble(call.Data)^);
        ftExtended:  result := PExtended(call.Data)^;
        ftCurr:      result := PCurrency(call.Data)^;
      end;
    picMethod:
      case ft of
        ftSingle:    result := TSingleProc(call);
        ftDoub:      result := TDoubleProc(call);
        ftExtended:  result := TExtendedProc(call);
        ftCurr:      result := TCurrencyProc(call);
      end;
    picIndexed:
      case ft of
        ftSingle:    result := TSingleIndexed(call)(Index);
        ftDoub:      result := TDoubleIndexed(call)(Index);
        ftExtended:  result := TExtendedIndexed(call)(Index);
        ftCurr:      result := TCurrencyIndexed(call)(Index);
      end;
  end;
end;

procedure TPropInfo.SetFloatProp(Instance: TObject; Value: TSynExtended);
type
  TSingleProc = procedure(const Value: Single) of object;
  TSingleIndexed = procedure(Index: integer; const Value: Single) of object;
  TDoubleProc = procedure(const Value: double) of object;
  TDoubleIndexed = procedure(Index: integer; const Value: double) of object;
  TExtendedProc = procedure(const Value: Extended) of object;
  TExtendedIndexed = procedure(Index: integer; const Value: Extended) of object;
  TCurrencyProc = procedure(const Value: Currency) of object;
  TCurrencyIndexed = procedure(Index: integer; const Value: Currency) of object;
var call: TMethod;
    ft: TFloatType;
begin
  ft := {$ifdef HASINLINE}PropType^.FloatType{$else}
    PFloatType(@PropType^.Name[ord(PropType^.Name[0])+1])^{$endif};
  case Setter(Instance,@call) of
    picField:
      case ft of
        ftSingle:    PSingle(call.Data)^ := Value;
        ftDoub:      unaligned(PDouble(call.Data)^) := Value;
        ftExtended:  PExtended(call.Data)^ := Value;
        ftCurr:      PCurrency(call.Data)^ := Value;
      end;
    picMethod:
      case ft of
        ftSingle:    TSingleProc(call)(Value);
        ftDoub:      TDoubleProc(call)(Value);
        ftExtended:  TExtendedProc(call)(Value);
        ftCurr:      TCurrencyProc(call)(Value);
      end;
    picIndexed:
      case ft of
        ftSingle:    TSingleIndexed(call)(Index,Value);
        ftDoub:      TDoubleIndexed(call)(Index,Value);
        ftExtended:  TExtendedIndexed(call)(Index,Value);
        ftCurr:      TCurrencyIndexed(call)(Index,Value);
      end;
  end;
end;

{$ifndef NOVARIANTS}
procedure TPropInfo.GetVariantProp(Instance: TObject; var result: Variant);
  procedure SubProc(pic: TPropInfoCall; const call: TMethod); // avoid try..finally
  type
    TGetProc = function: variant of object;
    TGetIndexed = function(Index: Integer): variant of object;
  begin
    case pic of
      picMethod:  result := TGetProc(call);
      picIndexed: result := TGetIndexed(call)(Index);
      else result := '';
    end;
  end;
var pic: TPropInfoCall;
    call: TMethod;
begin
  pic := Getter(Instance,@call);
  if pic=picField then
    SetVariantByValue(PVariant(call.Data)^,result) else
    SubProc(pic,call);
end;

procedure TPropInfo.SetVariantProp(Instance: TObject; const Value: Variant);
type
  TSetProc = procedure(const Value: variant) of object;
  TSetIndexed = procedure(Index: integer; const Value: variant) of object;
var call: TMethod;
begin
  case Setter(Instance,@call) of
    picField:   PVariant(call.Data)^ := Value;
    picMethod:  TSetProc(call)(Value);
    picIndexed: TSetIndexed(call)(Index,Value);
  end;
end;
{$endif NOVARIANTS}


{ TEnumType }

{$ifdef FPC_ENUMHASINNER}
function TEnumType.MinValue: Longint;
begin
  result := inner.iMinValue;
end;

function TEnumType.MaxValue: Longint;
begin
  result := inner.iMaxValue;
end;

function TEnumType.BaseType: PPTypeInfo;
begin
  result := inner.iBaseType;
end;
{$endif FPC_ENUMHASINNER}

function TEnumType.GetEnumName(const Value): PShortString;
begin
  result := GetEnumNameOrd(FromOrdType(OrdType,@Value));
end;

function TEnumType.GetEnumNameOrd(Value: Integer): PShortString;
// note: FPC doesn't align NameList (cf. GetEnumName() function in typinfo.pp)
{$ifdef PUREPASCAL}
begin
  result := @NameList;
  if cardinal(Value)<=cardinal(MaxValue) then
    while Value>0 do begin
      inc(PByte(result),ord(result^[0])+1);
      dec(Value);
    end else
    result := @NULL_SHORTSTRING;
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=PEnumType edx=Value
        xor     ecx, ecx
        {$ifdef FPC_ENUMHASINNER}
        cmp     edx, [eax].TEnumType.inner.iMaxValue
        {$else}
        cmp     edx, [eax].TEnumType.MaxValue
        {$endif}
        lea     eax, [eax].TEnumType.NameList
        ja      @0
        test    edx, edx
        jz      @z
        push    edx
        shr     edx, 2 // fast pipelined by-four scanning
        jz      @1
@4:     dec     edx
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        jnz     @4
        pop     edx
        and     edx, 3
        jnz     @s
@z:     ret
@1:     pop     edx
@s:     movzx   ecx, byte ptr[eax]
        dec     edx
        lea     eax, [eax + ecx + 1] // next short string
        jnz     @s
        ret
@0:     lea     eax, NULL_SHORTSTRING
end;
{$endif}

function TEnumType.GetSetNameCSV(Value: integer; SepChar: AnsiChar;
  FullSetsAsStar: boolean): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    GetSetNameCSV(W,Value,SepChar,FullSetsAsStar);
    W.SetText(result);
  finally
    W.Free;
  end;
end;

procedure TEnumType.GetSetNameCSV(W: TTextWriter; Value: integer; SepChar: AnsiChar;
  FullSetsAsStar: boolean);
var j: integer;
    PS: PShortString;
begin
  W.Add('[');
  if FullSetsAsStar and GetAllBits(Value,MaxValue+1) then
    W.AddShort('"*"') else begin
    PS := @NameList;
    for j := MinValue to MaxValue do begin
      if GetBitPtr(@Value,j) then begin
        W.Add('"');
        if twoTrimLeftEnumSets in W.CustomOptions then
          W.AddTrimLeftLowerCase(PS) else
          W.AddShort(PS^);
        W.Add('"',SepChar);
      end;
      inc(PByte(PS),ord(PS^[0])+1); // next item
    end;
  end;
  W.CancelLastComma;
  W.Add(']');
end;

function TEnumType.GetSetNameAsDocVariant(Value: integer; FullSetsAsStar: boolean): variant;
var j: integer;
    PS: PShortString;
    arr: TDocVariantData;
begin
  arr.InitFast;
  if FullSetsAsStar and GetAllBits(Value,MaxValue+1) then
    arr.AddItem('*') else begin
    PS := @NameList;
    for j := MinValue to MaxValue do begin
      if GetBitPtr(@Value,j) then
        arr.AddItem(PS^);
      inc(PByte(PS),ord(PS^[0])+1); // next item
    end;
  end;
  result := variant(arr);
end;

function TEnumType.GetEnumNameValue(Value: PUTF8Char; ValueLen: integer;
  AlsoTrimLowerCase: boolean): Integer;
begin
  if (Value<>nil) and (ValueLen>0) then begin
    result := FindShortStringListExact(@NameList,
      MaxValue,Value,ValueLen);
    if (result<0) and AlsoTrimLowerCase then
      result := FindShortStringListTrimLowerCase(@NameList,
        MaxValue,Value,ValueLen);
  end else
    result := -1;
end;

function TEnumType.GetEnumNameValue(const EnumName: ShortString): Integer;
begin
  result := GetEnumNameValue(@EnumName[1],ord(EnumName[0]));
end;

function TEnumType.GetEnumNameValue(Value: PUTF8Char): Integer;
begin
  result := GetEnumNameValue(Value,StrLen(Value));
end;

{$ifdef HASINLINE}
function TEnumType.GetEnumNameTrimed(const Value): RawUTF8;
begin
  result := TrimLeftLowerCaseShort(GetEnumName(Value));
end;
{$else}
{$ifdef PUREPASCAL}
function TEnumType.GetEnumNameTrimed(const Value): RawUTF8;
begin
  result := TrimLeftLowerCaseShort(GetEnumName(Value));
end;
{$else}
function TEnumType.GetEnumNameTrimed(const Value): RawUTF8;
asm
        push    ecx
        call    TEnumType.GetEnumName
        pop     edx
        jmp     TrimLeftLowerCaseShort
end;
{$endif}
{$endif}

function TEnumType.GetCaption(const Value): string;
// GetCaptionFromPCharLen() expect ASCIIz -> use temp RawUTF8
begin
  GetCaptionFromPCharLen(pointer(GetEnumNameTrimed(Value)),result);
end;

procedure TEnumType.GetEnumNameTrimedAll(var result: RawUTF8; const Prefix: RawUTF8;
  quotedValues: boolean; const Suffix: RawUTF8);
begin
  GetEnumNameAll(result,Prefix,quotedValues,Suffix,{trimed=}true);
end;

function TEnumType.GetEnumNameAllAsJSONArray(TrimLeftLowerCase, UnCamelCased: boolean): RawUTF8;
begin
  GetEnumNameAll(result,'[',{quoted=}true,']',TrimLeftLowerCase,UnCamelCased);
end;

procedure TEnumType.GetEnumNameAll(var result: RawUTF8; const Prefix: RawUTF8;
  quotedValues: boolean; const Suffix: RawUTF8; trimedValues, unCamelCased: boolean);
var i: integer;
    V: PShortString;
    uncamel: string;
    temp: TTextWriterStackBuffer;
begin
  with TTextWriter.CreateOwnedStream(temp) do
  try
    AddString(Prefix);
    V := @NameList;
    for i := MinValue to MaxValue do begin
      if quotedValues then
        Add('"');
      if unCamelCased then begin
        GetCaptionFromTrimmed(V,uncamel);
        AddNoJSONEscapeString(uncamel);
      end else
      if trimedValues then
        AddTrimLeftLowerCase(V) else
        AddShort(V^);
      if quotedValues then
        Add('"');
      Add(',');
      inc(PByte(V),length(V^)+1);
    end;
    CancelLastComma;
    AddString(Suffix);
    SetText(result);
  finally
    Free;
  end;
end;

procedure TEnumType.GetEnumNameAll(var result: TRawUTF8DynArray;
  TrimLeftLowerCase: boolean);
var max,i: integer;
    V: PShortString;
begin
  Finalize(result);
  max := MaxValue-MinValue;
  SetLength(result,max+1);
  V := @NameList;
  for i := 0 to max do begin
    if TrimLeftLowerCase then
      result[i] := TrimLeftLowerCaseShort(V) else
      result[i] := RawUTF8(V^);
    inc(PByte(V),length(V^)+1);
  end;
end;

procedure TEnumType.AddCaptionStrings(Strings: TStrings; UsedValuesBits: Pointer);
var i, L: PtrInt;
    Line: array[byte] of AnsiChar;
    P: PAnsiChar;
    V: PShortString;
    s: string;
begin
  if @self=nil then
    exit;
  {$ifndef LVCL}
  Strings.BeginUpdate;
  try
  {$endif}
    V := @NameList;
    for i := MinValue to MaxValue do begin
      if (UsedValuesBits=nil) or
         GetBitPtr(UsedValuesBits,i) then begin
        L := ord(V^[0]);
        P := @V^[1];
        while (L>0) and (P^ in ['a'..'z']) do begin // ignore left lowercase chars
          inc(P);
          dec(L);
        end;
        if L=0 then begin
          L := ord(V^[0]);
          P := @V^[1];
        end;
        Line[L] := #0; // GetCaptionFromPCharLen() expect it as ASCIIZ
        MoveFast(P^,Line,L);
        GetCaptionFromPCharLen(Line,s);
        Strings.AddObject(s,pointer(i));
      end;
      inc(PByte(V),length(V^)+1);
    end;
  {$ifndef LVCL}
  finally
    Strings.EndUpdate;
  end;
  {$endif}
end;

function TEnumType.GetCaptionStrings(UsedValuesBits: Pointer=nil): string;
var List: TStringList;
begin
  List := TStringList.Create;
  try
    AddCaptionStrings(List,UsedValuesBits);
    result := List.Text;
  finally
    List.Free;
  end;
end;

function TEnumType.GetEnumNameTrimedValue(const EnumName: ShortString): Integer;
begin
  result := GetEnumNameTrimedValue(@EnumName[1],ord(EnumName[0]));
end;

function TEnumType.GetEnumNameTrimedValue(Value: PUTF8Char; ValueLen: integer): Integer;
begin
  if Value=nil then
    result := -1 else begin
    if ValueLen=0 then
      ValueLen := StrLen(Value);
    result := FindShortStringListTrimLowerCase(@NameList,MaxValue,Value,ValueLen);
    if result<0 then
      result := FindShortStringListExact(@NameList,MaxValue,Value,ValueLen);
  end;
end;

function TEnumType.SizeInStorageAsEnum: Integer;
begin
  result := ORDTYPE_SIZE[OrdType]; // MaxValue does not work e.g. with WordBool
end;

procedure TEnumType.SetEnumFromOrdinal(out Value; Ordinal: Integer);
begin
  ToOrdType(OrdType,@Value,Ordinal);  // MaxValue does not work e.g. with WordBool
end;

function TEnumType.SizeInStorageAsSet: Integer;
begin
  case MaxValue of
  0..7:   result := 1;
  8..15:  result := 2;
  16..31: result := 4;
  else    result := 0;
  end;
end;


{ TTypeInfo - not inlined methods }

function TTypeInfo.ClassCreate: TObject;
var instance: TClassInstance;
begin
  instance.Init(ClassType^.ClassType);
  result := instance.CreateNew;
end;

function TTypeInfo.ClassFieldCount(onlyWithoutGetter: boolean): integer;
begin
  result := ClassFieldCountWithParents(ClassType^.ClassType,onlyWithoutGetter);
end;

function TTypeInfo.ClassSQLFieldType: TSQLFieldType;
const T_: array[0..5{$ifndef LVCL}+1{$endif}] of TClass = (
        TSQLRecordMany,TSQLRecord,TRawUTF8List,TStrings,TObjectList,TObject
        {$ifndef LVCL},TCollection{$endif});
var CT: PClassType;
    C: TClass;
    T: PClassArray;
begin
  CT := AlignTypeData(PAnsiChar(@Name[1])+ord(Name[0])); // inlined ClassType
  C := CT^.ClassType;
  T := @T_;
  result := sftUnknown;
  while true do // unrolled several InheritsFrom() calls
    if C<>T[0] then
    if C<>T[1] then
    if (C<>T[2]) and (C<>T[3]) and (C<>T[4]){$ifndef LVCL}and (C<>T[6]){$endif} then
      if CT^.ParentInfo<>nil then begin
        if CT^.PropCount>0 then
          result := sftObject; // identify any class with published properties
        {$ifdef HASDIRECTTYPEINFO}
        with PTypeInfo(CT^.ParentInfo)^ do
        {$else} // circumvent weird Delphi inlining compiler random bug
        with CT^.ParentInfo^^ do
        {$endif} // get parent ClassType
          CT := AlignTypeData(PAnsiChar(@Name[1])+ord(Name[0]));
        C := CT^.ClassType;
        if C<>T[5] then
          continue else
          break;
      end else break
    else begin
      result := sftObject; // TStrings,TObjectList,TRawUTF8List or TCollection
      break;
    end else begin
      result := sftID; // TSQLRecord field is pointer(RecordID), not an Instance
      break;
    end else begin
      result := sftMany; // no data is stored here, but in a pivot table
      break;
    end;
end;

function TTypeInfo.InheritsFrom(AClass: TClass): boolean;
{$ifdef FPC_OR_PUREPASCAL}
var CT: PClassType;
begin
  CT := ClassType;
  repeat
    if CT^.ClassType={$ifndef FPC}pointer{$endif}(AClass) then begin
      result := true;
      exit;
    end;
    if CT^.ParentInfo = nil then
      break else
      CT := CT^.ParentInfo^.ClassType;
  until CT = nil;
  result := false;
end;
{$else}
asm     // eax=PClassType edx=AClass
@1:     movzx   ecx, byte ptr[eax].TTypeInfo.Name
        lea     eax, [eax + ecx].TTypeInfo.Name[1]
        cmp     edx, [eax].TClassType.ClassType
        jz      @2
        mov     eax, [eax].TClassType.ParentInfo
        test    eax, eax
        jz      @3 // no parent
        mov     eax, [eax] // get parent type info
        jmp     @1
@3:     rep     ret
@2:     mov     eax, 1
end;
{$endif}

function TTypeInfo.GetSQLFieldType: TSQLFieldType;
begin // very fast, thanks to the TypeInfo() compiler-generated function
  case Kind of
    tkInteger: begin
      result := sftInteger; // works also for otSQWord,otUQWord
      exit; // direct exit is faster in generated asm code
    end;
    tkInt64:
      if (@self=TypeInfo(TRecordReference)) or
         (@self=TypeInfo(TRecordReferenceToBeDeleted)) then begin
        result := sftRecord;
        exit;
      end else
      if @self=TypeInfo(TCreateTime) then begin
        result := sftCreateTime;
        exit;
      end else
      if @self=TypeInfo(TModTime) then begin
        result := sftModTime;
        exit;
      end else
      if @self=TypeInfo(TTimeLog) then begin
        result := sftTimeLog;
        exit;
      end else
      if @self=TypeInfo(TUnixTime) then begin
        result := sftUnixTime;
        exit;
      end else
      if @self=TypeInfo(TUnixMSTime) then begin
        result := sftUnixMSTime;
        exit;
      end else
      if @self=TypeInfo(TID) then begin
        result := sftTID;
        exit;
      end else
      if @self=TypeInfo(TSessionUserID) then begin
        result := sftSessionUserID;
        exit;
      end else
      if @self=TypeInfo(TRecordVersion) then begin
        result := sftRecordVersion;
        exit;
      end else
      if (ord(Name[1]) and $df=ord('T')) and // T...ID pattern in type name -> TID
         (PWord(@Name[ord(Name[0])-1])^ and $dfdf=ord('I')+ord('D') shl 8) then begin
        result := sftTID;
        exit;
      end else begin
        result := sftInteger;
        exit;
      end;
    {$ifdef FPC}
    tkBool: begin
      result := sftBoolean;
      exit;
    end;
    tkQWord: begin
      result := sftInteger;
      exit;
    end;
    {$endif FPC}
    tkSet: begin
      result := sftSet;
      exit;
    end;
    tkEnumeration:
      {$ifndef FPC}
      if @self=TypeInfo(Boolean) then begin
        result := sftBoolean;
        exit;
      end else
      {$endif FPC}
      if @self=TypeInfo(WordBool) then begin // circumvent a Delphi RTTI bug
        result := sftBoolean;
        exit;
      end else
      begin
        result := sftEnumerate;
        exit;
      end;
    tkFloat:
      if @self=TypeInfo(Currency) then begin
        result := sftCurrency;
        exit;
      end else
      if @self=TypeInfo(TDateTime) then begin
        result := sftDateTime;
        exit;
      end else
      if @self=TypeInfo(TDateTimeMS) then begin
        result := sftDateTimeMS;
        exit;
      end else begin
        result := sftFloat;
        exit;
      end;
      {$ifdef FPC}tkLStringOld,{$endif} tkLString:
      // do not use AnsiStringCodePage since AnsiString = GetAcp may change
      if (@self=TypeInfo(TSQLRawBlob)) or
         (@self=TypeInfo(RawByteString)) then begin
        result := sftBlob;
        exit;
      end else
      if @self=TypeInfo(WinAnsiString) then begin
        result := sftAnsiText;
        exit;
      end else begin
        result := sftUTF8Text; // CP_UTF8,CP_UTF16 and any other to UTF-8 text
        exit;
      end;
    {$ifdef HASVARUSTRING}tkUString,{$endif} tkChar, tkWChar, tkWString: begin
      result := sftUTF8Text;
      exit;
    end;
    tkDynArray: begin
      result := sftBlobDynArray;
      exit;
    end;
    {$ifdef PUBLISHRECORD}
    tkRecord{$ifdef FPC},tkObject{$endif}: begin
      result := sftUTF8Custom;
      exit;
    end;
    {$endif}
    {$ifndef NOVARIANTS}
    tkVariant: begin // this function does not need to handle sftNullable
      result := sftVariant;
      exit;
    end;
    {$endif NOVARIANTS}
    tkClass: begin
      result := ClassSQLFieldType;
      exit;
    end;
    // note: tkString (shortstring) and tkInterface not handled
    else begin
      result := sftUnknown;
      exit;
    end;
  end;
end;

function TTypeInfo.EnumBaseType: PEnumType;
{$ifdef FPC}
var base: PTypeInfo;
begin
  result := GetTypeData(self);
  if Kind=tkBool then
    exit; // circumvent diverse RTTI encoding
  base := DeRef(result^.BaseType);
  if (base<>nil) and (base<>@self) then // no redirection if already the base type
    result := GetTypeData(base^);
end;
{$else}
{$ifdef HASINLINENOTX86}
begin
  with PEnumType(@Name[ord(Name[0])+1])^.BaseType^^ do
    result := @Name[ord(Name[0])+1];
end;
{$else}
asm     // very fast code
        movzx   edx, byte ptr[eax].TTypeInfo.Name
        mov     eax, [eax + edx].TTypeInfo.Name[1].TEnumType.BaseType
        mov     eax, [eax]
        movzx   edx, byte ptr[eax].TTypeInfo.Name
        lea     eax, [eax + edx].TTypeInfo.Name[1]
end;
{$endif}
{$endif FPC}

function TTypeInfo.SetEnumType: PEnumType;
begin
  if (@self=nil) or (Kind<>tkSet) then
    result := nil else
    {$ifdef FPC}
    result := PTypeInfo(GetSetBaseEnum(@self))^.EnumBaseType;
    {$else}
    result := PPTypeInfo(PPointer(PtrUInt(@Name[ord(Name[0])+1])+SizeOf(TOrdType))^)^.EnumBaseType;
    {$endif FPC}
end;

function TTypeInfo.DynArrayItemType(aDataSize: PInteger): PTypeInfo;
begin
  if @self=nil then
    result := nil else
    result := DynArrayTypeInfoToRecordInfo(@self,aDataSize);
end;

function TTypeInfo.DynArrayItemSize: integer;
begin
  if @self=nil then
    result := 0 else
    DynArrayTypeInfoToRecordInfo(@self,@result);
end;

function TTypeInfo.DynArraySQLFieldType: TSQLFieldType;
var item: mORMot.PTypeInfo;
begin
  if @self=nil then
    result := sftUnknown else begin
    item := DynArrayTypeInfoToRecordInfo(@self);
    if item=nil then
      result := sftUnknown else
      result := item^.GetSQLFieldType;
  end;
end;

function TTypeInfo.AnsiStringCodePage: integer;
begin
  {$ifdef HASCODEPAGE}
  if @self=TypeInfo(TSQLRawBlob) then
    result := CP_SQLRAWBLOB else
  if Kind=tkLString then // has tkLStringOld any codepage? -> UTF-8
    result := PWord(GetTypeData(self))^ else
  {$else}
  if @self=TypeInfo(RawUTF8) then
    result := CP_UTF8 else
  if @self=TypeInfo(WinAnsiString) then
    result := CODEPAGE_US else
  if @self=TypeInfo(RawUnicode) then
    result := CP_UTF16 else
  if @self=TypeInfo(TSQLRawBlob) then
    result := CP_SQLRAWBLOB else
  if @self=TypeInfo(RawByteString) then
    result := CP_RAWBYTESTRING else
  if @self=TypeInfo(AnsiString) then
    result := CP_ACP else
  {$endif HASCODEPAGE}
    result := CP_UTF8; // default is UTF-8
end;

function TTypeInfo.InterfaceGUID: PGUID;
begin
  if (@self=nil) or (Kind<>tkInterface) then
    result := nil else
    result := @InterfaceType^.IntfGuid;
end;

function TTypeInfo.InterfaceUnitName: PShortString;
begin
  if (@self=nil) or (Kind<>tkInterface) then
    result := @NULL_SHORTSTRING else
    result := @InterfaceType^.IntfUnit;
end;

function TTypeInfo.InterfaceAncestor: PTypeInfo;
begin
  if (@self=nil) or (Kind<>tkInterface) then
    result := nil else
    result := Deref(InterfaceType^.IntfParent);
end;

procedure TTypeInfo.InterfaceAncestors(out Ancestors: PTypeInfoDynArray;
  OnlyImplementedBy: TInterfacedObjectClass;
  out AncestorsImplementedEntry: TPointerDynArray);
var n: integer;
    nfo: PTypeInfo;
    typ: PInterfaceTypeData;
    entry: pointer;
begin
  if (@self=nil) or (Kind<>tkInterface) then
    exit;
  n := 0;
  typ := InterfaceType;
  repeat
    if typ^.IntfParent=nil then
      exit;
    nfo := Deref(typ^.IntfParent);
    if nfo=TypeInfo(IInterface) then
      exit;
    typ := nfo^.InterfaceType;
    if ifHasGuid in typ^.IntfFlags then begin
      if OnlyImplementedBy<>nil then begin
        entry := OnlyImplementedBy.GetInterfaceEntry(typ^.IntfGuid);
        if entry=nil then
          continue;
        SetLength(AncestorsImplementedEntry,n+1);
        AncestorsImplementedEntry[n] := entry;
      end;
      SetLength(Ancestors,n+1);
      Ancestors[n] := nfo;
      inc(n);
    end;
  until false;
end;

{$ifdef FPC_PROVIDE_ATTR_TABLE}
function TTypeInfo.AttributeTable: PFPCAttributeTable;
begin
  result := GetTypeDataClean(self);
end;
{$endif FPC_PROVIDE_ATTR_TABLE}


{ TClassProp }

function TClassProp.FieldProp(const PropName: shortstring): PPropInfo;
var i: integer;
begin
  if @self<>nil then begin
    result := @PropList;
    for i := 1 to PropCount do
      if IdemPropName(result^.Name,PropName) then
        exit else
        result := result^.Next;
  end;
  result := nil;
end;


{ TClassType }

function TClassType.ClassProp: PClassProp;
begin
  if pointer(@self)<>nil then
    result := AlignToPtr(@UnitName[ord(UnitName[0])+1]) else
    result := nil; // avoid GPF
end;

function TClassType.RTTISize: integer;
var C: PClassProp;
    P: PPropInfo;
    i: Integer;
begin
  result := 0;
  C := ClassProp;
  if C=nil then
    exit;
  P := @C^.PropList;
  for i := 1 to C^.PropCount do
    P := P^.Next;
  result := PtrUInt(P)-PtrUInt(@self);
end;

function TClassType.InheritsFrom(AClass: TClass): boolean;
{$ifdef FPC_OR_PUREPASCAL}
var P: PTypeInfo;
begin
  result := true;
  if ClassType=AClass then
    exit;
  P := DeRef(ParentInfo);
  while P<>nil do
    with P^.ClassType^ do
    if ClassType=AClass then
      exit else
      P := DeRef(ParentInfo);
  result := false;
end;
{$else}
asm // eax=PClassType edx=AClass
        cmp     [eax].TClassType.ClassType, edx
        jz      @3
@2:     mov     eax, [eax].TClassType.ParentInfo
        test    eax, eax
        jz      @0
@1:     mov     eax, [eax]
        movzx   ecx, byte ptr[eax].TTypeInfo.Name
        lea     eax, [eax + ecx].TTypeInfo.Name[1]
        cmp     edx, [eax].TClassType.ClassType
        jnz     @2
@3:     mov     eax, 1
@0:
end;
{$endif}



function SQLWhereIsEndClause(const Where: RawUTF8): boolean;
begin
  result := IdemPCharArray(pointer(Where),['ORDER BY ','GROUP BY ',
    'LIMIT ','OFFSET ','LEFT ','RIGHT ','INNER ','OUTER ','JOIN '])>=0;
end;

function SQLFromWhere(const Where: RawUTF8): RawUTF8;
begin
  if Where='' then
    result := '' else
  if SQLWhereIsEndClause(Where) then
    result := ' '+Where else
    result := ' WHERE '+Where;
end;

function SQLFromSelect(const TableName, Select, Where, SimpleFields: RawUTF8): RawUTF8;
begin
  if Select='*' then
     // don't send BLOB values to query: retrieve all other fields
    result := 'SELECT '+SimpleFields  else
    result := 'SELECT '+Select;
  result := result+' FROM '+TableName+SQLFromWhere(Where);
end;

function SelectInClause(const PropName: RawUTF8; const Values: array of RawUTF8;
  const Suffix: RawUTF8; ValuesInlinedMax: integer): RawUTF8;
var n, i: integer;
    temp: TTextWriterStackBuffer;
begin
  n := length(Values);
  if n>0 then
    with TTextWriter.CreateOwnedStream(temp) do
    try
      AddString(PropName);
      if n=1 then begin
        if ValuesInlinedMax>1 then
          AddShort('=:(') else
          Add('=');
        AddQuotedStr(pointer(Values[0]),'''');
        if ValuesInlinedMax>1 then
          AddShort('):');
      end else begin
        AddShort(' in (');
        for i := 0 to n-1 do begin
          if ValuesInlinedMax>n then
            Add(':','(');
          AddQuotedStr(pointer(Values[i]),'''');
          if ValuesInlinedMax>n then
            AddShort('):,') else
            Add(',');
        end;
        CancelLastComma;
        Add(')');
      end;
      AddString(Suffix);
      SetText(result);
    finally
      Free;
    end else
    result := '';
end;

function SelectInClause(const PropName: RawUTF8; const Values: array of Int64;
  const Suffix: RawUTF8; ValuesInlinedMax: integer): RawUTF8;
var n, i: integer;
    temp: TTextWriterStackBuffer;
begin
  n := length(Values);
  if n>0 then
    with TTextWriter.CreateOwnedStream(temp) do
    try
      AddString(PropName);
      if n=1 then begin
        if ValuesInlinedMax>1 then
          AddShort('=:(') else
          Add('=');
        Add(Values[0]);
        if ValuesInlinedMax>1 then
          AddShort('):');
      end else begin
        AddShort(' in (');
        for i := 0 to n-1 do begin
          if ValuesInlinedMax>n then
            Add(':','(');
          Add(Values[i]);
          if ValuesInlinedMax>n then
            AddShort('):,') else
            Add(',');
        end;
        CancelLastComma;
        Add(')');
      end;
      AddString(Suffix);
      SetText(result);
    finally
      Free;
    end else
    result := '';
end;

{ TSQLRecordFill }

function TSQLRecordFill.GetJoinedFields: boolean;
begin
  if self=nil then
    result := false else
    result := fJoinedFields;
end;

function TSQLRecordFill.TableMapFields: TSQLFieldBits;
begin
  if self=nil then
    FillZero(result) else
    result := fTableMapFields;
end;

procedure TSQLRecordFill.AddMap(aRecord: TSQLRecord; aField: TSQLPropInfo;
  aIndex: integer);
begin
  if (self=nil) or (aRecord=nil) then
    exit;
  if fTableMapCount>=length(fTableMap) then
    SetLength(fTableMap,fTableMapCount+fTableMapCount shr 1+16);
  with fTableMap[fTableMapCount] do begin
    Dest := aRecord;
    DestField := aField;
    TableIndex := aIndex;
    inc(fTableMapCount);
  end;
end;

procedure TSQLRecordFill.AddMap(aRecord: TSQLRecord; const aFieldName: RawUTF8;
  aIndex: integer);
var aFieldIndex: integer;
begin
  if (self<>nil) and (aRecord<>nil) then
    if IsRowID(pointer(aFieldName)) then
      AddMap(aRecord,nil,aIndex) else
      with aRecord.RecordProps do begin
        aFieldIndex := Fields.IndexByName(aFieldName);
        if aFieldIndex>=0 then begin // only map if column name is a valid field
          include(fTableMapFields,aFieldIndex);
          AddMap(aRecord,Fields.List[aFieldIndex],aIndex);
        end;
      end;
end;

procedure TSQLRecordFill.AddMapSimpleFields(aRecord: TSQLRecord;
  const aProps: array of TSQLPropInfo; var aIndex: integer);
var i: integer;
begin
  AddMap(aRecord,nil,aIndex);
  inc(aIndex);
  for i := 0 to high(aProps) do
  if aProps[i].SQLFieldTypeStored<>sftID then begin
    AddMap(aRecord,aProps[i],aIndex);
    inc(aIndex);
  end;
end;

destructor TSQLRecordFill.Destroy;
begin
  try
    UnMap; // release fTable instance if necessary
  finally
    inherited;
  end;
end;

function TSQLRecordFill.Fill(aRow: integer): Boolean;
begin
  if (self=nil) or (Table=nil) or (cardinal(aRow)>cardinal(Table.fRowCount)) then
    Result := False else begin
    Fill(@Table.fResults[aRow*Table.FieldCount]);
    Result := True;
  end;
end;

function TSQLRecordFill.Fill(aRow: integer; aDest: TSQLRecord): Boolean;
begin
  if (self=nil) or (aDest=nil) or
     (Table=nil) or (cardinal(aRow)>cardinal(Table.fRowCount)) then
    Result := False else begin
    Fill(@Table.fResults[aRow*Table.FieldCount],aDest);
    Result := True;
  end;
end;

procedure TSQLRecordFill.Fill(aTableRow: PPUtf8CharArray);
var f: integer;
begin
  if (self<>nil) and (aTableRow<>nil) then
    for f := 0 to fTableMapCount-1 do
      with fTableMap[f] do
        if DestField=nil then
          SetID(aTableRow[TableIndex],Dest.fID) else
          DestField.SetValue(Dest,aTableRow[TableIndex],TableIndex in fTable.fFieldParsedAsString);
end;

procedure TSQLRecordFill.Fill(aTableRow: PPUtf8CharArray; aDest: TSQLRecord);
var f: integer;
begin
  if (self<>nil) and (aTableRow<>nil) then
  for f := 0 to fTableMapCount-1 do
    with fTableMap[f] do
      if DestField=nil then
        SetID(aTableRow[TableIndex],aDest.fID) else
        DestField.SetValue(aDest,aTableRow[TableIndex],TableIndex in fTable.fFieldParsedAsString);
end;

procedure TSQLRecordFill.ComputeSetUpdatedFieldBits(Props: TSQLRecordProperties;
  out Bits: TSQLFieldBits);
begin
  if (self<>nil) and (fTable<>nil) and (fTableMapRecordManyInstances=nil) then
    // within FillPrepare/FillOne loop: update ID, TModTime and mapped fields
    Bits := fTableMapFields+Props.ComputeBeforeUpdateFieldsBits else
    // update all simple/custom fields (also for FillPrepareMany)
    Bits := Props.SimpleFieldsBits[soUpdate];
end;

procedure TSQLRecordFill.Map(aRecord: TSQLRecord; aTable: TSQLTable;
  aCheckTableName: TSQLCheckTableName);
var f: integer;
    ColumnName: PUTF8Char;
    FieldName: RawUTF8;
    Props: TSQLRecordProperties;
begin
  if aTable=nil then // avoid any GPF
    exit;
  fTable := aTable;
  if aTable.fResults=nil then
    exit; // void content
  Props := aRecord.RecordProps;
  for f := 0 to aTable.FieldCount-1 do begin
    ColumnName := aTable.fResults[f];
    if aCheckTableName=ctnNoCheck then
      Utf8ToRawUTF8(ColumnName,FieldName) else
      if IdemPChar(ColumnName,pointer(Props.SQLTableNameUpperWithDot)) then
        Utf8ToRawUTF8(ColumnName+length(Props.SQLTableNameUpperWithDot),FieldName) else
        if aCheckTableName=ctnMustExist then
          continue else
          Utf8ToRawUTF8(ColumnName,FieldName);
    AddMap(aRecord,FieldName,f);
  end;
  fFillCurrentRow := 1; // point to first data row (0 is field names)
end;

procedure TSQLRecordFill.UnMap;
var i: integer;
begin
  if self=nil then
    exit;
  fTableMapCount := 0;
  fFillCurrentRow :=  0;
  // release TSQLRecordMany.fDestID^ instances set by TSQLRecord.FillPrepareMany()
  for i := 0 to length(fTableMapRecordManyInstances)-1 do
  with fTableMapRecordManyInstances[i] do begin
    TObject(fDestID^).Free;
    fDestID^ := 0;
    fSourceID^ := 0;
  end;
  fTableMapRecordManyInstances := nil;
  FillZero(fTableMapFields);
  // free any previous fTable if necessary
  if Table<>nil then
  try
    if Table.OwnerMustFree then
      Table.Free;
  finally
    fTable := nil;
  end;
end;


{ TSQLRecord }

constructor TSQLRecord.Create;
var i: PtrInt;
begin
  // auto-instanciate any TSQLRecordMany instance
  with RecordProps do
    if pointer(ManyFields)<>nil then
    for i := 0 to length(ManyFields)-1 do
      ManyFields[i].SetInstance(self,TSQLRecordClass(ManyFields[i].ObjectClass).Create);
end;

constructor TSQLRecord.Create(const aSimpleFields: array of const; aID: TID);
begin
  Create;
  fID := aID;
  if not SimplePropertiesFill(aSimpleFields) then
    raise EORMException.CreateUTF8('Incorrect %.Create(aSimpleFields) call',[self]);
end;

function TSQLRecord.CreateCopy: TSQLRecord;
var f: PtrInt;
begin
  // create new instance
  result := RecordClass.Create;
  // copy properties content
  result.fID := fID;
  with RecordProps do
    for f := 0 to length(CopiableFields)-1 do
      CopiableFields[f].CopyValue(self,result);
end;

function TSQLRecord.CreateCopy(const CustomFields: TSQLFieldBits): TSQLRecord;
var f: integer;
begin
  result := RecordClass.Create;
  // copy properties content
  result.fID := fID;
  with RecordProps do
    for f := 0 to Fields.Count-1 do
      if (f in CustomFields) and (f in CopiableFieldsBits) then
        Fields.List[f].CopyValue(self,result);
end;

function TSQLRecord.GetNonVoidFields: TSQLFieldBits;
var f: integer;
begin
  FillZero(result);
  with RecordProps do
    for f := 0 to Fields.Count-1 do
      if (f in CopiableFieldsBits) and not Fields.List[f].IsValueVoid(self) then
        include(result,f);
end;

constructor TSQLRecord.Create(aClient: TSQLRest; aID: TID; ForUpdate: boolean=false);
begin
  Create;
  if aClient<>nil then
    aClient.Retrieve(aID,self,ForUpdate);
end;

constructor TSQLRecord.Create(aClient: TSQLRest; aPublishedRecord: TSQLRecord; ForUpdate: boolean);
begin
  Create;
  if aClient<>nil then
    aClient.Retrieve(aPublishedRecord.ID,self,ForUpdate);
end;

constructor TSQLRecord.Create(aClient: TSQLRest; const aSQLWhere: RawUTF8);
begin
  Create;
  if aClient<>nil then
    aClient.Retrieve(aSQLWhere,self);
end;

constructor TSQLRecord.Create(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
  const BoundsSQLWhere: array of const);
begin
  Create;
  if aClient<>nil then
    aClient.Retrieve(FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere),self);
end;

constructor TSQLRecord.Create(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
  const ParamsSQLWhere, BoundsSQLWhere: array of const);
begin
  Create;
  if aClient<>nil then
    aClient.Retrieve(FormatUTF8(FormatSQLWhere,ParamsSQLWhere,BoundsSQLWhere),self);
end;

constructor TSQLRecord.CreateFrom(const JSONRecord: RawUTF8);
begin
  Create;
  FillFrom(JSONRecord);
end;

constructor TSQLRecord.CreateFrom(P: PUTF8Char);
begin
  Create;
  FillFrom(P);
end;

{$ifndef NOVARIANTS}
constructor TSQLRecord.CreateFrom(const aDocVariant: variant);
begin
  Create;
  FillFrom(aDocVariant);
end;
{$endif}

class procedure TSQLRecord.InitializeTable(Server: TSQLRestServer;
  const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
var f: integer;
begin // is not part of TSQLRecordProperties because has been declared as virtual
  if (self<>nil) and (Server<>nil) and
     (Options*INITIALIZETABLE_NOINDEX<>INITIALIZETABLE_NOINDEX) then begin
    // ensure ID/RowID column is indexed
    if not (itoNoIndex4ID in Options) then
      if (FieldName='') or IsRowID(pointer(FieldName)) then
        Server.CreateSQLIndex(self,'ID',true); // for external tables
    // automatic column indexation of fields which are commonly searched by value
    with RecordProps do
    for f := 0 to Fields.Count-1 do
      with Fields.List[f] do
      if (FieldName='') or IdemPropNameU(FieldName,Name) then
        if ((aIsUnique in Attributes) and not (itoNoIndex4UniqueField in Options)) or
           ((SQLFieldType=sftRecord) and not (itoNoIndex4RecordReference in Options)) or
           ((SQLFieldType=sftRecordVersion) and not (itoNoIndex4RecordVersion in Options)) or
           ((SQLFieldType=sftID) and not (itoNoIndex4NestedRecord in Options)) or
           ((SQLFieldType=sftTID) and not (itoNoIndex4TID in Options)) then
            Server.CreateSQLIndex(self,Name,false);
  end; // failure in Server.CreateSQLIndex() above is ignored (may already exist)
end;

procedure TSQLRecord.FillFrom(aRecord: TSQLRecord);
begin
  if (self<>nil) and (aRecord<>nil) then
    FillFrom(aRecord, aRecord.RecordProps.CopiableFieldsBits);
end;

procedure TSQLRecord.FillFrom(aRecord: TSQLRecord; const aRecordFieldBits: TSQLFieldBits);
var i, f: integer;
    S, D: TSQLRecordProperties;
    SP: TSQLPropInfo;
    wasString: boolean;
    tmp: RawUTF8;
begin
  if (self=nil) or (aRecord=nil) or IsZero(aRecordFieldBits) then
    exit;
  D := RecordProps;
  if PSQLRecordClass(aRecord)^.InheritsFrom(PSQLRecordClass(self)^) then begin
    if PSQLRecordClass(aRecord)^=PSQLRecordClass(self)^ then
      fID := aRecord.fID; // same class -> ID values will match
    for f := 0 to D.Fields.Count-1 do
      if f in aRecordFieldBits then
        D.Fields.List[f].CopyValue(aRecord,self);
    exit;
  end;
  S := aRecord.RecordProps; // two diverse tables -> don't copy ID
  for i := 0 to S.Fields.Count-1 do
    if i in aRecordFieldBits then begin
      SP := S.Fields.List[i];
      if D.Fields.List[i].Name=SP.Name then // optimistic match
        f := i else
        f := D.Fields.IndexByName(SP.Name);
      if f>=0 then begin
        SP.GetValueVar(aRecord,False,tmp,@wasString);
        D.Fields.List[f].SetValueVar(Self,tmp,wasString);
      end;
    end;
end;

procedure TSQLRecord.FillFrom(Table: TSQLTable; Row: integer);
begin
  try
    FillPrepare(Table);
    if Table.InternalState<>fInternalState then
      fInternalState := Table.InternalState;
    FillRow(Row);
  finally
    FillClose; // avoid GPF in TSQLRecord.Destroy
  end;
end;

procedure TSQLRecord.FillFrom(const JSONTable: RawUTF8; Row: integer);
var Table: TSQLTableJSON;
    tmp: TSynTempBuffer; // work on a private copy
begin
  tmp.Init(JSONTable);
  try
    Table := TSQLTableJSON.Create('',tmp.buf,tmp.len);
    try
      FillFrom(Table,Row);
    finally
      Table.Free;
    end;
  finally
    tmp.Done;
  end;
end;

procedure TSQLRecord.FillFrom(const JSONRecord: RawUTF8; FieldBits: PSQLFieldBits);
var tmp: TSynTempBuffer; // work on a private copy
begin
  tmp.Init(JSONRecord);
  try
    FillFrom(tmp.buf,FieldBits); // now we can safely call FillFrom()
  finally
    tmp.Done;
  end;
end;

procedure TSQLRecord.FillFrom(P: PUTF8Char; FieldBits: PSQLFieldBits);
(* two possible formats = first not expanded, 2nd is expanded (most useful)
 {"fieldCount":9,"values":["ID","Int","Test","Unicode","Ansi","ValFloat","ValWord",
  "ValDate","Next",0,0,"abcde+?ef+?+?","abcde+?ef+?+?","abcde+?ef+?+?",
  3.14159265300000E+0000,1203,"2009-03-10T21:19:36",0]}
 {"ID":0,"Int":0,"Test":"abcde+?ef+?+?","Unicode":"abcde+?ef+?+?","Ansi":
 "abcde+?ef+?+?","ValFloat": 3.14159265300000E+0000,"ValWord":1203,
 "ValDate":"2009-03-10T21:19:36","Next":0} *)
var F: array[0..MAX_SQLFIELDS-1] of PUTF8Char; // store field/property names
    wasString: boolean;
    i, n: integer;
    Prop, Value: PUTF8Char;
begin
  if FieldBits<>nil then
    FillZero(FieldBits^);
  // go to start of object
  if P=nil then
    exit;
  while P^<>'{' do
    if P^=#0 then exit else inc(P);
  if Expect(P,FIELDCOUNT_PATTERN,14) then begin
    // not expanded format
    n := GetJSONIntegerVar(P)-1;
    if cardinal(n)>high(F) then
      exit;
    if Expect(P,ROWCOUNT_PATTERN,12) then
      GetJSONIntegerVar(P); // just ignore "rowCount":.. here
    if not Expect(P,VALUES_PATTERN,11) then
      exit;
    for i := 0 to n do
      F[i] := GetJSONField(P,P);
    for i := 0 to n do begin
      Value := GetJSONFieldOrObjectOrArray(P,@wasString,nil,true);
      FillValue(F[i],Value,wasString,FieldBits); // set properties from values
    end;
  end else
  if P^='{' then begin
    // expanded format
    inc(P);
    repeat
      Prop := GetJSONPropName(P);
      if (Prop=nil) or (P=nil) then break;
      Value := GetJSONFieldOrObjectOrArray(P,@wasString,nil,true);
      FillValue(Prop,Value,wasString,FieldBits); // set property from value
    until P=nil;
  end;
end;

{$ifndef NOVARIANTS}
procedure TSQLRecord.FillFrom(const aDocVariant: variant);
var json: RawUTF8;
begin
  if _Safe(aDocVariant)^.Kind=dvObject then begin
    VariantSaveJSON(aDocVariant,twJSONEscape, json);
    FillFrom(pointer(json));
  end;
end;
{$endif}

procedure TSQLRecord.FillPrepare(Table: TSQLTable; aCheckTableName: TSQLCheckTableName);
begin
  if self=nil then
    exit;
  if fFill=nil then
    fFill := TSQLRecordFill.Create else
    fFill.UnMap;
  fFill.Map(self,Table,aCheckTableName);
end;

function TSQLRecord.FillPrepare(aClient: TSQLRest; const aSQLWhere: RawUTF8;
  const aCustomFieldsCSV: RawUTF8; aCheckTableName: TSQLCheckTableName): boolean;
var T: TSQLTable;
begin
  result := false;
  FillClose; // so that no further FillOne will work
  if (self=nil) or (aClient=nil) then
    exit;
  T := aClient.MultiFieldValues(RecordClass,aCustomFieldsCSV,aSQLWhere);
  if T=nil then
    exit;
  T.OwnerMustFree := true;
  FillPrepare(T,aCheckTableName);
  result := true;
end;

function TSQLRecord.FillPrepare(aClient: TSQLRest; const FormatSQLWhere: RawUTF8;
  const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8=''): boolean;
var sqlwhere: RawUTF8;
begin
  sqlwhere := FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere);
  result := FillPrepare(aClient,sqlwhere,aCustomFieldsCSV);
end;

function TSQLRecord.FillPrepare(aClient: TSQLRest;
  const FormatSQLWhere: RawUTF8; const ParamsSQLWhere, BoundsSQLWhere: array of const;
  const aCustomFieldsCSV: RawUTF8): boolean;
var sqlwhere: RawUTF8;
begin
  sqlwhere := FormatUTF8(FormatSQLWhere,ParamsSQLWhere,BoundsSQLWhere);
  result := FillPrepare(aClient,sqlwhere,aCustomFieldsCSV);
end;

const
  INLINED_MAX = 10;

function TSQLRecord.FillPrepare(aClient: TSQLRest; const aIDs: array of Int64;
  const aCustomFieldsCSV: RawUTF8=''): boolean;
begin
  if high(aIDs)<0 then
    result := false else
    result := FillPrepare(aClient,SelectInClause('id',aIDs,'',INLINED_MAX),aCustomFieldsCSV);
end;

function TSQLRecord.FillRow(aRow: integer; aDest: TSQLRecord): boolean;
begin
  if self<>nil then
    if aDest=nil then
      result := fFill.Fill(aRow) else
      if fFill.fTableMapRecordManyInstances=nil then
        result := fFill.Fill(aRow,aDest) else
        raise EBusinessLayerException.CreateUTF8(
          '%.FillRow() forbidden after FillPrepareMany',[self]) else
    result := false;
end;

function TSQLRecord.FillOne(aDest: TSQLRecord=nil): boolean;
begin
  if (self=nil) or (fFill=nil) or (fFill.Table=nil) or
     (fFill.Table.fRowCount=0) or // also check if FillTable is emtpy
     (cardinal(fFill.FillCurrentRow)>cardinal(fFill.Table.fRowCount)) then
    result := false else begin
    FillRow(fFill.FillCurrentRow,aDest);
    inc(fFill.fFillCurrentRow);
    result := true;
  end;
end;

function TSQLRecord.FillRewind: boolean;
begin
  if (self=nil) or (fFill=nil) or (fFill.Table=nil) or (fFill.Table.fRowCount=0) then
    result := false else begin
    fFill.fFillCurrentRow := 1;
    result := true;
  end;
end;

procedure TSQLRecord.FillClose;
begin
  if self<>nil then
    fFill.UnMap;
end;

procedure TSQLRecord.AppendFillAsJsonValues(W: TJSONSerializer);
begin
  W.Add('[');
  while FillOne do begin
    GetJSONValues(W);
    W.Add(',');
  end;
  W.CancelLastComma;
  W.Add(']');
end;

procedure TSQLRecord.FillValue(PropName: PUTF8Char; Value: PUTF8Char;
  wasString: boolean; FieldBits: PSQLFieldBits);
var field: TSQLPropInfo;
begin
  if self<>nil then
    if IsRowID(PropName) then
      SetID(Value,fID) else begin
      field := RecordProps.Fields.ByName(PropName);
      if field<>nil then begin
        field.SetValue(self,Value,wasString);
        if FieldBits<>nil then
          Include(FieldBits^,field.PropertyIndex);
      end;
    end;
end;

function TSQLRecord.SetFieldSQLVars(const Values: TSQLVarDynArray): boolean;
var max, field: integer;
begin
  result := false;
  max := length(Values)-1;
  with RecordProps do begin
    // expect exact Values[] type match with FieldType[]
    if max<>Fields.Count-1 then // must match field count
      exit else
    for field := 0 to max do
      if Fields.List[field].SQLDBFieldType<>Values[field].VType then
        exit;
    // now we can safely update field values
    for field := 0 to max do
      Fields.List[field].SetFieldSQLVar(self,Values[field]);
  end;
  result := true;
end;

procedure TSQLRecord.GetBinaryValues(W: TFileBufferWriter);
var f: integer;
begin
  with RecordProps do
    for f := 0 to Fields.Count-1 do
      Fields.List[f].GetBinary(self,W);
end;

procedure TSQLRecord.GetBinaryValuesSimpleFields(W: TFileBufferWriter);
var f: integer;
begin
  with RecordProps do
    for f := 0 to SimpleFieldCount-1 do
      SimpleFields[f].GetBinary(self,W);
end;

procedure TSQLRecord.GetBinaryValues(W: TFileBufferWriter;
  const aFields: TSQLFieldBits);
var f: integer;
begin
  with RecordProps do
    for f := 0 to Fields.Count-1 do
      if f in aFields then
        Fields.List[f].GetBinary(self,W);
end;

function TSQLRecord.GetBinary: RawByteString;
var W: TFileBufferWriter;
begin
  W := TFileBufferWriter.Create(TRawByteStringStream);
  try
    W.WriteVarUInt64(fID);
    GetBinaryValues(W);
    W.Flush;
    result := (W.Stream as TRawByteStringStream).DataString;
  finally
    W.Free;
  end;
end;

function TSQLRecord.SetBinary(P,PEnd: PAnsiChar): Boolean;
begin
  P := pointer(FromVarUInt64Safe(pointer(P),pointer(PEnd),PQWord(@fID)^));
  result := SetBinaryValues(P,PEnd);
end;

function TSQLRecord.SetBinary(const binary: RawByteString): Boolean;
begin
  result := SetBinary(pointer(binary),PAnsiChar(pointer(binary))+length(binary));
end;

function TSQLRecord.SetBinaryValues(var P: PAnsiChar; PEnd: PAnsiChar): boolean;
var f: integer;
begin
  result := false;
  if P=nil then
    exit; // on error
  with RecordProps do
    for f := 0 to Fields.Count-1 do begin
      P := Fields.List[f].SetBinary(self,P,PEnd);
      if P=nil then
        exit;
    end;
  result := true;
end;

function TSQLRecord.SetBinaryValuesSimpleFields(var P: PAnsiChar; PEnd: PAnsiChar): Boolean;
var f: integer;
begin
  result := false;
  with RecordProps do
    for f := 0 to SimpleFieldCount-1 do begin
      P := SimpleFields[f].SetBinary(self,P,PEnd);
      if P=nil then
        exit; // on error
    end;
  result := true;
end;

procedure TSQLRecord.GetJSONValues(W: TJSONSerializer);
var i,n: integer;
    Props: TSQLPropInfoList;
begin
  if self=nil then
    exit;
  // write the row data
  if W.Expand then begin
    W.Add('{');
    if W.WithID then
      W.AddString(W.ColNames[0]);
  end;
  if W.WithID then begin
    W.Add(fID);
    W.Add(',');
    if (jwoID_str in W.fSQLRecordOptions) and W.Expand then begin
      W.AddShort('"ID_str":"');
      W.Add(fID);
      W.Add('"',',');
    end;
    n := 1;
  end else
    n := 0;
  if W.Fields<>nil then begin
    Props := RecordProps.Fields;
    for i := 0 to length(W.Fields)-1 do begin
      if W.Expand then begin
        W.AddString(W.ColNames[n]); // '"'+ColNames[]+'":'
        inc(n);
      end;
      Props.List[W.Fields[i]].GetJSONValues(Self,W);
      W.Add(',');
    end;
  end;
  W.CancelLastComma; // cancel last ','
  if W.Expand then
    W.Add('}');
end;

procedure TSQLRecord.AppendAsJsonObject(W: TJSONSerializer; Fields: TSQLFieldBits);
var i: integer;
    Props: TSQLPropInfoList;
begin
  if Self=nil then begin
    W.AddShort('null');
    exit;
  end;
  W.AddShort('{"ID":');
  W.Add(fID);
  if IsZero(Fields) then
    Fields := RecordProps.SimpleFieldsBits[soSelect];
  Props := RecordProps.Fields;
  for i := 0 to Props.Count-1 do
    if i in Fields then begin
      W.Add(',','"');
      W.AddNoJSONEscape(pointer(Props.List[i].Name),length(Props.List[i].Name));
      W.Add('"',':');
      Props.List[i].GetJSONValues(Self,W);
    end;
  W.Add('}');
end;

procedure TSQLRecord.AppendFillAsJsonArray(const FieldName: RawUTF8;
   W: TJSONSerializer; Fields: TSQLFieldBits=[]);
begin
  if FieldName<>'' then
    W.AddFieldName(FieldName);
  W.Add('[');
  while FillOne do begin
    AppendAsJsonObject(W,Fields);
    W.Add(',');
  end;
  W.CancelLastComma;
  W.Add(']');
  if FieldName<>'' then
    W.Add(',');
end;

{$ifndef NOVARIANTS}
procedure TSQLRecord.ForceVariantFieldsOptions(aOptions: TDocVariantOptions);
var i: integer;
    p: TSQLPropInfo;
begin
  if self<>nil then
  with RecordProps do
  if sftVariant in HasTypeFields then
  for i := 0 to Fields.Count-1 do
  begin
    p := Fields.List[i];
    if (p.SQLFieldType=sftVariant) and p.InheritsFrom(TSQLPropInfoRTTIVariant) then
      with TSQLPropInfoRTTIVariant(p) do
        if PropInfo.GetterIsField then
        with _Safe(PVariant(PropInfo.GetterAddr(self))^)^ do
          if Count>0 then
            Options := aOptions;
  end;
end;
{$endif}

procedure TSQLRecord.GetJSONValuesAndFree(JSON : TJSONSerializer);
begin
  if JSON<>nil then
  try
    // write the row data
    GetJSONValues(JSON);
    // end the JSON object
    if not JSON.Expand then
      JSON.AddNoJSONEscape(PAnsiChar(']}'),2);
    JSON.FlushFinal;
  finally
    JSON.Free;
  end;
end;

procedure TSQLRecord.GetJSONValues(JSON: TStream; Expand, withID: boolean;
  Occasion: TSQLOccasion; SQLRecordOptions: TJSONSerializerSQLRecordOptions);
var serializer: TJSONSerializer;
begin
  if self=nil then
    exit;
  with RecordProps do
    serializer := CreateJSONWriter(JSON,Expand,withID,
      SimpleFieldsBits[Occasion],{knownrows=}0);
  serializer.SQLRecordOptions := SQLRecordOptions;
  GetJSONValuesAndFree(serializer);
end;

function TSQLRecord.GetJSONValues(Expand, withID: boolean;
  const Fields: TSQLFieldBits; SQLRecordOptions: TJSONSerializerSQLRecordOptions): RawUTF8;
var J: TRawByteStringStream;
    serializer: TJSONSerializer;
begin
  J := TRawByteStringStream.Create;
  try
    serializer := RecordProps.CreateJSONWriter(J,Expand,withID,Fields,{knownrows=}0);
    serializer.SQLRecordOptions := SQLRecordOptions;
    GetJSONValuesAndFree(serializer);
    result := J.DataString;
  finally
    J.Free;
  end;
end;

function TSQLRecord.GetJSONValues(Expand, withID: boolean;
  const FieldsCSV: RawUTF8; SQLRecordOptions: TJSONSerializerSQLRecordOptions): RawUTF8;
var bits: TSQLFieldBits;
begin
  if RecordProps.FieldBitsFromCSV(FieldsCSV,bits) then
    result := GetJSONValues(Expand,withID,bits,SQLRecordOptions) else
    result := '';
end;

function TSQLRecord.GetJSONValues(Expand, withID: boolean;
  Occasion: TSQLOccasion; UsingStream: TCustomMemoryStream;
  SQLRecordOptions: TJSONSerializerSQLRecordOptions): RawUTF8;
var J: TRawByteStringStream;
begin
  if not withID and IsZero(RecordProps.SimpleFieldsBits[Occasion]) then
    // no simple field to write -> quick return
    result := '' else
  if UsingStream<>nil then begin
    UsingStream.Seek(0,soFromBeginning);
    GetJSONValues(UsingStream,Expand,withID,Occasion,SQLRecordOptions);
    FastSetString(result,UsingStream.Memory,UsingStream.Seek(0,soFromCurrent));
  end else begin
    J := TRawByteStringStream.Create;
    try
      GetJSONValues(J,Expand,withID,Occasion,SQLRecordOptions);
      result := J.DataString;
    finally
      J.Free;
    end;
  end;
end;

function GetVirtualTableSQLCreate(Props: TSQLRecordProperties): RawUTF8;
var i: integer;
    SQL: RawUTF8;
begin
  result := ''; // RowID is added by sqlite3_declare_vtab() for a Virtual Table
  for i := 0 to Props.Fields.Count-1 do
  with Props.Fields.List[i] do begin
    SQL := Props.SQLFieldTypeToSQL(i); // = '' for field with no matching DB column
    if SQL<>'' then
      result := result+Name+SQL;
  end;
  if result='' then
    result := ');' else
    pWord(@result[length(result)-1])^ := ord(')')+ord(';')shl 8;
end;

class function TSQLRecord.GetSQLCreate(aModel: TSQLModel): RawUTF8;
// not implemented in TSQLRecordProperties since has been made virtual
var i: integer;
    c: TClass;
    SQL, cname, tokenizer: RawUTF8;
    M: TSQLVirtualTableClass;
    Props: TSQLModelRecordProperties;
    fields: TSQLPropInfoList;
begin
  if aModel=nil then
    raise EModelException.CreateUTF8('Invalid %.GetSQLCreate(nil) call',[self]);
  Props := aModel.Props[self];
  if Props.Kind<>rSQLite3 then begin
    // create a FTS3/FTS4/RTREE virtual table
    result := 'CREATE VIRTUAL TABLE '+SQLTableName+' USING ';
    case Props.Kind of
    rFTS3:  result := result+'fts3(';
    rFTS4:  result := result+'fts4(';
    rFTS5:  result := result+'fts5(';
    rRTree: result := result+'rtree(RowID,';
    rRTreeInteger: result := result+'rtree_i32(RowID,';
    rCustomForcedID, rCustomAutoID: begin
      M := aModel.VirtualTableModule(self);
      if M=nil then
        raise EModelException.CreateUTF8('No registered module for %',[self]);
      if Props.Props.Fields.Count=0 then
        raise EModelException.CreateUTF8(
          'Virtual % class % should have published properties',[M.ModuleName,self]);
      result := result+M.ModuleName+'(';
    end;
    else raise EModelException.CreateUTF8('%.GetSQLCreate(%)?',[self,ToText(Props.Kind)^]);
    end;
    fields := Props.Props.Fields;
    case Props.Kind of
    rFTS3, rFTS4, rFTS5: begin
      if (Props.fFTSWithoutContentFields<>'') and (Props.fFTSWithoutContentTableIndex>=0) then begin
        result := FormatUTF8('%content="%",',[result,
          aModel.Tables[Props.fFTSWithoutContentTableIndex].SQLTableName]);
        if Props.Kind = rFTS5 then
           result := FormatUTF8('%content_rowid="ID",',[result]);
      end;
      for i := 0 to fields.Count-1 do
        result := result+fields.List[i].Name+',';
      tokenizer := 'simple';
      c := self;
      repeat
        ToText(c,cname); // TSQLFTSTest = class(TSQLRecordFTS3Porter)
        if IdemPChar(pointer(cname),'TSQLRECORDFTS') and
           (cname[14] in ['3','4','5']) then begin
          if length(cname)>14 then
            tokenizer := copy(cname,15,100); // e.g. TSQLRecordFTS3Porter -> 'Porter'
          break;
        end;
        c := GetClassParent(c);
      until c=TSQLRecord;
      result := FormatUTF8('% tokenize=%)',[result,LowerCaseU(tokenizer)]);
    end;
    rRTree, rRTreeInteger: begin
      for i := 0 to fields.Count-1 do
        with fields.List[i] do
        if aAuxiliaryRTreeField in Attributes then // for SQlite3 >= 3.24.0
          result := FormatUTF8('%+% %',[result,Name,Props.Props.SQLFieldTypeToSQL(i)]) else
          result := result+Name+',';
      result[length(result)] := ')';
    end;
    rCustomForcedID, rCustomAutoID:
      result := result+GetVirtualTableSQLCreate(Props.Props);
    end;
  end else begin
    // inherits from TSQLRecord: create a "normal" SQLite3 table
    result := 'CREATE TABLE '+SQLTableName+
      '(ID INTEGER PRIMARY KEY AUTOINCREMENT, ';
    // we always add an ID field which is an INTEGER PRIMARY KEY
    // column, as it is always created (as hidden RowID) by the SQLite3 engine
    with Props.Props do
    for i := 0 to Fields.Count-1 do
    with Fields.List[i] do begin
      SQL := SQLFieldTypeToSQL(i); // = '' for field with no matching DB column
      if SQL<>'' then begin
        result := result+Name+SQL;
        if i in IsUniqueFieldsBits then
          insert(' UNIQUE',result,length(result)-1);
      end;
    end;
    pWord(@result[length(result)-1])^ := ord(')')+ord(';')shl 8;
  end;
end;

function TSQLRecord.GetSQLSet: RawUTF8;
var i: integer;
    V: RawUTF8;
    wasString: boolean;
begin
  result := '';
  if self=nil then
    exit;
  with RecordProps do
    for i := 0 to length(SimpleFields)-1 do
    with SimpleFields[i] do begin
      // format is 'COL1='VAL1', COL2='VAL2'' }
      GetValueVar(self,true,V,@wasString);
      if wasString then
        V := QuotedStr(V);
      result := result+Name+'='+V+', ';
    end;
  if result<>'' then
    SetLength(result,length(result)-2);
end;

function TSQLRecord.GetSQLValues: RawUTF8;
var i: integer;
    V: RawUTF8;
    wasString: boolean;
begin
  result := '';
  if self<>nil then
  with RecordProps do
    if SimpleFields=nil then
      exit else begin
    if HasNotSimpleFields then // get 'COL1,COL2': no 'ID,' for INSERT (false below)
      result := SQLTableSimpleFieldsNoRowID; // always <> '*'
    result := result+' VALUES (';
    for i := 0 to length(SimpleFields)-1 do
    with SimpleFields[i] do begin
      GetValueVar(self,true,V,@wasString);
      if wasString then
        V := QuotedStr(V);
      result := result+V+',';
    end;
    result[length(result)] := ')';
  end;
end;

class function TSQLRecord.CaptionName(Action: PRawUTF8=nil; ForHint: boolean=false): string;
begin
  if Action=nil then
    GetCaptionFromPCharLen(pointer(RecordProps.SQLTableName),result) else
    GetCaptionFromPCharLen(TrimLeftLowerCase(Action^),result);
end;

class function TSQLRecord.CaptionNameFromRTTI(Action: PShortString): string;
var tmp: RawUTF8;
begin
  if Action=nil then
    result := CaptionName(nil) else begin
    SetString(tmp,PAnsiChar(@Action^[1]),ord(Action^[0]));
    result := CaptionName(@tmp);
  end;
end;

function TSQLRecord.SameRecord(Reference: TSQLRecord): boolean;
var i: integer;
begin
  result := false;
  if (self=nil) or (Reference=nil) or
     (PSQLRecordClass(Reference)^<>PSQLRecordClass(Self)^) or (Reference.fID<>fID) then
    exit;
  with RecordProps do
    for i := 0 to length(SimpleFields)-1 do
      // compare not TSQLRawBlob/TSQLRecordMany fields
      with SimpleFields[i] do
        if CompareValue(self,Reference,false)<>0 then
          exit; // properties don't have the same value
  result := true;
end;

function TSQLRecord.SameValues(Reference: TSQLRecord): boolean;
var O: TSQLPropInfo;
    i: integer;
    This,Ref: TSQLRecordProperties;
begin
  result := false;
  if (self=nil) or (Reference=nil) or
     (Reference.fID<>fID) then // ID field must be tested by hand
    exit;
  if self<>Reference then
  if (PSQLRecordClass(Reference)^=PSQLRecordClass(self)^) then begin
    // faster comparison on same exact class
    with RecordProps do
    for i := 0 to length(SimpleFields)-1 do
      // compare not TSQLRawBlob/TSQLRecordMany fields
      with SimpleFields[i] do
        if CompareValue(self,Reference,false)<>0 then
          exit; // properties don't have the same value
  end else begin
    // comparison of all properties of Reference against self
    This := RecordProps;
    Ref := Reference.RecordProps;
    for i := 0 to length(Ref.SimpleFields)-1 do
    with Ref.SimpleFields[i] do begin
      // compare not TSQLRawBlob/TSQLRecordMany fields
      O := This.Fields.ByRawUTF8Name(Name);
      if O=nil then
        exit; // this Reference property doesn't exist in current object
      if GetValue(Reference,false,nil)<>O.GetValue(self,false,nil) then
        exit; // properties don't have the same value
    end;
  end;
  result := true;
end;

procedure TSQLRecord.ClearProperties;
var i: integer;
begin
  if self=nil then
    exit;
  fInternalState := 0;
  fID := 0;
  with RecordProps do
    if fFill.JoinedFields then begin
      for i := 0 to length(CopiableFields)-1 do
        if CopiableFields[i].SQLFieldType<>sftID then
          CopiableFields[i].SetValue(self,nil,false) else
          TSQLRecord(TSQLPropInfoRTTIInstance(CopiableFields[i]).GetInstance(Self)).
            ClearProperties; // clear nested allocated TSQLRecord
    end else
    for i := 0 to length(CopiableFields)-1 do
      CopiableFields[i].SetValue(self,nil,false);
end;

procedure TSQLRecord.ClearProperties(const aFieldsCSV: RawUTF8);
var bits: TSQLFieldBits;
    f: integer;
begin
  if (self=nil) or (aFieldsCSV='') then
    exit;
  with RecordProps do begin
    if aFieldsCSV='*' then
      bits := SimpleFieldsBits[soInsert] else
      if not FieldBitsFromCSV(aFieldsCSV,bits) then
        exit;
    for f := 0 to Fields.Count-1 do
      if (f in bits) and (Fields.List[f].SQLFieldType in COPIABLE_FIELDS) then
        Fields.List[f].SetValue(self,nil,false); // clear field value
  end;
end;

{$IFDEF PUREPASCAL}
function TSQLRecord.RecordClass: TSQLRecordClass;
begin
  if self=nil then
    Result := nil else
    Result := PSQLRecordClass(Self)^;
end;
{$else}
function TSQLRecord.RecordClass: TSQLRecordClass;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        test    eax, eax
        jz      @z
        mov     eax, [eax]
@z:
end;
{$endif}

{$IFDEF PUREPASCAL}
function TSQLRecord.ClassProp: PClassProp;
begin
  if self<>nil then
    result := InternalClassProp(ClassType) else
    result := nil; // avoid GPF
end;
{$else}
function TSQLRecord.ClassProp: PClassProp;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        test    eax, eax
        jz      @z // avoid GPF
        mov     eax, [eax] // get ClassType of this TSQLRecord instance
        test    eax, eax
        jz      @z // avoid GPF
        mov     eax, [eax + vmtTypeInfo]
        test    eax, eax
        jz      @z // avoid GPF
        movzx   edx, byte ptr[eax].TTypeInfo.Name
        lea     eax, [eax + edx].TTypeInfo.Name[1]
        movzx   edx, byte ptr[eax].TClassType.UnitName
        lea     eax, [eax + edx].TClassType.UnitName[1].TClassProp
@z:
end;
{$endif}

function TSQLRecord.RecordReference(Model: TSQLModel): TRecordReference;
begin
  if (self=nil) or (fID<=0) then
    result := 0 else begin
    result := Model.GetTableIndexExisting(PSQLRecordClass(Self)^);
    if result>63 then // TRecordReference handle up to 64=1 shl 6 tables
      result := 0 else
      inc(result,fID shl 6);
  end;
end;

destructor TSQLRecord.Destroy;
var i: integer;
    props: TSQLRecordProperties;
begin
  props := RecordProps;
  if fFill<>nil then begin
    if fFill.fJoinedFields then
      // free all TSQLRecord instances created by TSQLRecord.CreateJoined
      for i := 0 to length(props.JoinedFields)-1 do
        props.JoinedFields[i].GetInstance(self).Free;
    fFill.Free; // call UnMap -> release fTable instance if necessary
  end;
  // free all TSQLRecordMany instances created by TSQLRecord.Create
  if props.ManyFields<>nil then
    for i := 0 to length(props.ManyFields)-1 do
      props.ManyFields[i].GetInstance(self).Free;
  // free any registered T*ObjArray
  if props.DynArrayFieldsHasObjArray then
    for i := 0 to length(props.DynArrayFields)-1 do
      with props.DynArrayFields[i] do
        if ObjArray<>nil then
          ObjArrayClear(fPropInfo^.GetFieldAddr(self)^);
  inherited;
end;

function TSQLRecord.SimplePropertiesFill(const aSimpleFields: array of const): boolean;
var i: integer;
    tmp: RawUTF8;
begin
  if self=nil then
    result := false else // means error
    with RecordProps do
    if length(SimpleFields)<>length(aSimpleFields) then
      result := false else begin
      for i := 0 to high(aSimpleFields) do begin
        VarRecToUTF8(aSimpleFields[i],tmp); // will work for every handled type
        SimpleFields[i].SetValueVar(self,tmp,false);
      end;
      result := True;
    end;
end;

constructor TSQLRecord.CreateAndFillPrepare(aClient: TSQLRest;
  const aSQLWhere: RawUTF8; const aCustomFieldsCSV: RawUTF8='');
var aTable: TSQLTable;
begin
  Create;
  aTable := aClient.MultiFieldValues(RecordClass,aCustomFieldsCSV,aSQLWhere);
  if aTable=nil then
    exit;
  aTable.OwnerMustFree := true;
  FillPrepare(aTable);
end;

constructor TSQLRecord.CreateAndFillPrepare(aClient: TSQLRest;
  const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
  const aCustomFieldsCSV: RawUTF8='');
var where: RawUTF8;
begin
  where := FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere);
  CreateAndFillPrepare(aClient,where,aCustomFieldsCSV);
end;

constructor TSQLRecord.CreateAndFillPrepare(aClient: TSQLRest;
  const FormatSQLWhere: RawUTF8; const ParamsSQLWhere,
  BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8);
var where: RawUTF8;
begin
  where := FormatUTF8(FormatSQLWhere,ParamsSQLWhere,BoundsSQLWhere);
  CreateAndFillPrepare(aClient,where,aCustomFieldsCSV);
end;

constructor TSQLRecord.CreateAndFillPrepare(aClient: TSQLRest;
  const aIDs: array of Int64; const aCustomFieldsCSV: RawUTF8='');
begin
  Create;
  FillPrepare(aClient,aIDs,aCustomFieldsCSV);
end;

constructor TSQLRecord.CreateAndFillPrepare(const aJSON: RawUTF8);
var aTable: TSQLTable;
begin
  Create;
  aTable := TSQLTableJSON.CreateFromTables([RecordClass],'',aJSON);
  aTable.OwnerMustFree := true;
  FillPrepare(aTable);
end;

constructor TSQLRecord.CreateAndFillPrepare(aJSON: PUTF8Char; aJSONLen: integer);
var aTable: TSQLTable;
begin
  Create;
  aTable := TSQLTableJSON.CreateFromTables([RecordClass],'',aJSON,aJSONLen);
  aTable.OwnerMustFree := true;
  FillPrepare(aTable);
end;

constructor TSQLRecord.CreateAndFillPrepareJoined(aClient: TSQLRest;
  const aFormatSQLJoin: RawUTF8; const aParamsSQLJoin, aBoundsSQLJoin: array of const);
var i,n: integer;
    props: TSQLModelRecordProperties;
    T: TSQLTableJSON;
    instance: TSQLRecord;
    SQL: RawUTF8;
begin
  Create;
  props := aClient.Model.Props[PSQLRecordClass(Self)^];
  if props.props.JoinedFields=nil then
    raise EORMException.CreateUTF8('No nested TSQLRecord to JOIN in %',[self]);
  SQL := props.SQL.SelectAllJoined;
  if aFormatSQLJoin<>'' then
    SQL := SQL+FormatUTF8(SQLFromWhere(aFormatSQLJoin),aParamsSQLJoin,aBoundsSQLJoin);
  T := aClient.ExecuteList(props.props.JoinedFieldsTable,SQL);
  if T=nil then
    exit;
  fFill := TSQLRecordFill.Create;
  fFill.fJoinedFields := True;
  fFill.fTable := T;
  fFill.fTable.OwnerMustFree := true;
  n := 0;
  with props.props do begin // follow SQL.SelectAllJoined columns
    fFill.AddMapSimpleFields(Self,SimpleFields,n);
    for i := 1 to length(JoinedFieldsTable)-1 do begin
      instance := JoinedFieldsTable[i].Create;
      JoinedFields[i-1].SetInstance(self,instance);
      fFill.AddMapSimpleFields(instance,JoinedFieldsTable[i].RecordProps.SimpleFields,n);
    end;
  end;
  fFill.fFillCurrentRow := 1; // point to first data row (0 is field names)
end;

constructor TSQLRecord.CreateJoined(aClient: TSQLRest; aID: TID);
begin
  CreateAndFillPrepareJoined(aClient,'%.RowID=?',[RecordProps.SQLTableName],[aID]);
  FillOne;
end;

constructor TSQLRecord.CreateAndFillPrepareMany(aClient: TSQLRest;
  const aFormatSQLJoin: RawUTF8; const aParamsSQLJoin, aBoundsSQLJoin: array of const);
begin
  Create;
  if Length(RecordProps.ManyFields)=0 then
    raise EModelException.CreateUTF8(
      '%.CreateAndFillPrepareMany() with no many-to-many fields',[self]);
  if not FillPrepareMany(aClient,aFormatSQLJoin,aParamsSQLJoin,aBoundsSQLJoin) then
    raise EModelException.CreateUTF8(
      '%.CreateAndFillPrepareMany(): FillPrepareMany() failure',[self]);
end;

function TSQLRecord.EnginePrepareMany(aClient: TSQLRest; const aFormatSQLJoin: RawUTF8;
  const aParamsSQLJoin, aBoundsSQLJoin: array of const;
  out ObjectsClass: TSQLRecordClassDynArray; out SQL: RawUTF8): RawUTF8;
var aSQLFields, aSQLFrom, aSQLWhere, aSQLJoin: RawUTF8;
    aField: string[3];
    aMany: RawUTF8;
    f, n, i, SQLFieldsCount: Integer;
    Props: TSQLRecordProperties;
    SQLFields: array of record
      SQL: string[3];
      Prop: TSQLPropInfo;
      Instance: TSQLRecord;
    end;
    M: TSQLRecordMany;
    D: TSQLRecord;
    J,JBeg: PUTF8Char;
    Objects: array of TSQLRecord;

  function AddField(aProp: TSQLPropInfo): Boolean;
  begin
    if SQLFieldsCount>=MAX_SQLFIELDS then
      result := false else
      with SQLFields[SQLFieldsCount] do begin
        SQL := aField;
        Prop := aProp;
        Instance := Objects[f];
        inc(SQLFieldsCount);
        result := true;
      end;
  end;
  function ProcessField(var P: PUTF8Char): RawUTF8;
  var B: PUTF8Char;
      field: TSQLPropInfo;
      i: integer;
      M: TSQLRecordMany;
      aManyField: string[63];
    function GetManyField(F: PUTF8Char): boolean;
    var B: PUTF8Char;
    begin
      result := true;
      B := F;
      while tcIdentifier in TEXT_CHARS[F^] do inc(F); // go to end of sub-field name
      if B=F then begin
        result := false;
        exit;
      end;
      dec(B,2); // space for 'C.'
      SetString(aManyField,B,F-B);
      aManyField[2] := '.';
      P := F;
    end;
  begin
    B := P;
    while tcIdentifier in TEXT_CHARS[P^] do inc(P); // go to end of field name
    FastSetString(result,B,P-B);
    if (result='') or IdemPropNameU(result,'AND') or IdemPropNameU(result,'OR') or
       IdemPropNameU(result,'LIKE') or IdemPropNameU(result,'NOT') or
       IdemPropNameU(result,'NULL') then
      exit;
    if not IsRowID(pointer(result)) then begin
      i := Props.Fields.IndexByName(result);
      if i<0 then
        exit;
      field := Props.Fields.List[i];
      if field.SQLFieldType=sftMany then begin
        M := TSQLPropInfoRTTIInstance(field).GetInstance(self) as TSQLRecordMany;
        for i := 0 to n-1 do
        if Objects[i*2+1]=M then begin
          if IdemPChar(P,'.DEST.') then begin // special case of Many.Dest.*
            if GetManyField(P+6) then begin
              aManyField[1] := AnsiChar(i*2+67);
              result := RawUTF8(aManyField);
              exit; // Categories.Dest.Name=? -> C.Name=?
            end;
          end else
          if (P^='.') and GetManyField(P+1) then begin
            aManyField[1] := AnsiChar(i*2+66);
            result := RawUTF8(aManyField);
            exit;  // Categories.Kind=? -> CC.Kind=?
          end;
        end;
        exit;
      end;
    end;
    result := 'A.'+result; // Owner=? -> A.Owner=?
  end;
begin
  result := '';
  FillClose; // so that no further FillOne will work
  if (self=nil) or (aClient=nil) then
    exit;
  // reset TSQLRecordFill object
  if fFill=nil then
    fFill := TSQLRecordFill.Create else
    fFill.UnMap;
  // compute generic joined SQL statement and initialize Objects*[]+SQLFields[]
  SetLength(SQLFields,MAX_SQLFIELDS);
  Props := RecordProps;
  n := Length(Props.ManyFields);
  if n=0 then
    exit;
  SetLength(Objects,n*2+1);
  SetLength(ObjectsClass,n*2+1);
  Objects[0] := self;
  ObjectsClass[0] := PSQLRecordClass(self)^;
  SetLength(fFill.fTableMapRecordManyInstances,n);  // fFill.UnMap will release memory
  for f := 0 to n-1 do begin
    M := TSQLRecordMany(Props.ManyFields[f].GetInstance(self));
    if M=nil then
      raise EORMException.CreateUTF8('%.Create should have created %:% for EnginePrepareMany',
        [self,Props.ManyFields[f].Name,Props.ManyFields[f].ObjectClass]);
    fFill.fTableMapRecordManyInstances[f] := M;
    Objects[f*2+1] := M;
    ObjectsClass[f*2+1] := PSQLRecordClass(M)^;
    with M.RecordProps do begin
      if (fRecordManySourceProp.ObjectClass<>PClass(self)^) or
         (fRecordManyDestProp.ObjectClass=nil) then
        raise EORMException.CreateUTF8('%.EnginePrepareMany %:% mismatch',
          [self,Props.ManyFields[f].Name,Props.ManyFields[f].ObjectClass]);
      ObjectsClass[f*2+2] := TSQLRecordClass(fRecordManyDestProp.ObjectClass);
      D := TSQLRecordClass(fRecordManyDestProp.ObjectClass).Create;
      // let TSQLRecordMany.Source and Dest point to real instances
      M.fSourceID^ := PtrInt(self);
      M.fDestID^ := PtrInt(D);
    end;
    Objects[f*2+2] := TSQLRecord(M.fDestID^);
    if Props.fSQLFillPrepareMany='' then begin
      aMany := AnsiChar(f*2+66); // Many=B,D,F...
      if aSQLWhere<>'' then
        aSQLWhere := aSQLWhere+' and ';
      aSQLWhere := FormatUTF8('%%.Source=A.RowID and %.Dest=%.RowID',
        [aSQLWhere,aMany,aMany,AnsiChar(f*2+67){Dest=C,E,G..}]);
    end;
  end;
  SQLFieldsCount := 0;
  aField := 'A00';
  for f := 0 to length(ObjectsClass)-1 do
    with ObjectsClass[f].RecordProps do begin
      PWord(@aField[2])^ := ord('I')+ord('D')shl 8;
      if not AddField(nil) then
        Exit; // try to add the ID field
      if Props.fSQLFillPrepareMany='' then begin
        if aSQLFields<>'' then
          aSQLFields := aSQLFields+',';
          aSQLFields := FormatUTF8('%%.RowID %',[aSQLFields,aField[1],aField]);
      end;
      for i := 0 to length(SimpleFields)-1 do
      with SimpleFields[i] do begin
        if (f and 1=0) {self/dest} or
           not(IdemPropNameU(Name,'SOURCE') or
               IdemPropNameU(Name,'DEST')) {many} then begin
          PWord(@aField[2])^ := TwoDigitLookupW[i];
          if not AddField(SimpleFields[i]) then
            Exit; // try to add this simple field
          if Props.fSQLFillPrepareMany='' then
            aSQLFields := FormatUTF8('%,%.% %',[aSQLFields,aField[1],Name,aField]);
        end;
      end;
      if Props.fSQLFillPrepareMany='' then begin
        if aSQLFrom<>'' then
          aSQLFrom := aSQLFrom+',';
        aSQLFrom := aSQLFrom+SQLTableName+' '+ToUTF8(aField[1]);
      end;
      inc(aField[1]);
    end;
  if Props.fSQLFillPrepareMany<>'' then
    SQL := Props.fSQLFillPrepareMany else begin
    FormatUTF8('select % from % where %',[aSQLFields,aSQLFrom,aSQLWhere],SQL);
    Props.fSQLFillPrepareMany := SQL;
  end;
  // process aFormatSQLJoin,aParamsSQLJoin and aBoundsSQLJoin parameters
  if aFormatSQLJoin<>'' then begin
    aSQLWhere := '';
    FormatUTF8(aFormatSQLJoin,aParamsSQLJoin,aSQLJoin);
    JBeg := pointer(aSQLJoin);
    repeat
      J := JBeg;
      while not (tcIdentifier in TEXT_CHARS[J^]) do begin
        case J^ of
        '"':  repeat inc(J) until J^ in [#0,'"'];
        '''': repeat inc(J) until J^ in [#0,''''];
        end;
        if J^=#0 then break;
        inc(J);
      end;
      if J<>JBeg then begin // append ' ',')'..
        FastSetString(aSQLFrom,JBeg,J-JBeg);
        aSQLWhere := aSQLWhere+aSQLFrom;
        JBeg := J;
      end;
      if J^=#0 then break;
      aSQLWhere := aSQLWhere+ProcessField(JBeg);
    until JBeg^=#0;
    SQL := SQL+' and ('+FormatUTF8(aSQLWhere,[],aBoundsSQLJoin)+')';
  end;
  // execute SQL statement and retrieve the matching data
  result := aClient.EngineList(SQL);
  if result<>'' then // prepare Fill mapping on success - see FillPrepareMany()
    for i := 0 to SQLFieldsCount-1 do
      with SQLFields[i] do
        fFill.AddMap(Instance,Prop,i);
end;

function TSQLRecord.FillPrepareMany(aClient: TSQLRest;
  const aFormatSQLJoin: RawUTF8; const aParamsSQLJoin, aBoundsSQLJoin: array of const): boolean;
var JSON,SQL: RawUTF8;
    ObjectsClass: TSQLRecordClassDynArray;
    T: TSQLTable;
begin
  result := false;
  JSON := EnginePrepareMany(aClient,aFormatSQLJoin,aParamsSQLJoin,aBoundsSQLJoin,
    ObjectsClass,SQL);
  if JSON='' then
    exit;
  T := TSQLTableJSON.CreateFromTables(ObjectsClass,SQL,JSON);
  if (T=nil) or (T.fResults=nil) then begin
    T.Free;
    exit;
  end;
{  assert(T.FieldCount=SQLFieldsCount);
  for i := 0 to SQLFieldsCount-1 do
    assert(IdemPropName(SQLFields[i].SQL,T.fResults[i],StrLen(T.fResults[i]))); }
  fFill.fTable := T;
  T.OwnerMustFree := true;
  fFill.fFillCurrentRow := 1; // point to first data row (0 is field names)
  result := true;
end;

function TSQLRecord.GetID: TID;
begin
  {$ifdef MSWINDOWS}
  if PtrUInt(self)<PtrUInt(SystemInfo.lpMinimumApplicationAddress) then
    // was called from a TSQLRecord property (sftID type)
    // (will return 0 if current instance is nil)
    result := PtrUInt(self) else
    result := fID;
    // was called from a real TSQLRecord instance
  {$else}
  if PtrUInt(self)<$100000 then // rough estimation, but works in practice
    result := PtrUInt(self) else
  try
    result := fID;
  except
    result := PtrUInt(self);
  end;
  {$endif MSWINDOWS}
end;

function TSQLRecord.GetIDAsPointer: pointer;
begin
  {$ifdef MSWINDOWS}
  if PtrUInt(self)<PtrUInt(SystemInfo.lpMinimumApplicationAddress) then
    // was called from a TSQLRecord property (sftID type)
    // (will return 0 if current instance is nil)
    result := self else
    // was called from a real TSQLRecord instance
    {$ifndef CPU64}
    if fID>MaxInt then
      raise EORMException.CreateUTF8('%.GetIDAsPointer is storing ID=%, which '+
        'cannot be stored in a pointer/TSQLRecord 32-bit instance: use '+
        'a TID/T*ID published field for 64-bit IDs',[self,fID]) else
    {$endif CPU64}
      result := pointer(PtrInt(fID));
  {$else}
  if PtrUInt(self)<$100000 then // rough estimation, but works in practice
    result := self else
  try
    result := pointer(PtrInt(fID));
  except
    result := self;
  end;
  {$endif MSWINDOWS}
end;

class procedure TSQLRecord.InternalRegisterCustomProperties(Props: TSQLRecordProperties);
begin // do nothing by default
end;

class procedure TSQLRecord.InternalDefineModel(Props: TSQLRecordProperties);
begin // do nothing by default
end;

function TSQLRecord.GetHasBlob: boolean;
begin
  if Self=nil then
    result := false else
    result := RecordProps.BlobFields<>nil;
end;

function TSQLRecord.GetSimpleFieldCount: integer;
begin
  if Self=nil then
    result := 0 else
    result := length(RecordProps.SimpleFields);
end;

function TSQLRecord.GetFillCurrentRow: integer;
begin
  if (self=nil) or (fFill=nil) then
    result := 0 else
    result := fFill.FillCurrentRow;
end;

function TSQLRecord.GetFillReachedEnd: boolean;
begin
  result := (self=nil) or (fFill=nil) or (fFill.Table.fRowCount=0) or
   (cardinal(fFill.FillCurrentRow)>cardinal(fFill.Table.fRowCount));
end;

function TSQLRecord.GetTable: TSQLTable;
begin
  if (self=nil) or (fFill=nil) then
    result := nil else
    result := fFill.Table;
end;

function TSQLRecord.GetFieldValue(const PropName: RawUTF8): RawUTF8;
var P: TSQLPropInfo;
begin
  result := '';
  if self=nil then
    exit;
  P := RecordProps.Fields.ByName(pointer(PropName));
  if P<>nil then
    P.GetValueVar(self,False,result,nil);
end;

procedure TSQLRecord.SetFieldValue(const PropName: RawUTF8; Value: PUTF8Char);
var P: TSQLPropInfo;
begin
  if self=nil then
    exit;
  P := RecordProps.Fields.ByName(pointer(PropName));
  if P<>nil then
    P.SetValue(self,Value,false);
end;

{$ifndef NOVARIANTS}

function TSQLRecord.GetAsDocVariant(withID: boolean; const withFields: TSQLFieldBits;
  options: PDocVariantOptions; replaceRowIDWithID: boolean): variant;
begin
  GetAsDocVariant(withID,withFields,result,options,replaceRowIDWithID);
end;

procedure TSQLRecord.GetAsDocVariant(withID: boolean;
  const withFields: TSQLFieldBits; var result: variant; options: PDocVariantOptions;
  replaceRowIDWithID: boolean);
const _ID: array[boolean] of RawUTF8 = ('RowID','ID');
var f,i: integer;
    Fields: TSQLPropInfoList;
    intvalues: TRawUTF8Interning;
    doc: TDocVariantData absolute result;
begin
  VarClear(result);
  if self=nil then
    exit;
  Fields := RecordProps.Fields;
  doc.InitFast(Fields.Count+1,dvObject);
  intvalues := nil;
  if options<>nil then begin // force options
    PDocVariantData(@result)^.Options := options^;
    if dvoInternValues in options^ then
      intvalues := DocVariantType.InternValues;
  end;
  if withID then
    doc.Values[doc.InternalAdd(_ID[replaceRowIDWithID])] := fID;
  for f := 0 to Fields.Count-1 do
  if f in withFields then begin
    i := doc.InternalAdd(Fields.List[f].Name);
    Fields.List[f].GetVariant(self,doc.Values[i]);
    if intvalues<>nil then // doc.Values[i] set manually -> manual interning
      intvalues.UniqueVariant(doc.Values[i]);
  end;
end;

function TSQLRecord.GetSimpleFieldsAsDocVariant(withID: boolean;
  options: PDocVariantOptions): variant;
begin
  if self=nil then
    VarClear(result) else
    GetAsDocVariant(withID,RecordProps.SimpleFieldsBits[soSelect],result,options);
end;

function TSQLRecord.GetFieldVariant(const PropName: string): Variant;
var P: TSQLPropInfo;
begin
  if self=nil then
    P := nil else
    P := RecordProps.Fields.ByRawUTF8Name({$ifdef UNICODE}StringToUTF8{$endif}(PropName));
  if P=nil then
    VarClear(result) else
    P.GetVariant(self,result);
end;

procedure TSQLRecord.SetFieldVariant(const PropName: string;
  const Source: Variant);
var P: TSQLPropInfo;
begin
  if self=nil then
    P := nil else
    P := RecordProps.Fields.ByRawUTF8Name({$ifdef UNICODE}StringToUTF8{$endif}(PropName));
  if P<>nil then
    P.SetVariant(self,Source);
end;

{$endif NOVARIANTS}

var
  vmtAutoTableLock: TRTLCriticalSection; // atomic set of the VMT AutoTable entry

function PropsCreate(aTable: TSQLRecordClass): TSQLRecordProperties;
var PVMT: pointer;
begin // private sub function makes the code faster in most case
  if not aTable.InheritsFrom(TSQLRecord) then begin
    result := nil; // invalid call
    exit;
  end;
  EnterCriticalSection(vmtAutoTableLock);
  try
    // TSQLRecordProperties instance is stored into "AutoTable" unused VMT entry
    PVMT := pointer(PtrInt(PtrUInt(aTable))+vmtAutoTable);
    result := PPointer(PVMT)^;
    if result=nil then begin // protect from (unlikely) concurrent call
      // create the properties information from RTTI
      result := TSQLRecordProperties.Create(aTable);
      PatchCodePtrUInt(PVMT,PtrUInt(result),true); // LeaveUnprotected=true
      // register to the internal garbage collection (avoid memory leak)
      GarbageCollectorFreeAndNil(PVMT^,result); // set to nil at finalization
      // overriden method may use RecordProps -> do it after the VMT is set
      aTable.InternalDefineModel(result);
    end;
  finally
    LeaveCriticalSection(vmtAutoTableLock);
  end;
end;

// since "var class" are not available in Delphi 6-7, and is inherited by
// the children classes under latest Delphi versions (i.e. the "var class" is
// shared by all inherited classes, whereas we want one var per class), we reused
// one of the unused magic VMT slots (i.e. the one for automated methods,
// AutoTable, a relic from Delphi 2 that is generally not used anymore) - see
// http://hallvards.blogspot.com/2007/05/hack17-virtual-class-variables-part-ii.html

{$ifdef FPC_OR_PUREPASCAL}
class function TSQLRecord.RecordProps: TSQLRecordProperties;
begin
  if Self<>nil then begin
    result := PPointer(PtrInt(PtrUInt(Self))+vmtAutoTable)^;
    if result=nil then
      result := PropsCreate(self);
  end else
    result := nil;
end;
{$else}
class function TSQLRecord.RecordProps: TSQLRecordProperties;
asm
        test    eax, eax
        jz      @null
        mov     edx, [eax + vmtAutoTable]
        test    edx, edx
        jz      PropsCreate
        mov     eax, edx
@null:
end;
{$endif}

function TSQLRecord.Filter(const aFields: TSQLFieldBits): boolean;
var f, i: integer;
    Value, Old: RawUTF8;
begin
  result := IsZero(aFields);
  if (self=nil) or result then
    // avoid GPF and handle case if no field was selected
    exit;
  with RecordProps do
  if Filters=nil then
    // no filter set yet -> process OK
    result := true else begin
    for f := 0 to Fields.Count-1 do
      if (Fields.List[f].SQLFieldType in COPIABLE_FIELDS) then
        for i := 0 to length(Filters[f])-1 do
        if Filters[f,i].InheritsFrom(TSynFilter) then begin
          Fields.List[f].GetValueVar(self,false,Value,nil);
          Old := Value;
          TSynFilter(Filters[f,i]).Process(f,Value);
          if Old<>Value then
            // value was changed -> store modified
            Fields.List[f].SetValueVar(self,Value,false);
        end;
  end;
end;

function TSQLRecord.Filter(const aFields: array of RawUTF8): boolean;
var F: TSQLFieldBits;
begin
  if RecordProps.FieldBitsFromRawUTF8(aFields,F) then
    // must always call the virtual Filter() method
    result := Filter(F) else
    result := false;
end;

class function TSQLRecord.SQLTableName: RawUTF8;
begin
  if self=nil then
    result := '' else
    result := RecordProps.SQLTableName;
end;

class function TSQLRecord.AutoFree(varClassPairs: array of pointer): IAutoFree;
var n,i: integer;
begin
  n := length(varClassPairs);
  if (n=0) or (n and 1=1) then
    exit;
  n := n shr 1;
  if n=0 then
    exit;
  for i := 0 to n-1 do // convert TSQLRecordClass into TSQLRecord instances
    varClassPairs[i*2+1] := TSQLRecordClass(varClassPairs[i*2+1]).Create;
  result := TAutoFree.Create(varClassPairs);
end;

class function TSQLRecord.AutoFree(var localVariable): IAutoFree;
begin
  result := TAutoFree.Create(localVariable,Create);
end;

class function TSQLRecord.AutoFree(var localVariable; Rest: TSQLRest; ID: TID): IAutoFree;
begin
  result := TAutoFree.Create(localVariable,Create(Rest,ID));
end;

class function TSQLRecord.AutoFree(var localVariable; Rest: TSQLRest;
  const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
  const aCustomFieldsCSV: RawUTF8): IAutoFree;
begin
  result := TAutoFree.Create(localVariable,CreateAndFillPrepare(Rest,
    FormatSQLWhere,BoundsSQLWhere,aCustomFieldsCSV));
end;

class function TSQLRecord.AutoFree(var localVariable; Rest: TSQLRest;
  const FormatSQLWhere: RawUTF8; const ParamsSQLWhere,BoundsSQLWhere: array of const;
  const aCustomFieldsCSV: RawUTF8): IAutoFree;
begin
  result := TAutoFree.Create(localVariable,CreateAndFillPrepare(Rest,
    FormatSQLWhere,ParamsSQLWhere,BoundsSQLWhere,aCustomFieldsCSV));
end;

class procedure TSQLRecord.AddFilterOrValidate(const aFieldName: RawUTF8;
  aFilter: TSynFilterOrValidate);
begin
  RecordProps.AddFilterOrValidate(aFieldName,aFilter);
end;

class procedure TSQLRecord.AddFilterNotVoidText(const aFieldNames: array of RawUTF8);
var i,f: Integer;
begin
  with RecordProps do
    for i := 0 to high(aFieldNames) do begin
      f := Fields.IndexByNameOrExcept(aFieldNames[i]);
      AddFilterOrValidate(f,TSynFilterTrim.Create);
      AddFilterOrValidate(f,TSynValidateNonVoidText.Create);
    end;
end;

class procedure TSQLRecord.AddFilterNotVoidAllTextFields;
var f: Integer;
begin
  with RecordProps,Fields do
    for f := 0 to Count-1 do
      if List[f].SQLFieldType in RAWTEXT_FIELDS then begin
        AddFilterOrValidate(f,TSynFilterTrim.Create);
        AddFilterOrValidate(f,TSynValidateNonVoidText.Create);
      end;
end;

function TSQLRecord.Validate(aRest: TSQLRest; const aFields: TSQLFieldBits;
  aInvalidFieldIndex: PInteger; aValidator: PSynValidate): string;
var f, i: integer;
    Value: RawUTF8;
    Validate: TSynValidate;
    ValidateRest: TSynValidateRest absolute Validate;
    valid: boolean;
begin
  result := '';
  if (self=nil) or IsZero(aFields) then
    // avoid GPF and handle case if no field was selected
    exit;
  with RecordProps do
  if Filters<>nil then
  for f := 0 to Fields.Count-1 do
  if Fields.List[f].SQLFieldType in COPIABLE_FIELDS then begin
    for i := 0 to length(Filters[f])-1 do begin
      Validate := TSynValidate(Filters[f,i]);
      if Validate.InheritsFrom(TSynValidate) then begin
        if Value='' then
          Fields.List[f].GetValueVar(self,false,Value,nil);
        if Validate.InheritsFrom(TSynValidateRest) then
          valid := TSynValidateRest(Validate).Validate(f,Value,result, aRest, self)
        else
          valid := Validate.Process(f,Value,result);
        if not valid then begin
          // TSynValidate process failed -> notify caller
          if aInvalidFieldIndex<>nil then
            aInvalidFieldIndex^ := f;
          if aValidator<>nil then
            aValidator^ := Validate;
          if result='' then
            // no custom message -> show a default message
            result := format(sValidationFailed,[
              GetCaptionFromClass(Validate.ClassType)]);
          exit;
        end;
      end;
    end;
    Value := '';
  end;
end;

function TSQLRecord.Validate(aRest: TSQLRest; const aFields: array of RawUTF8;
  aInvalidFieldIndex: PInteger; aValidator: PSynValidate): string;
var F: TSQLFieldBits;
begin
  if RecordProps.FieldBitsFromRawUTF8(aFields,F) then
    // must always call the virtual Validate() method
    result := Validate(aRest,F,aInvalidFieldIndex,aValidator) else
    result := '';
end;

function TSQLRecord.FilterAndValidate(aRest: TSQLRest; out aErrorMessage: string;
  const aFields: TSQLFieldBits; aValidator: PSynValidate): boolean;
var invalidField: Integer;
begin
  Filter(aFields);
  aErrorMessage := Validate(aRest,aFields,@invalidField,aValidator);
  if aErrorMessage='' then
    result := true else begin
    if invalidField>=0 then
      aErrorMessage := FormatString('"%": %',
        [RecordProps.Fields.List[invalidField].GetNameDisplay,aErrorMessage]);
    result := false;
  end;
end;

function TSQLRecord.FilterAndValidate(aRest: TSQLRest;
  const aFields: TSQLFieldBits; aValidator: PSynValidate): RawUTF8;
var msg: string;
begin
  if FilterAndValidate(aRest,msg,aFields,aValidator) then
    result := '' else
    StringToUTF8(msg,result);
end;

function TSQLRecord.DynArray(const DynArrayFieldName: RawUTF8): TDynArray;
var F: integer;
begin
  with RecordProps do
    for F := 0 to length(DynArrayFields)-1 do
      with DynArrayFields[F] do
      if IdemPropNameU(Name,DynArrayFieldName) then begin
        GetDynArray(self,result);
        exit;
      end;
  result.Void;
end;

function TSQLRecord.DynArray(DynArrayFieldIndex: integer): TDynArray;
var F: integer;
begin
  if DynArrayFieldIndex>0 then
    with RecordProps do
      for F := 0 to length(DynArrayFields)-1 do
        with DynArrayFields[F] do
        if DynArrayIndex=DynArrayFieldIndex then begin
          GetDynArray(self,result);
          exit;
        end;
  result.Void;
end;

procedure TSQLRecord.ComputeFieldsBeforeWrite(aRest: TSQLRest; aOccasion: TSQLEvent);
var F: integer;
    types: TSQLFieldTypes;
    i64: Int64;
    p: TSQLPropInfo;
begin
  if (self<>nil) and (aRest<>nil) then
    with RecordProps do begin
      integer(types) := 0;
      if sftModTime in HasTypeFields then
        include(types,sftModTime);
      if (sftCreateTime in HasTypeFields) and (aOccasion=seAdd) then
        include(types,sftCreateTime);
      if integer(types)<>0 then begin
        i64 := aRest.ServerTimestamp;
        for F := 0 to Fields.Count-1 do begin
          p := Fields.List[f];
          if p.SQLFieldType in types then
            TSQLPropInfoRTTIInt64(p).fPropInfo.SetInt64Prop(Self,i64);
        end;
      end;
      if sftSessionUserID in HasTypeFields then begin
        i64 := aRest.GetCurrentSessionUserID;
        if i64<>0 then
          for F := 0 to Fields.Count-1 do begin
            p := Fields.List[f];
            if p.SQLFieldType=sftSessionUserID then
              TSQLPropInfoRTTIInt64(p).fPropInfo.SetInt64Prop(Self,i64);
          end;
      end;
    end;
end;


{ TSQLRecordNoCase }

class procedure TSQLRecordNoCase.InternalDefineModel(Props: TSQLRecordProperties);
begin
  Props.SetCustomCollationForAll(sftUTF8Text,'NOCASE');
end;

{ TSQLRecordCaseSensitive }

class procedure TSQLRecordCaseSensitive.InternalDefineModel(
  Props: TSQLRecordProperties);
begin
  Props.SetCustomCollationForAll(sftUTF8Text,'BINARY');
end;

{ TSQLRecordNoCaseExtended }

class procedure TSQLRecordNoCaseExtended.InternalDefineModel(Props: TSQLRecordProperties);
begin
  inherited InternalDefineModel(Props); // set NOCASE collation
  Props.SetVariantFieldsDocVariantOptions(JSON_OPTIONS_FAST_EXTENDED);
end;

{ TSQLRecordCaseSensitiveExtended }

class procedure TSQLRecordCaseSensitiveExtended.InternalDefineModel(
  Props: TSQLRecordProperties);
begin
  inherited InternalDefineModel(Props); // set BINARY collation
  Props.SetVariantFieldsDocVariantOptions(JSON_OPTIONS_FAST_EXTENDED);
end;


{ TSQLRecordNoCaseExtendedNoID }

class procedure TSQLRecordNoCaseExtendedNoID.InitializeTable(Server: TSQLRestServer;
  const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
begin
  inherited InitializeTable(Server, FieldName, Options + [itoNoIndex4TID]);
end;


{ TSQLRecordPropertiesMapping }

procedure TSQLRecordPropertiesMapping.Init(Table: TSQLRecordClass;
  const MappedTableName: RawUTF8; MappedConnection: TObject;
  AutoComputeSQL: boolean; MappingOptions: TSQLRecordPropertiesMappingOptions);
begin
  fOptions := MappingOptions;
  fProps := Table.RecordProps;
  if MappedTableName='' then
    fTableName := fProps.SQLTableName else
    fTableName := MappedTableName;
  fConnectionProperties := MappedConnection;
  fRowIDFieldName := 'ID';
  fProps.Fields.NamesToRawUTF8DynArray(fExtFieldNames);
  fProps.Fields.NamesToRawUTF8DynArray(fExtFieldNamesUnQuotedSQL);
  FillcharFast(fFieldNamesMatchInternal,SizeOf(fFieldNamesMatchInternal),255);
  fAutoComputeSQL := AutoComputeSQL;
  fMappingVersion := 1;
  if fAutoComputeSQL then
    ComputeSQL;
end;

function TSQLRecordPropertiesMapping.MapField(
  const InternalName, ExternalName: RawUTF8): PSQLRecordPropertiesMapping;
begin
  MapFields([InternalName,ExternalName]);
  result := @self;
end;

function TSQLRecordPropertiesMapping.MapFields(
  const InternalExternalPairs: array of RawUTF8): PSQLRecordPropertiesMapping;
var i,int: Integer;
begin
  for i := 0 to (length(InternalExternalPairs) shr 1)-1 do begin
    int := fProps.Fields.IndexByNameOrExcept(InternalExternalPairs[i*2]);
    if int<0 then begin
      fRowIDFieldName := InternalExternalPairs[i*2+1];
      if IdemPropNameU(fRowIDFieldName,'ID') then
        include(fFieldNamesMatchInternal,0) else     // [0]=ID
        exclude(fFieldNamesMatchInternal,0);
    end else begin
      fExtFieldNames[int] := InternalExternalPairs[i*2+1];
      fExtFieldNamesUnQuotedSQL[int] := UnQuotedSQLSymbolName(fExtFieldNames[int]);
      if IdemPropNameU(fExtFieldNames[int],fProps.Fields.List[int].Name) then
        include(fFieldNamesMatchInternal,int+1) else // [0]=ID  [1..n]=fields[i-1]
        exclude(fFieldNamesMatchInternal,int+1);
    end;
  end;
  inc(fMappingVersion);
  if fAutoComputeSQL then
    ComputeSQL;
  result := @self;
end;

function TSQLRecordPropertiesMapping.MapAutoKeywordFields:
  PSQLRecordPropertiesMapping;
begin
  if @self<>nil then
    include(fOptions,rpmAutoMapKeywordFields);
  result := @self;
end;

function TSQLRecordPropertiesMapping.SetOptions(
  aOptions: TSQLRecordPropertiesMappingOptions): PSQLRecordPropertiesMapping;
begin
  if @self<>nil then
    fOptions := aOptions;
  result := @self;
end;

procedure TSQLRecordPropertiesMapping.ComputeSQL;
  type // similar to TSQLModelRecordProperties.Create()/SetKind()
    TContent = (TableSimpleFields, UpdateSimple, UpdateSetAll, InsertAll);
  procedure SetSQL(W: TTextWriter;
    withID, withTableName: boolean; var result: RawUTF8;
    content: TContent=TableSimpleFields);
  var f: integer;
  begin
    W.CancelAll;
    if withID and (content=TableSimpleFields) then begin
      if withTableName then
        W.AddStrings([TableName,'.']);
      W.AddString(RowIDFieldName);
      if 0 in FieldNamesMatchInternal then
        W.Add(',') else
        W.AddShort(' as ID,');
    end;
    with fProps do
    for f := 0 to Fields.Count-1 do
    with Fields.List[f] do
    if SQLFieldType in COPIABLE_FIELDS then // sftMany fields do not exist
      case content of
      TableSimpleFields:
        if f in SimpleFieldsBits[soSelect] then begin
          if withTableName then
            W.AddStrings([TableName,'.']);
          W.AddString(ExtFieldNames[f]);
          if not(f+1 in FieldNamesMatchInternal) then
            W.AddStrings([' as ',Name]); // to get expected JSON column name
          W.Add(',');
        end;
      UpdateSimple:
        if f in SimpleFieldsBits[soSelect] then
          W.AddStrings([ExtFieldNames[f],'=?,']);
      UpdateSetAll:
        W.AddStrings([ExtFieldNames[f],'=?,']);
      InsertAll:
        W.AddStrings([ExtFieldNames[f],',']);
      end;
    W.CancelLastComma;
    W.SetText(result);
  end;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try // SQL.TableSimpleFields[withID: boolean; withTableName: boolean]
    SetSQL(W,false,false,fSQL.TableSimpleFields[false,false]);
    SetSQL(W,false,true,fSQL.TableSimpleFields[false,true]);
    SetSQL(W,true,false,fSQL.TableSimpleFields[true,false]);
    SetSQL(W,true,true,fSQL.TableSimpleFields[true,true]);
    // SQL.SelectAll: array[withRowID: boolean]
    fSQL.SelectAllWithRowID := SQLFromSelect(TableName,'*','',
      fSQL.TableSimpleFields[true,false]);
    fSQL.SelectAllWithID := fSQL.SelectAllWithRowID;
    SetSQL(W,false,false,fSQL.UpdateSetSimple,UpdateSimple);
    SetSQL(W,false,false,fSQL.UpdateSetAll,UpdateSetAll);
    SetSQL(W,false,false,fSQL.InsertSet,InsertAll);
  finally
    W.Free;
  end;
end;

function TSQLRecordPropertiesMapping.InternalToExternal(const FieldName: RawUTF8): RawUTF8;
var int: integer;
begin
  int := fProps.Fields.IndexByNameOrExcept(FieldName);
  if int<0 then
    result := RowIDFieldName else
    result := fExtFieldNames[int];
end;

function TSQLRecordPropertiesMapping.InternalCSVToExternalCSV(
  const CSVFieldNames, Sep, SepEnd: RawUTF8): RawUTF8;
var IntFields,ExtFields: TRawUTF8DynArray;
begin
  CSVToRawUTF8DynArray(CSVFieldNames,Sep,SepEnd,IntFields);
  InternalToExternalDynArray(IntFields,ExtFields);
  result := RawUTF8ArrayToCSV(ExtFields,Sep)+SepEnd;
end;

procedure TSQLRecordPropertiesMapping.InternalToExternalDynArray(
  const IntFieldNames: array of RawUTF8; out result: TRawUTF8DynArray;
  IntFieldIndex: PIntegerDynArray);
var i,n,ndx: integer;
begin
  n := length(IntFieldNames);
  SetLength(result,n);
  if IntFieldIndex<>nil then
    SetLength(IntFieldIndex^,n);
  for i := 0 to n-1 do begin
    ndx := fProps.Fields.IndexByNameOrExcept(IntFieldNames[i]);
    if IntFieldIndex<>nil then
      IntFieldIndex^[i] := ndx;
    if ndx<0 then
      result[i] := RowIDFieldName else
      result[i] := fExtFieldNames[ndx];
  end;
end;

function TSQLRecordPropertiesMapping.ExternalToInternalIndex(
  const ExtFieldName: RawUTF8): integer;
begin
  if IdemPropNameU(ExtFieldName,RowIDFieldName) then
    result := -1 else begin
    // search for customized field mapping
    for result := 0 to length(fExtFieldNamesUnQuotedSQL)-1 do
      if IdemPropNameU(ExtFieldName,fExtFieldNamesUnQuotedSQL[result]) then
        exit;
    result := -2; // indicates not found
  end;
end;

function TSQLRecordPropertiesMapping.ExternalToInternalOrNull(
  const ExtFieldName: RawUTF8): RawUTF8;
var i: integer;
begin
  i := ExternalToInternalIndex(ExtFieldName);
  if i=-1 then
    result := 'ID' else
  if i>=0 then
    result := fProps.Fields.List[i].Name else
    result := ''; // indicates not found
end;

function TSQLRecordPropertiesMapping.AppendFieldName(
  FieldIndex: Integer; var Text: RawUTF8): boolean;
begin
  result := false; // success
  if FieldIndex=VIRTUAL_TABLE_ROWID_COLUMN then
    Text := Text+RowIDFieldName else
  if cardinal(FieldIndex)>=cardinal(Length(ExtFieldNames)) then
    result := true else // FieldIndex out of range
    Text := Text+ExtFieldNames[FieldIndex];
end;

function TSQLRecordPropertiesMapping.FieldNameByIndex(FieldIndex: Integer): RawUTF8;
begin
  if FieldIndex=VIRTUAL_TABLE_ROWID_COLUMN then
    result := RowIDFieldName else
  if cardinal(FieldIndex)>=cardinal(Length(ExtFieldNames)) then
    result := '' else // FieldIndex out of range
    result := ExtFieldNames[FieldIndex];
end;


{ TSQLModelRecordProperties }

constructor TSQLModelRecordProperties.Create(aModel: TSQLModel;
  aTable: TSQLRecordClass; aKind: TSQLRecordVirtualKind);
var f: integer;
begin // similar to TSQLRecordPropertiesMapping.ComputeSQL
  fModel := aModel;
  fTableIndex := fModel.GetTableIndexExisting(aTable);
  fProps := aTable.RecordProps;
  SetKind(aKind);
  with Props do
    for f := 0 to Fields.Count-1 do
    with Fields.List[f] do
    if SQLFieldType in COPIABLE_FIELDS then begin // sftMany fields do not exist
      // pre-computation of SQL statements
      SQL.UpdateSetAll := SQL.UpdateSetAll+Name+'=?,';
      SQL.InsertSet := SQL.InsertSet+Name+',';
      if f in SimpleFieldsBits[soUpdate] then
        SQL.UpdateSetSimple := SQL.UpdateSetSimple+Name+'=?,';
      // filter + validation of unique fields, i.e. if marked as "stored false"
      if f in IsUniqueFieldsBits then begin
        // must trim() text value before storage, and validate for unicity
        if SQLFieldType in [sftUTF8Text,sftAnsiText] then
          AddFilterOrValidate(f,TSynFilterTrim.Create);
        // register unique field pre-validation
        AddFilterOrValidate(f,TSynValidateUniqueField.Create);
      end;
    end;
  SetLength(SQL.InsertSet,length(SQL.InsertSet)-1);
  SetLength(SQL.UpdateSetAll,length(SQL.UpdateSetAll)-1); // 'COL1=?,COL2=?'
  if SQL.UpdateSetSimple<>'' then
    SetLength(SQL.UpdateSetSimple,length(SQL.UpdateSetSimple)-1); // 'COL1=?,COL2=?'
  Props.InternalRegisterModel(aModel,aModel.GetTableIndexExisting(aTable),self);
end;

constructor TSQLModelRecordProperties.CreateFrom(aModel: TSQLModel;
  aSource: TSQLModelRecordProperties);
begin
  inherited Create;
  fModel := aModel;
  fTableIndex := aSource.fTableIndex;
  fFTSWithoutContentTableIndex := aSource.fFTSWithoutContentTableIndex;
  fFTSWithoutContentFields := aSource.fFTSWithoutContentFields;
  fProps := aSource.fProps;
  fKind := aSource.Kind;
  SQL := aSource.SQL;
  ExternalDB := aSource.ExternalDB;
  Props.InternalRegisterModel(fModel,fModel.GetTableIndexExisting(fProps.Table),self);
end;

procedure TSQLModelRecordProperties.SetKind(Value: TSQLRecordVirtualKind);
  function IntSQLTableSimpleFields(withID, withTableName: boolean): RawUTF8;
  const IDComma: array[TSQLRecordVirtualKind] of rawUTF8 =
    ('ID,','RowID,','RowID,','RowID,','RowID,','RowID,','RowID,','RowID,');
  // rSQLite3, rFTS3, rFTS4, rFTS5, rRTree, rRTreeInteger, rCustomForcedID, rCustomAutoID
  var TableName: RawUTF8;
      i: integer;
  begin
    if withTableName then
      TableName := Props.SQLTableName+'.'; // calc TableName once
    if withID then
      if withTableName then
        result := TableName+IDComma[Kind] else
        result := IDComma[Kind] else
      result := '';
    for i := 0 to length(Props.SimpleFields)-1 do begin
      if withTableName then
        result := result+TableName;
      result := result+Props.SimpleFields[i].Name+','; // valid simple fields
    end;
    if result<>'' then
      SetLength(result,length(result)-1); // trim last ','
  end;
var f: integer;
    expected: TSQLFieldType;
begin
  case Value of // validates virtual table fields expectations
  rFTS3, rFTS4, rFTS5: begin
    if Props.Fields.Count=0 then
      raise EModelException.CreateUTF8(
        'Virtual FTS class % should have published properties',[Props.Table]);
    for f := 0 to Props.Fields.Count-1 do
      with Props.Fields.List[f] do
        if SQLFieldTypeStored<>sftUTF8Text then
          raise EModelException.CreateUTF8('%.%: FTS field must be RawUTF8',[Props.Table,Name])
  end;
  rRTree, rRTreeInteger: begin
    Props.RTreeCoordBoundaryFields := 0;
    if Value=rRTree then
      expected := sftFloat else
      expected := sftInteger;
    for f := 0 to Props.Fields.Count-1 do
      with Props.Fields.List[f] do
      if aAuxiliaryRTreeField in Attributes then // https://sqlite.org/rtree.html#auxiliary_columns
        expected := sftUnknown // will expect further columns to be auxiliary
      else if SQLFieldTypeStored<>expected then
        raise EModelException.CreateUTF8('%.%: RTREE field must be %',
          [Props.Table,Name,ToText(expected)^]) else
        inc(Props.RTreeCoordBoundaryFields);
    if (Props.RTreeCoordBoundaryFields<2) or
       (Props.RTreeCoordBoundaryFields>RTREE_MAX_DIMENSION*2) or
       (Props.RTreeCoordBoundaryFields and 1<>0) then
      raise EModelException.CreateUTF8('% has % fields: RTREE expects 2,4,6..% boundary columns',
        [Props.Table,Props.RTreeCoordBoundaryFields,RTREE_MAX_DIMENSION*2]);
  end;
  end;
  fKind := Value;
  // SQL.TableSimpleFields[withID: boolean; withTableName: boolean]
  SQL.TableSimpleFields[false,false] := IntSQLTableSimpleFields(false,false);
  SQL.TableSimpleFields[false,true] := IntSQLTableSimpleFields(false,true);
  SQL.TableSimpleFields[true,false] := IntSQLTableSimpleFields(true,false);
  SQL.TableSimpleFields[true,true] := IntSQLTableSimpleFields(true,true);
  if Props.SQLTableSimpleFieldsNoRowID<>SQL.TableSimpleFields[false,false] then
    raise EModelException.CreateUTF8('SetKind(%)',[Props.Table]);
  SQL.SelectAllWithRowID := SQLFromSelectWhere('*','');
  SQL.SelectAllWithID := SQL.SelectAllWithRowID;
  if IdemPChar(PUTF8Char(pointer(SQL.SelectAllWithID))+7,'ROWID') then
    delete(SQL.SelectAllWithID,8,3); // 'SELECT RowID,..' -> 'SELECT ID,'
end;

function TSQLModelRecordProperties.SQLFromSelectWhere(
  const SelectFields, Where: RawUTF8): RawUTF8;
begin
  result := SQLFromSelect(Props.SQLTableName,SelectFields,Where,
    SQL.TableSimpleFields[true,false]);
end;

procedure TSQLModelRecordProperties.FTS4WithoutContent(ContentTable: TSQLRecordClass);
var i: integer;
    field: RawUTF8;
begin
  if not(Kind in [rFTS4,rFTS5]) then
    raise EModelException.CreateUTF8('FTS4WithoutContent: % is not a FTS4/5 table',[Props.Table]);
  fFTSWithoutContentTableIndex := fModel.GetTableIndexExisting(ContentTable);
  for i := 0 to Props.Fields.Count-1 do begin
    field := Props.Fields.List[i].Name;
    if ContentTable.RecordProps.Fields.IndexByName(field)<0 then
      raise EModelException.CreateUTF8('FTS4WithoutContent: %.% is not a % field',
        [Props.Table,field,ContentTable]);
    fFTSWithoutContentFields := fFTSWithoutContentFields+',new.'+field;
  end;
  if fFTSWithoutContentFields='' then
    raise EModelException.CreateUTF8('FTS4WithoutContent: % has no field',[Props.Table]);
end;

function TSQLModelRecordProperties.GetProp(const PropName: RawUTF8): TSQLPropInfo;
begin
  if self<>nil then
    result := Props.Fields.ByName(pointer(PropName)) else
    result := nil;
end;


{ TSQLModel }

function TSQLModel.GetTableIndexSafe(aTable: TSQLRecordClass;
  RaiseExceptionIfNotExisting: boolean): integer;
begin
  for result := 0 to fTablesMax do // manual search: GetTableIndex() may fail
    if fTables[result]=aTable then
      exit;
  if RaiseExceptionIfNotExisting then
    raise EModelException.CreateUTF8('% must include %',[self,aTable]);
  result := -1;
end;

procedure TSQLModel.SetTableProps(aIndex: integer);
var j,f: integer;
    t: TSQLFieldType;
    Kind: TSQLRecordVirtualKind;
    Table, TableID: TSQLRecordClass;
    aTableName,aFieldName: RawUTF8;
    Props: TSQLModelRecordProperties;
    fields: TSQLPropInfoList;
    W: TTextWriter;

  procedure RegisterTableForRecordReference(aFieldType: TSQLPropInfo;
    aFieldTable: TClass);
  var R: integer;
  begin
    if (aFieldTable=nil) or (aFieldTable=TSQLRecord) or not aFieldTable.InheritsFrom(TSQLRecord) then
      exit; // no associated table to track deletion
    R := length(fRecordReferences);
    SetLength(fRecordReferences,R+1);
    with fRecordReferences[R] do begin
      TableIndex := aIndex;
      FieldType := aFieldType;
      FieldTable := pointer(aFieldTable);
      FieldTableIndex := GetTableIndexSafe(FieldTable,false);
      if FieldTableIndex<0 then
        FieldTableIndex := -2; // allow lazy table index identification
      if aFieldType.InheritsFrom(TSQLPropInfoRTTIRecordReference) then
        CascadeDelete := TSQLPropInfoRTTIRecordReference(aFieldType).CascadeDelete;
    end;
  end;

begin
  if (cardinal(aIndex)>cardinal(fTablesMax)) or (fTableProps[aIndex]<>nil) then
    raise EModelException.Create('TSQLModel.SetTableProps');
  Table := fTables[aIndex];
  if Table.InheritsFrom(TSQLRecordFTS5) then
    Kind := rFTS5 else
  if Table.InheritsFrom(TSQLRecordFTS4) then
    Kind := rFTS4 else
  if Table.InheritsFrom(TSQLRecordFTS3) then
    Kind := rFTS3 else
  if Table.InheritsFrom(TSQLRecordVirtualTableForcedID) then
    Kind := rCustomForcedID else
  if Table.InheritsFrom(TSQLRecordRTree) then
    Kind := rRTree else
  if Table.InheritsFrom(TSQLRecordRTreeInteger) then
    Kind := rRTreeInteger else
  if Table.InheritsFrom(TSQLRecordVirtual) then
    Kind := rCustomAutoID else
    Kind := rSQLite3;
  Props := TSQLModelRecordProperties.Create(self,Table,Kind);
  Props.Props.InternalRegisterModel(Self,aIndex,Props);
  for t := low(t) to high(t) do
    if fCustomCollationForAll[t]<>'' then
      Props.Props.SetCustomCollationForAll(t,fCustomCollationForAll[t]);
  fTableProps[aIndex] := Props;
  aTableName := Props.Props.SQLTableName;
  UpperCaseCopy(aTableName,fSortedTablesNameUpper[aIndex]);
  fSortedTablesNameIndex[aIndex] := aIndex;
  fields := Props.Props.Fields;
  for f := 0 to fields.Count-1 do
    case fields.List[f].SQLFieldType of
    sftRecord:
      RegisterTableForRecordReference(fields.List[f],Table); // Table not used
    sftID:
      RegisterTableForRecordReference(
        fields.List[f],(fields.List[f] as TSQLPropInfoRTTIInstance).ObjectClass);
    sftTID: begin
      TableID := (fields.List[f] as TSQLPropInfoRTTITID).RecordClass;
      if TableID=nil then // T*ID name didn't match any TSQLRecord type
        fields.List[f].fSQLFieldType := sftInteger else
        RegisterTableForRecordReference(fields.List[f],TableID);
    end;
    sftMany:
      GetTableIndexSafe(pointer((fields.List[f] as TSQLPropInfoRTTIMany).ObjectClass),true);
    end;
  if Props.Props.JoinedFieldsTable<>nil then begin
    W := TTextWriter.CreateOwnedStream;
    try
      W.AddShort('SELECT ');
      // JoinedFieldsTable[0] is the class itself
      with Props.Props do begin
        W.Add('%.RowID as `%.RowID`,',[SQLTableName,SQLTableName]);
        for f := 0 to length(SimpleFields)-1 do
          if SimpleFields[f].SQLFieldType<>sftID then
            W.Add('%.% as `%.%`,',[SQLTableName,SimpleFields[f].Name,
              SQLTableName,SimpleFields[f].Name]);
      end;
      // add JoinedFieldsTable[1..] fields
      for j := 1 to high(Props.Props.JoinedFieldsTable) do begin
        aFieldName := Props.Props.JoinedFields[j-1].Name;
        W.Add('%.RowID as `%.RowID`,',[aFieldName,aFieldName]);
        with Props.Props.JoinedFieldsTable[j].RecordProps do
        for f := 0 to High(SimpleFields) do
          if SimpleFields[f].SQLFieldType<>sftID then
            W.Add('%.% as `%.%`,',[aFieldName,SimpleFields[f].Name,
              aFieldName,SimpleFields[f].Name]);
      end;
      W.CancelLastComma;
      // add LEFT JOIN clause
      W.AddStrings([' FROM ',aTableName]);
      for j := 1 to high(Props.Props.JoinedFieldsTable) do begin
        aFieldName := Props.Props.JoinedFields[j-1].Name;
        with Props.Props.JoinedFieldsTable[j].RecordProps do
          W.Add(' LEFT JOIN % AS % ON %.%=%.RowID',[
            SQLTableName,aFieldName,aTableName,aFieldName,aFieldName]);
      end;
      W.SetText(Props.SQL.SelectAllJoined);
    finally
      W.Free;
    end;
  end;
end;

function TSQLModel.GetTableProps(aClass: TSQLRecordClass): TSQLModelRecordProperties;
begin
  result := fTableProps[GetTableIndexExisting(aClass)];
end;

function TSQLModel.AddTable(aTable: TSQLRecordClass;
  aTableIndexCreated: PInteger=nil): boolean;
var n: integer;
begin
  // first register for JSONToObject() and for TSQLPropInfoRTTITID.Create()
  TJSONSerializer.RegisterClassForJSON(aTable);
  // insert only once
  if GetTableIndex(aTable)>=0 then begin
    result := false;
    exit;
  end;
  // add to the model list
  inc(fTablesMax);
  n := fTablesMax+1;
  SetLength(fTables,n);
  SetLength(fSortedTablesNameUpper,n);
  SetLength(fSortedTablesNameIndex,n);
  SetLength(fTableProps,n);
  fTables[fTablesMax] := aTable;
  SetTableProps(fTablesMax);
  QuickSortRawUTF8(fSortedTablesNameUpper,fTablesMax+1,@fSortedTablesNameIndex);
  if aTableIndexCreated<>nil then
    aTableIndexCreated^ := fTablesMax;
  result := true;
end;

function TSQLModel.AddTableInherited(aTable: TSQLRecordClass): pointer;
var ndx: integer;
begin
  ndx := GetTableIndexInheritsFrom(aTable);
  if ndx<0 then
    if not AddTable(aTable,@ndx) then
      raise EModelException.CreateUTF8('%.AddTableInherited(%)',[self,aTable]);
  result := Tables[ndx];
end;

function TSQLModel.GetTableInherited(aTable: TSQLRecordClass): TSQLRecordClass;
var ndx: integer;
begin
  ndx := GetTableIndexInheritsFrom(aTable);
  if ndx<0 then
    result := aTable else
    result := Tables[ndx];
end;

constructor TSQLModel.Create(CloneFrom: TSQLModel);
var i: integer;
begin
  if CloneFrom=nil then
    raise EModelException.CreateUTF8('%.Create(CloneFrom=nil)',[self]);
  fTables := CloneFrom.fTables;
  fTablesMax := CloneFrom.fTablesMax;
  if fTablesMax<>High(fTables) then
    raise EModelException.CreateUTF8('%.Create: incorrect CloneFrom.TableMax',[self]);
  SetRoot(CloneFrom.fRoot);
  fActions := CloneFrom.fActions;
  fEvents := CloneFrom.fEvents;
  fRestOwner := CloneFrom.fRestOwner;
  fSortedTablesNameUpper := CloneFrom.fSortedTablesNameUpper;
  fSortedTablesNameIndex := CloneFrom.fSortedTablesNameIndex;
  fRecordReferences := CloneFrom.fRecordReferences;
  fVirtualTableModule := CloneFrom.fVirtualTableModule;
  fCustomCollationForAll := CloneFrom.fCustomCollationForAll;
  SetLength(fTableProps,fTablesMax+1);
  for i := 0 to fTablesMax do
    fTableProps[i] := TSQLModelRecordProperties.CreateFrom(
      self,CloneFrom.fTableProps[i]);
end;

constructor TSQLModel.Create(Owner: TSQLRest; TabParameters: PSQLRibbonTabParameters;
  TabParametersCount, TabParametersSize: integer;
  const NonVisibleTables: array of TSQLRecordClass;
  Actions, Events: PTypeInfo; const aRoot: RawUTF8);
var i: integer;
    Tables: array of TSQLRecordClass;
begin
  if (TabParameters=nil) or (TabParametersCount<=0) or
     (cardinal(TabParametersSize)<SizeOf(TSQLRibbonTabParameters)) then
    raise EModelException.CreateUTF8('%.Create(TabParameters?)',[self]);
  SetLength(Tables,TabParametersCount+length(NonVisibleTables));
  for i := 0 to TabParametersCount-1 do begin
    Tables[i] := TabParameters^.Table;
    inc(PByte(TabParameters),TabParametersSize);
  end;
  for i := 0 to high(NonVisibleTables) do
    Tables[i+TabParametersCount] := NonVisibleTables[i];
  Create(Tables,aRoot);
  fRestOwner := Owner;
  SetActions(Actions);
  SetEvents(Events);
end;

constructor TSQLModel.Create;
begin
  raise EModelException.CreateUTF8('Plain %.Create is not allowed: use overloaded Create()',[self]);
end;

function TSQLModel.SafeRoot: RawUTF8;
begin
  if self=nil then
    result := '' else
    result := fRoot;
end;

procedure TSQLModel.SetRoot(const aRoot: RawUTF8);
var i: integer;
begin
  for i := 1 to length(aRoot) do // allow RFC URI + '/' for URI-fragment
    if not (aRoot[i] in ['0'..'9','a'..'z','A'..'Z','_','-','.','~',' ','/']) then
      raise EModelException.CreateUTF8('%.Root="%" contains URI unfriendly chars',[self,aRoot]);
  if (aRoot<>'') and (aRoot[length(aRoot)]='/') then
    fRoot := copy(aRoot,1,Length(aRoot)-1) else
    fRoot := aRoot;
  UpperCaseCopy(fRoot,fRootUpper);
end;

constructor TSQLModel.Create(const Tables: array of TSQLRecordClass; const aRoot: RawUTF8);
var N, i: integer;
begin
  N := length(Tables);
  if N>SizeOf(SUPERVISOR_ACCESS_RIGHTS.Get)*8 then // TSQLAccessRights bits size
    raise EModelException.CreateUTF8('% % has too many Tables: %>%',
      [self,aRoot,N,SizeOf(SUPERVISOR_ACCESS_RIGHTS.Get)*8]); // e.g. N>64
  // set the Tables to be associated with this Model, as TSQLRecord classes
  fTablesMax := N-1;
  SetLength(fTables,N);
  MoveFast(Tables[0],fTables[0],N*SizeOf(Tables[0]));
  for i := 0 to N-1 do
    // first register for JSONToObject() and for TSQLPropInfoRTTITID.Create()
    TJSONSerializer.RegisterClassForJSON(Tables[i]);
  SetLength(fSortedTablesNameUpper,N);
  SetLength(fSortedTablesNameIndex,N);
  SetLength(fTableProps,N);
  // initialize internal properties
  for i := 0 to fTablesMax do
    SetTableProps(i);
  QuickSortRawUTF8(fSortedTablesNameUpper,fTablesMax+1,@fSortedTablesNameIndex);
  // set the optional Root URI path of this Model
  if aRoot<>'' then
    SetRoot(aRoot);
end;

function TSQLModel.GetIsUnique(aTable: TSQLRecordClass; aFieldIndex: integer): boolean;
var i: integer;
begin
  i := GetTableIndex(aTable);
  if (i<0) or (Cardinal(aFieldIndex)>=MAX_SQLFIELDS) then
    result := false else
    result := aFieldIndex in TableProps[i].Props.IsUniqueFieldsBits;
end;

function GetTableNameFromSQLSelect(const SQL: RawUTF8;
  EnsureUniqueTableInFrom: boolean): RawUTF8;
var i,j,k: integer;
begin
  i := PosI(' FROM ',SQL);
  if i>0 then begin
    inc(i,6);
    while SQL[i] in [#1..' '] do inc(i);
    j := 0;
    while tcIdentifier in TEXT_CHARS[SQL[i+j]] do inc(j);
    if cardinal(j-1)<64 then begin
      k := i+j;
      while SQL[k] in [#1..' '] do inc(k);
      if not EnsureUniqueTableInFrom or (SQL[k]<>',') then begin
        FastSetString(result,PAnsiChar(PtrInt(SQL)+i-1),j);
        exit;
      end;
    end;
  end;
  result := '';
end;

function GetTableNamesFromSQLSelect(const SQL: RawUTF8): TRawUTF8DynArray;
var i,j,k,n: integer;
begin
  result := nil;
  n := 0;
  i := PosI(' FROM ',SQL);
  if i>0 then begin
    inc(i,6);
    repeat
      while SQL[i] in [#1..' '] do inc(i);
      j := 0;
      while tcIdentifier in TEXT_CHARS[SQL[i+j]] do inc(j);
      if cardinal(j-1)>64 then begin
        result := nil;
        exit; // seems too big
      end;
      k := i+j;
      while SQL[k] in [#1..' '] do inc(k);
      SetLength(result,n+1);
      FastSetString(result[n],PAnsiChar(PtrInt(SQL)+i-1),j);
      inc(n);
      if SQL[k]<>',' then
        break;
      i := k+1;
    until false;
  end;
end;

function TSQLModel.GetTableIndexFromSQLSelect(const SQL: RawUTF8;
  EnsureUniqueTableInFrom: boolean): integer;
var TableName: RawUTF8;
begin
  TableName := GetTableNameFromSQLSelect(SQL,EnsureUniqueTableInFrom);
  result := GetTableIndex(TableName);
end;

function TSQLModel.GetTableIndexesFromSQLSelect(const SQL: RawUTF8): TIntegerDynArray;
var TableNames: TRawUTF8DynArray;
    i,t,n,ndx: integer;
begin
  result := nil;
  TableNames := GetTableNamesFromSQLSelect(SQL);
  t := length(TableNames);
  if t=0 then
    exit;
  SetLength(result,t);
  n := 0;
  for i := 0 to t-1 do begin
    ndx := GetTableIndex(TableNames[i]);
    if ndx<0 then
      continue;
    result[n] := ndx;
    inc(n);
  end;
  if n<>t then
    SetLength(result,n);
end;

function TSQLModel.GetTablesFromSQLSelect(const SQL: RawUTF8): TSQLRecordClassDynArray;
var t: TIntegerDynArray;
    n,i: integer;
begin
  result := nil;
  t := GetTableIndexesFromSQLSelect(SQL);
  n := length(t);
  if n=0 then
    exit;
  SetLength(result,n);
  for i := 0 to n-1 do
    result[i] := Tables[t[i]];
end;

function TSQLModel.GetTable(const SQLTableName: RawUTF8): TSQLRecordClass;
var i: integer;
begin
  i := GetTableIndex(SQLTableName);
  if i>=0 then
    result := Tables[i] else
    result := nil;
end;

function TSQLModel.GetTableExactClass(const TableName: RawUTF8): TSQLRecordClass;
var i: integer;
begin
  i := GetTableExactIndex(TableName);
  if i>=0 then
    result := Tables[i] else
    result := nil;
end;

function TSQLModel.GetTableIndex(aTable: TSQLRecordClass): integer;
var i: PtrInt;
    Props: TSQLRecordProperties;
    c: PSQLRecordClass;
begin
  if (self<>nil) and (aTable<>nil) then begin
    Props := PPointer(PtrInt(PtrUInt(aTable))+vmtAutoTable)^;
    if (Props<>nil) and (Props.fModelMax<fTablesMax) then
      // fastest O(1) search in all registered models (if worth it)
      for i := 0 to Props.fModelMax do
        with Props.fModel[i] do
          if Model=self then begin
            result := TableIndex; // almost always loop-free
            exit;
          end;
    // manual search e.g. if fModel[] is not yet set
    c := pointer(Tables);
    for result := 0 to fTablesMax do
      if c^=aTable then
        exit else
        inc(c);
  end;
  result := -1;
end;

function TSQLModel.GetTableIndexInheritsFrom(aTable: TSQLRecordClass): integer;
begin
  if (self<>nil) and (aTable<>nil) and (aTable<>TSQLRecord) then
    for result := 0 to fTablesMax do
      if Tables[result].InheritsFrom(aTable) then
        exit;
  result := -1;
end;

function TSQLModel.GetTableIndexExisting(aTable: TSQLRecordClass): integer;
begin
  if self=nil then
    raise EModelException.Create('nil.GetTableIndexExisting');
  if aTable=nil then
    raise EModelException.CreateUTF8('%.GetTableIndexExisting(nil) %',[self,Root]);
  result := GetTableIndex(aTable);
  if result<0 then
    raise EModelException.CreateUTF8('% is not part of % %',[aTable,self,Root]);
end;

function TSQLModel.GetTableExactIndex(const TableName: RawUTF8): integer;
var L: integer;
begin
  if self<>nil then begin
  L := length(TableName);
  for result := 0 to fTablesMax do
    if Tables[result]<>nil then // avoid GPF
    if IdemPropName(
       // new TObject.ClassName is UnicodeString (Delphi 20009) -> inline code
       // using vmtClassName = UTF-8 encoded text stored as shortstring
       PShortString(PPointer(PtrInt(PtrUInt(Tables[result]))+vmtClassName)^)^,
       pointer(TableName),L) then
      exit;  // case insensitive search
  end;
  result := -1;
end;

function TSQLModel.GetTableIndex(const SQLTableName: RawUTF8): integer;
begin
  if (self<>nil) and (SQLTableName<>'') then begin
    result := FastFindUpperPUTF8CharSorted( // O(log(n)) binary search
      pointer(fSortedTablesNameUpper),fTablesMax,pointer(SQLTableName),length(SQLTableName));
    if result>=0 then
      result := fSortedTablesNameIndex[result];
  end else
    result := -1;
end;

function TSQLModel.GetTableIndexPtr(SQLTableName: PUTF8Char): integer;
begin
  if (self<>nil) and (SQLTableName<>nil) then begin
    result := FastFindUpperPUTF8CharSorted( // O(log(n)) binary search
      pointer(fSortedTablesNameUpper),fTablesMax,SQLTableName,StrLen(SQLTableName));
    if result>=0 then
      result := fSortedTablesNameIndex[result];
  end else
    result := -1;
end;

function TSQLModel.getURI(aTable: TSQLRecordClass): RawUTF8;
begin
  result := '';
  if self=nil then
    exit;
  if aTable<>nil then
    result := aTable.RecordProps.SQLTableName else begin
    result := Root;
    exit;
  end;
  if Root<>'' then
    result := Root+'/'+result;
end;

function TSQLModel.URIMatch(const URI: RawUTF8): TSQLRestModelMatch;
var URILen: integer;
begin
  result := rmNoMatch;
  if (self=nil) or (fRoot='') or (URI='') then
    exit;
  if IdemPChar(pointer(URI),pointer(fRootUpper)) then begin
    URILen := length(fRoot);
    if URI[URILen+1] in [#0,'/','?'] then
      if CompareMemFixed(pointer(URI),pointer(fRoot),URILen) then
        result := rmMatchExact else
        result := rmMatchWithCaseChange;
  end;
end;

function TSQLModel.SQLFromSelectWhere(const Tables: array of TSQLRecordClass;
   const SQLSelect, SQLWhere: RawUTF8): RawUTF8;
var i: integer;
    aProps: array[0..31] of TSQLModelRecordProperties;
begin
  if self=nil then
    raise EORMException.Create('Model required');
  if high(Tables)=0 then begin
    // fastest common call with one TSQLRecordClass
    result := Props[Tables[0]].SQLFromSelectWhere(SQLSelect,SQLWhere);
    exit;
  end;
  // 'SELECT T1.F1,T1.F2,T1.F3,T2.F1,T2.F2 FROM T1,T2 WHERE ..' e.g.
  if cardinal(high(Tables))>high(aProps) then
    raise EModelException.CreateUTF8('%.SQLFromSelectWhere() up to % Tables[]',
      [self,Length(aProps)]);
  for i := 0 to high(Tables) do
    aProps[i] := Props[Tables[i]]; // raise EModelException if not found
  if SQLSelect='*' then
     // don't send BLOB values to query: retrieve all other fields
    if high(Tables)=0 then
      result := 'SELECT '+aProps[0].SQL.TableSimpleFields[true,false] else begin
      result := 'SELECT '+aProps[0].SQL.TableSimpleFields[true,true];
      for i := 1 to high(Tables) do
        result := result+','+aProps[i].SQL.TableSimpleFields[true,true];
    end else
    result := 'SELECT '+SQLSelect;
  result := result+' FROM '+aProps[0].Props.SQLTableName;
  for i := 1 to high(Tables) do
    result := result+','+aProps[i].Props.SQLTableName;
  result := result+SQLFromWhere(SQLWhere);
end;

procedure TSQLModel.SetCustomCollationForAll(aFieldType: TSQLFieldType;
  const aCollationName: RawUTF8);
var i: integer;
begin
  if self=nil then
    exit;
  if fCustomCollationForAll[aFieldType]<>'' then
    raise EModelException.CreateUTF8('%.SetCustomCollationForAll(%)'+
      ' shall be called only once',[self,aCollationName]);
  fCustomCollationForAll[aFieldType] := aCollationName;
  for i := 0 to high(fTableProps) do
    fTableProps[i].fProps.SetCustomCollationForAll(aFieldType,aCollationName);
end;

procedure TSQLModel.SetMaxLengthValidatorForAllTextFields(IndexIsUTF8Length: boolean);
var i: integer;
begin
  if self<>nil then
    for i := 0 to high(fTableProps) do
      fTableProps[i].fProps.SetMaxLengthValidatorForTextFields(IndexIsUTF8Length);
end;

procedure TSQLModel.SetMaxLengthFilterForAllTextFields(IndexIsUTF8Length: boolean);
var i: integer;
begin
  if self<>nil then
    for i := 0 to high(fTableProps) do
      fTableProps[i].fProps.SetMaxLengthFilterForTextFields(IndexIsUTF8Length);
end;

{$ifndef NOVARIANTS}
procedure TSQLModel.SetVariantFieldsDocVariantOptions(const Options: TDocVariantOptions);
var i: integer;
begin
  if self<>nil then
    for i := 0 to high(fTableProps) do
      fTableProps[i].fProps.SetVariantFieldsDocVariantOptions(Options);
end;
{$endif}

function TSQLModel.SetIDGenerator(aTable: TSQLRecordClass;
  aIdentifier: TSynUniqueIdentifierProcess; const aSharedObfuscationKey: RawUTF8): TSynUniqueIdentifierGenerator;
var i: integer;
begin
  i := GetTableIndexExisting(aTable);
  if i>=length(fIDGenerator) then
    SetLength(fIDGenerator,fTablesMax+1);
  result := TSynUniqueIdentifierGenerator.Create(aIdentifier,aSharedObfuscationKey);
  fIDGenerator[i].Free;
  fIDGenerator[i] := result;
end;

function TSQLModel.GetIDGenerator(aTable: TSQLRecordClass): TSynUniqueIdentifierGenerator;
var i: cardinal;
begin
  i := GetTableIndexExisting(aTable);
  if i<cardinal(length(fIDGenerator)) then
    result := fIDGenerator[i] else
    result := nil;
end;

function TSQLModel.NewRecord(const SQLTableName: RawUTF8): TSQLRecord;
var aClass: TSQLRecordClass;
begin
  aClass := Table[SQLTableName];
  if aClass=nil then
    result := nil else
    result := aClass.Create;
end;

procedure TSQLModel.SetActions(aActions: PTypeInfo);
begin
  if (aActions=nil) or not (aActions^.Kind=tkEnumeration) then
    fActions := nil else
    fActions := aActions^.EnumBaseType;
end;

procedure TSQLModel.SetEvents(aEvents: PTypeInfo);
begin
  if (aEvents=nil) or not (aEvents^.Kind=tkEnumeration) then
    fEvents := nil else
    fEvents := aEvents^.EnumBaseType;
end;

function TSQLModel.GetSQLCreate(aTableIndex: integer): RawUTF8;
begin
  if (self=nil) or (cardinal(aTableIndex)>cardinal(fTablesMax)) then
    result := '' else
    result := Tables[aTableIndex].GetSQLCreate(self);
end;

function TSQLModel.GetSQLAddField(aTableIndex: integer; aFieldIndex: integer): RawUTF8;
begin
  if (self=nil) or (cardinal(aTableIndex)>cardinal(fTablesMax)) then
    result := '' else
    result := TableProps[aTableIndex].Props.SQLAddField(aFieldIndex);
end;

function TSQLModel.isLocked(aTable: TSQLRecordClass; aID: TID): boolean;
begin
  result := GetLocks(aTable)^.isLocked(aID);
end;

function TSQLModel.isLocked(aRec: TSQLRecord): boolean;
begin
  if aRec=nil then
    result := false else
    result := isLocked(PSQLRecordClass(aRec)^,aRec.fID);
end;

function TSQLModel.Lock(aTable: TSQLRecordClass; aID: TID): boolean;
begin
  if self=nil then
    result := false else begin
    if fLocks=nil then
      SetLength(fLocks,fTablesMax+1); // initialize fLocks[] if necessary
    result :=  GetLocks(aTable)^.Lock(aID);
  end;
end;

function TSQLModel.Lock(aTableIndex: integer; aID: TID): boolean;
begin
  if (self=nil) or (Cardinal(aTableIndex)>cardinal(fTablesMax)) then
    result := false else begin
    if fLocks=nil then
      SetLength(fLocks,fTablesMax+1); // initialize fLocks[] if necessary
    result := fLocks[aTableIndex].Lock(aID);
  end;
end;

function TSQLModel.Lock(aRec: TSQLRecord): boolean;
begin
  if aRec=nil then
    result := false else
    result := Lock(PSQLRecordClass(aRec)^,aRec.fID);
end;

procedure TSQLModel.PurgeOlderThan(MinutesFromNow: cardinal);
var i: PtrInt;
begin
  if fLocks<>nil then
    for i := 0 to length(fLocks)-1 do
     fLocks[i].PurgeOlderThan(MinutesFromNow);
end;

function TSQLModel.UnLock(aTable: TSQLRecordClass; aID: TID): boolean;
begin
  if (self=nil) or (fLocks=nil) then
    result := false else
    result := GetLocks(aTable)^.UnLock(aID);
end;

function TSQLModel.UnLock(aTableIndex: integer; aID: TID): boolean;
begin
  if (self=nil) or (cardinal(aTableIndex)>=cardinal(length(fLocks))) then
    result := false else
    result := fLocks[aTableIndex].UnLock(aID);
end;

function TSQLModel.UnLock(aRec: TSQLRecord): boolean;
begin
  if aRec=nil then
    result := false else
    result := UnLock(PSQLRecordClass(aRec)^,aRec.fID);
end;

function TSQLModel.GetLocks(aTable: TSQLRecordClass): PSQLLocks;
begin
  if (self=nil) or (fLocks=nil) then
    result := nil else
    result := @fLocks[GetTableIndexExisting(aTable)];
end;

procedure TSQLModel.UnLockAll;
var i: PtrInt;
begin
  for i := 0 to length(fLocks)-1 do
    fLocks[i].Count := 0;
end;

function TSQLModel.getURIID(aTable: TSQLRecordClass; aID: TID): RawUTF8;
begin
  result := getURI(aTable);
  if aID>0 then
    result := result+'/'+Int64ToUtf8(aID);
end;

function TSQLModel.getURICallBack(const aMethodName: RawUTF8; aTable: TSQLRecordClass; aID: TID): RawUTF8;
begin
  result := getURIID(aTable,aID)+'/'+aMethodName;
end;

function TSQLModel.ActionName(const Action): string;
begin
  if (Self=nil) or (fActions=nil) then
    result := '' else
    result := TSQLRecord.CaptionNameFromRTTI(fActions^.GetEnumName(byte(Action)));
end;

function TSQLModel.EventName(const Event): string;
begin
  if (Self=nil) or (fEvents=nil) then
    result := '' else
    result := TSQLRecord.CaptionNameFromRTTI(fEvents^.GetEnumName(byte(Event)));
end;

function TSQLModel.RecordReference(Table: TSQLRecordClass; ID: TID): TRecordReference;
begin
  if (self=nil) or (ID<=0) then
    result := 0 else begin
    result := GetTableIndexExisting(Table);
    if result>63 then // TRecordReference handle up to 64=1 shl 6 tables
      result := 0 else
      inc(result,ID shl 6);
  end;
end;

function TSQLModel.RecordReferenceTable(const Ref: TRecordReference): TSQLRecordClass;
var i: integer;
begin
  i := Ref and 63;
  if i<=fTablesMax then
    result := fTables[i] else
    result := nil;
end;

function TSQLModel.VirtualTableRegister(aClass: TSQLRecordClass;
  aModule: TSQLVirtualTableClass; const aExternalTableName: RawUTF8;
  aExternalDataBase: TObject; aMappingOptions: TSQLRecordPropertiesMappingOptions): boolean;
var i: integer;
begin
  result := false;
  if aClass=nil then exit;
  i := GetTableIndexExisting(aClass);
  with TableProps[i] do begin
    if not (Kind in IS_CUSTOM_VIRTUAL) then
      if Kind=rSQLite3 then
        SetKind(rCustomAutoID) else // SetKind() recompute all SQL
        raise EModelException.CreateUTF8('Invalid %.VirtualTableRegister(%) call: '+
          'impossible to set class as virtual',[self,aClass]);
    ExternalDB.Init(aClass,aExternalTableName,aExternalDataBase,true,aMappingOptions);
  end;
  if high(fVirtualTableModule)<>fTablesMax then
    SetLength(fVirtualTableModule,fTablesMax+1);
  fVirtualTableModule[i] := aModule;
  result := true;
end;

function TSQLModel.VirtualTableModule(aClass: TSQLRecordClass): TSQLVirtualTableClass;
var i: integer;
begin
  result := nil;
  if (self=nil) or (fVirtualTableModule=nil) then
    exit;
  i := GetTableIndexExisting(aClass);
  if TableProps[i].Kind in IS_CUSTOM_VIRTUAL then
    result := fVirtualTableModule[i];
end;

destructor TSQLModel.Destroy;
var i,j: integer;
begin
  for i := 0 to fTablesMax do begin
    with TableProps[i].Props do begin
      EnterCriticalSection(fLock); // may be called from several threads at once
      try
        for j := 0 to fModelMax do
          if fModel[j].Model=self then begin
            // un-associate this TSQLRecord with this model
            MoveFast(fModel[j+1],fModel[j],(fModelMax-j)*SizeOf(fModel[j]));
            dec(fModelMax);
            break;
          end;
        TableProps[i].Free;
      finally
        LeaveCriticalSection(fLock);
      end;
    end;
  end;
  ObjArrayClear(fIDGenerator);
  inherited;
end;


{ TSQLRestBatch }

constructor TSQLRestBatch.Create(aRest: TSQLRest; aTable: TSQLRecordClass;
  AutomaticTransactionPerRow: cardinal; Options: TSQLRestBatchOptions;
  InternalBufferSize: cardinal);
begin
  if aRest=nil then
    raise EORMException.CreateUTF8('%.Create(aRest=nil)',[self]);
  fRest := aRest;
  if InternalBufferSize<4096 then
    InternalBufferSize := 4096;
  fInternalBufferSize := InternalBufferSize;
  Reset(aTable,AutomaticTransactionPerRow,Options);
end;

procedure TSQLRestBatch.Reset(aTable: TSQLRecordClass;
  AutomaticTransactionPerRow: cardinal; Options: TSQLRestBatchOptions);
begin
  fBatch.Free; // full reset for SetExpandedJSONWriter
  fBatch := TJSONSerializer.CreateOwnedStream(fInternalBufferSize);
  fBatch.Expand := true;
  FillZero(fBatchFields);
  fBatchCount := 0;
  fAddCount := 0;
  fUpdateCount := 0;
  fDeleteCount := 0;
  fDeletedCount := 0;
  fTable := aTable;
  if aTable<>nil then begin
    fTableIndex := fRest.Model.GetTableIndexExisting(aTable);
    fBatch.Add('{'); // sending data is '{"Table":["cmd":values,...]}'
    fBatch.AddFieldName(aTable.SQLTableName);
  end else
    fTableIndex := -1;
  fBatch.Add('[');
  fAutomaticTransactionPerRow := AutomaticTransactionPerRow;
  if AutomaticTransactionPerRow>0 then begin // should be the first command
    fBatch.AddShort('"automaticTransactionPerRow",');
    fBatch.Add(AutomaticTransactionPerRow);
    fBatch.Add(',');
  end;
  fOptions := Options;
  if boExtendedJSON in Options then
    include(fBatch.fCustomOptions,twoForceJSONExtended);
  Options := Options-[boExtendedJSON,boPostNoSimpleFields]; // client-side only
  if byte(Options)<>0 then begin
    fBatch.AddShort('"options",');
    fBatch.Add(byte(Options));
    fBatch.Add(',');
  end;
end;

procedure TSQLRestBatch.Reset;
begin
  if self<>nil then
    Reset(fTable,fAutomaticTransactionPerRow,fOptions);
end;

destructor TSQLRestBatch.Destroy;
begin
  FreeAndNil(fBatch);
  inherited;
end;

function TSQLRestBatch.GetCount: integer;
begin
  if self=nil then
    result := 0 else
    result := fBatchCount;
end;

function TSQLRestBatch.GetSizeBytes: cardinal;
begin
  if self=nil then
    result := 0 else
    result := fBatch.TextLength;
end;

procedure TSQLRestBatch.SetExpandedJSONWriter(Props: TSQLRecordProperties;
  ForceResetFields, withID: boolean; const WrittenFields: TSQLFieldBits);
begin
  if (self=nil) or (fBatch=nil) then
    exit;
  if not ForceResetFields then
    if fBatch.Expand and (fBatch.WithID=withID) and
       IsEqual(fBatchFields,WrittenFields) then
      exit; // already set -> do not compute it again
  fBatchFields := WrittenFields;
  fBatch.ChangeExpandedFields(withID,FieldBitsToIndex(WrittenFields,Props.Fields.Count));
  Props.SetJSONWriterColumnNames(fBatch,0);
end;

function TSQLRestBatch.RawAppend(FullRow: boolean): TTextWriter;
begin
  if FullRow then
    inc(fBatchCount);
  result := fBatch;
end;

function TSQLRestBatch.RawAdd(const SentData: RawUTF8): integer;
begin // '{"Table":[...,"POST",{object},...]}'
  if (fBatch=nil) or (fTable=nil) then
    raise EORMException.CreateUTF8('%.RawAdd %',[self,SentData]);
  fBatch.AddShort('"POST",');
  fBatch.AddString(SentData);
  fBatch.Add(',');
  result := fBatchCount;
  inc(fBatchCount);
  inc(fAddCount);
end;

function  TSQLRestBatch.RawUpdate(const SentData: RawUTF8; ID: TID): integer;
var sentID: TID;
begin // '{"Table":[...,"PUT",{object},...]}'
  if (fBatch=nil) or (fTable=nil) then
    raise EORMException.CreateUTF8('%.RawUpdate % %',[self,ID,SentData]);
  if JSONGetID(pointer(SentData),sentID) and (sentID<>ID) then
    raise EORMException.CreateUTF8('%.RawUpdate ID=% <> %',[self,ID,SentData]);
  fBatch.AddShort('"PUT",{ID:');
  fBatch.Add(ID);
  fBatch.Add(',');
  fBatch.AddStringCopy(SentData,2,maxInt shr 2);
  fBatch.Add(',');
  result := fBatchCount;
  inc(fBatchCount);
  inc(fUpdateCount);
end;

function TSQLRestBatch.Add(Value: TSQLRecord; SendData,ForceID: boolean;
  const CustomFields: TSQLFieldBits; DoNotAutoComputeFields: boolean): integer;
var Props: TSQLRecordProperties;
    FieldBits: TSQLFieldBits;
    PostSimpleFields: boolean;
    f: integer;
begin
  result := -1;
  if (self=nil) or (Value=nil) or (fBatch=nil) then
    exit; // invalid parameters, or not opened BATCH sequence
  if (fTable<>nil) and (PSQLRecordClass(Value)^<>fTable) then
    exit;
  Props := Value.RecordProps;
  if SendData and
     (fRest.Model.Props[PSQLRecordClass(Value)^].Kind in INSERT_WITH_ID) then
      ForceID := true; // same format as TSQLRestClient.Add
  if SendData and not ForceID and IsZero(CustomFields) and
     not(boPostNoSimpleFields in fOptions) then begin
    PostSimpleFields := true;
    fBatch.AddShort('"SIMPLE');
  end else begin
    PostSimpleFields := false;
    fBatch.AddShort('"POST');
  end;
  if fTable<>nil then  // '{"Table":[...,"POST",{object},...]}'
      fBatch.AddShort('",') else begin
      fBatch.Add('@'); // '[...,"POST@Table",{object}',...]'
      fBatch.AddString(Props.SQLTableName);
      fBatch.Add('"',',');
    end;
  if SendData then begin
    if IsZero(CustomFields) then
      FieldBits := Props.SimpleFieldsBits[soInsert] else
    if DoNotAutoComputeFields then
      FieldBits := CustomFields else
      FieldBits := CustomFields+Props.ComputeBeforeAddFieldsBits;
    SetExpandedJSONWriter(Props,fTablePreviousSendData<>PSQLRecordClass(Value)^,
      (Value.IDValue<>0) and ForceID,FieldBits);
    fTablePreviousSendData := PSQLRecordClass(Value)^;
    if not DoNotAutoComputeFields then // update TModTime/TCreateTime fields
      Value.ComputeFieldsBeforeWrite(fRest,seAdd);
    if PostSimpleFields then begin
      fBatch.Add('[');
      for f := 0 to length(Props.SimpleFields)-1 do begin
        Props.SimpleFields[f].GetJSONValues(Value,fBatch);
        fBatch.Add(',');
      end;
      fBatch.CancelLastComma;
      fBatch.Add(']');
    end else
      Value.GetJSONValues(fBatch);
    if fCalledWithinRest and ForceID then
      fRest.fCache.Notify(Value,soInsert);
  end else
    fBatch.Add('{','}'); // '{"Table":[...,"POST",{},...]}'
  fBatch.Add(',');
  result := fBatchCount;
  inc(fBatchCount);
  inc(fAddCount);
  if Assigned(fOnWrite) then
    fOnWrite(self,soInsert,PSQLRecordClass(Value)^,Value.IDValue,Value,FieldBits);
end;

procedure AddID(var Values: TIDDynArray; var ValuesCount: integer; Value: TID);
begin
  if ValuesCount=length(Values) then
    SetLength(Values,NextGrow(ValuesCount));
  Values[ValuesCount] := Value;
  inc(ValuesCount);
end;

procedure AddID(var Values: TIDDynArray; Value: TID);
var n: integer;
begin
  n := length(Values);
  SetLength(Values,n+1);
  Values[n] := Value;
end;

function TSQLRestBatch.Delete(Table: TSQLRecordClass; ID: TID): integer;
begin
  if (self=nil) or (fBatch=nil) or (Table=nil) or
     (ID<=0) or not fRest.RecordCanBeUpdated(Table,ID,seDelete) then begin
    result := -1; // invalid parameters, or not opened BATCH sequence
    exit;
  end;
  AddID(fDeletedRecordRef,fDeletedCount,fRest.Model.RecordReference(Table,ID));
  fBatch.AddShort('"DELETE@'); // '[...,"DELETE@Table",ID,...]}'
  fBatch.AddString(Table.RecordProps.SQLTableName);
  fBatch.Add('"',',');
  fBatch.Add(ID);
  fBatch.Add(',');
  result := fBatchCount;
  inc(fBatchCount);
  inc(fDeleteCount);
  if Assigned(fOnWrite) then
    fOnWrite(self,soDelete,Table,ID,nil,[]);
end;

function TSQLRestBatch.Delete(ID: TID): integer;
begin
  if (self=nil) or (fTable=nil) or
     (ID<=0) or not fRest.RecordCanBeUpdated(fTable,ID,seDelete) then begin
    result := -1; // invalid parameters, or not opened BATCH sequence
    exit;
  end;
  AddID(fDeletedRecordRef,fDeletedCount,RecordReference(fTableIndex,ID));
  fBatch.AddShort('"DELETE",'); // '{"Table":[...,"DELETE",ID,...]}'
  fBatch.Add(ID);
  fBatch.Add(',');
  result := fBatchCount;
  inc(fBatchCount);
  inc(fDeleteCount);
  if Assigned(fOnWrite) then
    fOnWrite(self,soDelete,fTable,ID,nil,[]);
end;

function TSQLRestBatch.PrepareForSending(out Data: RawUTF8): boolean;
var i: integer;
begin
  if (self=nil) or (fBatch=nil) then // no opened BATCH sequence
    result := false else begin
    if fBatchCount>0 then begin // if something to send
      for i := 0 to fDeletedCount-1 do
        if fDeletedRecordRef[i]<>0 then
          fRest.Cache.NotifyDeletion(fDeletedRecordRef[i] and 63,fDeletedRecordRef[i] shr 6);
      fBatch.CancelLastComma;
      fBatch.Add(']');
      if fTable<>nil then
        fBatch.Add('}'); // end sequence array '{"Table":["cmd":values,...]}'
      fBatch.SetText(Data);
    end;
    result := true;
  end;
end;

function TSQLRestBatch.Update(Value: TSQLRecord;
  const CustomFields: TSQLFieldBits; DoNotAutoComputeFields,ForceCacheUpdate: boolean): integer;
var Props: TSQLRecordProperties;
    FieldBits: TSQLFieldBits;
    ID: TID;
    tableIndex: integer;
begin
  result := -1;
  if (Value=nil) or (fBatch=nil) then
    exit;
  ID := Value.IDValue;
  if (ID<=0) or not fRest.RecordCanBeUpdated(Value.RecordClass,ID,seUpdate) then
    exit; // invalid parameters, or not opened BATCH sequence
  Props := Value.RecordProps;
  if fTable<>nil then
    if PSQLRecordClass(Value)^<>fTable then
      exit else begin // '{"Table":[...,"PUT",{object},...]}'
      tableIndex := fTableIndex;
      fBatch.AddShort('"PUT",');
    end else begin
      tableIndex := fRest.Model.GetTableIndexExisting(Props.Table);
      fBatch.AddShort('"PUT@'); // '[...,"PUT@Table",{object}',...]'
      fBatch.AddString(Props.SQLTableName);
      fBatch.Add('"',',');
    end;
  // same format as TSQLRest.Update, BUT including the ID
  if IsZero(CustomFields) then
    Value.FillContext.ComputeSetUpdatedFieldBits(Props,FieldBits) else
    if DoNotAutoComputeFields then
      FieldBits := CustomFields*Props.CopiableFieldsBits else
      FieldBits := CustomFields*Props.CopiableFieldsBits+Props.FieldBits[sftModTime];
  SetExpandedJSONWriter(Props,fTablePreviousSendData<>PSQLRecordClass(Value)^,
    {withID=}true,FieldBits);
  fTablePreviousSendData := PSQLRecordClass(Value)^;
  if not DoNotAutoComputeFields then
    Value.ComputeFieldsBeforeWrite(fRest,seUpdate); // update sftModTime fields
  Value.GetJSONValues(fBatch);
  fBatch.Add(',');
  if fCalledWithinRest and (FieldBits-Props.SimpleFieldsBits[soUpdate]=[]) then
    ForceCacheUpdate := true; // safe to update the cache with supplied values
  if ForceCacheUpdate then
    fRest.Cache.Notify(Value,soUpdate) else
    // may not contain all cached fields -> delete from cache
    AddID(fDeletedRecordRef,fDeletedCount,RecordReference(tableIndex,ID));
  result := fBatchCount;
  inc(fBatchCount);
  inc(fUpdateCount);
  if Assigned(fOnWrite) then
    fOnWrite(self,soUpdate,PSQLRecordClass(Value)^,Value.IDValue,Value,FieldBits);
end;

function TSQLRestBatch.Update(Value: TSQLRecord; const CustomCSVFields: RawUTF8;
  DoNotAutoComputeFields,ForceCacheUpdate: boolean): integer;
begin
  if (Value=nil) or (fBatch=nil) then
    result := -1 else
    result := Update(Value,Value.RecordProps.FieldBitsFromCSV(CustomCSVFields),
      DoNotAutoComputeFields,ForceCacheUpdate);
end;


{ TSQLRestBatchLocked }

constructor TSQLRestBatchLocked.Create(aRest: TSQLRest; aTable: TSQLRecordClass;
  AutomaticTransactionPerRow: cardinal; Options: TSQLRestBatchOptions;
  InternalBufferSize: cardinal);
begin
  inherited;
  fSafe.Init;
end;

destructor TSQLRestBatchLocked.Destroy;
begin
  fSafe.Done;
  inherited;
end;

procedure TSQLRestBatchLocked.Reset(aTable: TSQLRecordClass;
  AutomaticTransactionPerRow: cardinal; Options: TSQLRestBatchOptions);
begin
  inherited;
  fTix := GetTickCount64;
end;


{ TSQLRest }

constructor TSQLRest.Create(aModel: TSQLModel);
var cmd: TSQLRestServerURIContextCommand;
begin
  inherited Create;
  fPrivateGarbageCollector := TSynObjectList.Create;
  fModel := aModel;
  for cmd := Low(cmd) to high(cmd) do
    fAcquireExecution[cmd] := TSQLRestAcquireExecution.Create;
  AcquireWriteMode := amLocked;
  AcquireWriteTimeOut := 5000; // default 5 seconds
  fRoutingClass := TSQLRestRoutingREST;
  {$ifdef WITHLOG}
  SetLogClass(SQLite3Log); // by default
  {$endif}
end;

destructor TSQLRest.Destroy;
var cmd: TSQLRestServerURIContextCommand;
    i: integer;
begin
  InternalLog('TSQLRest.Destroy %',[fModel.SafeRoot],sllInfo); // self->GPF
  AsynchBatchStop(nil);
  FreeAndNil(fBackgroundTimer);
  FreeAndNil(fServices);
  FreeAndNil(fCache);
  FreeAndNil(fCustomEncryptAES);
  if (fModel<>nil) and (fModel.fRestOwner=self) then
    // make sure we are the Owner (TSQLRestStorage has fModel<>nil e.g.)
    FreeAndNil(fModel);
  for cmd := Low(cmd) to high(cmd) do
    FreeAndNil(fAcquireExecution[cmd]); // should be done BEFORE private GC
  if fPrivateGarbageCollector<>nil then begin
    for i := fPrivateGarbageCollector.Count-1 downto 0 do // last in, first out
    try
      fPrivateGarbageCollector.Delete(i); // will call fPrivate...[i].Free
    except
      on Exception do
        ; // just ignore exceptions in such destructors
    end;
    fPrivateGarbageCollector.Free;
  end;
  inherited Destroy;
end;

var
  GlobalDefinitions: array of TSQLRestClass;

class procedure TSQLRest.RegisterClassNameForDefinition;
begin
  ObjArrayAddOnce(GlobalDefinitions,TObject(self)); // TClass stored as TObject
end;

procedure TSQLRest.DefinitionTo(Definition: TSynConnectionDefinition);
begin
  if Definition<>nil then
    Definition.Kind := ClassName;
end;

function TSQLRest.DefinitionToJSON(Key: cardinal=0): RawUTF8;
var Definition: TSynConnectionDefinition;
begin
  Definition := TSynConnectionDefinition.Create;
  try
    Definition.Key := Key;
    DefinitionTo(Definition);
    result := Definition.SaveToJSON;
  finally
    Definition.Free;
  end;
end;

procedure TSQLRest.DefinitionToFile(const aJSONFile: TFileName; aKey: cardinal);
begin
  FileFromString(JSONReformat(DefinitionToJSON(aKey)),aJSONFile);
end;

class function TSQLRest.ClassFrom(aDefinition: TSynConnectionDefinition): TSQLRestClass;
var ndx: integer;
begin
  for ndx := 0 to length(GlobalDefinitions)-1 do
    if GlobalDefinitions[ndx].ClassNameIs(aDefinition.Kind) then begin
      result := GlobalDefinitions[ndx];
      exit;
    end;
  result := nil;
end;

constructor TSQLRest.RegisteredClassCreateFrom(aModel: TSQLModel;
  aDefinition: TSynConnectionDefinition);
begin
  Create(aModel);
end;

class function TSQLRest.CreateFrom(aModel: TSQLModel;
  aDefinition: TSynConnectionDefinition): TSQLRest;
var C: TSQLRestClass;
begin
  C := ClassFrom(aDefinition);
  if C=nil then
    raise EORMException.CreateUTF8('%.CreateFrom: unknown % class - please '+
      'add a reference to its implementation unit',[self,aDefinition.Kind]);
  result := C.RegisteredClassCreateFrom(aModel,aDefinition);
end;

class function TSQLRest.CreateTryFrom(aModel: TSQLModel;
  aDefinition: TSynConnectionDefinition; aServerHandleAuthentication: boolean): TSQLRest;
var C: TSQLRestClass;
begin
  C := ClassFrom(aDefinition);
  if C=nil then
    result := nil else
    if C.InheritsFrom(TSQLRestServer) then
      result := TSQLRestServerClass(C).RegisteredClassCreateFrom(
        aModel,aServerHandleAuthentication,aDefinition) else
      result := C.RegisteredClassCreateFrom(aModel,aDefinition);
end;

class function TSQLRest.CreateFromJSON(aModel: TSQLModel;
  const aJSONDefinition: RawUTF8; aKey: cardinal): TSQLRest;
var Definition: TSynConnectionDefinition;
begin
  Definition := TSynConnectionDefinition.CreateFromJSON(aJSONDefinition,aKey);
  try
    result := CreateFrom(aModel,Definition);
  finally
    Definition.Free;
  end;
end;

class function TSQLRest.CreateFromFile(aModel: TSQLModel;
  const aJSONFile: TFileName; aKey: cardinal): TSQLRest;
begin
  result := CreateFromJSON(aModel,AnyTextFileToRawUTF8(aJSONFile,true),aKey);
end;

procedure TSQLRest.InternalLog(const Text: RawUTF8; Level: TSynLogInfo);
begin
  {$ifdef WITHLOG}
  if (self<>nil) and (fLogFamily<>nil) and (Level in fLogFamily.Level) then
    fLogFamily.SynLog.Log(Level,Text,self);
  {$endif}
end;

procedure TSQLRest.InternalLog(const Format: RawUTF8;
  const Args: array of const; Level: TSynLogInfo);
begin
  {$ifdef WITHLOG}
  if (self<>nil) and (fLogFamily<>nil) and (Level in fLogFamily.Level) then
    fLogFamily.SynLog.Log(Level,Format,Args,self);
  {$endif}
end;

{$ifdef WITHLOG}
procedure TSQLRest.SetLogClass(aClass: TSynLogClass);
begin
  fLogClass := aClass;
  fLogFamily := fLogClass.Family;
end;

function TSQLRest.GetLogClass: TSynLogClass;
begin
  if self=nil then
    result := SQLite3Log else
    result := fLogClass;
end;
{$endif WITHLOG}

function TSQLRest.NewBackgroundThreadMethod(const Format: RawUTF8;
   const Args: array of const): TSynBackgroundThreadMethod;
begin
  result := TSynBackgroundThreadMethod.Create(nil,FormatUTF8(Format,Args),
    BeginCurrentThread,EndCurrentThread);
end;

function TSQLRest.NewParallelProcess(ThreadCount: integer; const Format: RawUTF8;
  const Args: array of const): TSynParallelProcess;
begin
  result := TSynParallelProcess.Create(ThreadCount,FormatUTF8(Format,Args),
    BeginCurrentThread,EndCurrentThread);
end;

function TSQLRest.NewBackgroundThreadProcess(
  aOnProcess: TOnSynBackgroundThreadProcess; aOnProcessMS: cardinal;
  const Format: RawUTF8; const Args: array of const;
  aStats: TSynMonitorClass): TSynBackgroundThreadProcess;
var name: RawUTF8;
begin
  FormatUTF8(Format,Args,name);
  if self=nil then
    result := TSynBackgroundThreadProcess.Create(name,aOnProcess,aOnProcessMS,
     nil,nil,aStats) else
    result := TSynBackgroundThreadProcess.Create(name,aOnProcess,aOnProcessMS,
      BeginCurrentThread,EndCurrentThread,aStats);
end;

function TSQLRest.EnsureBackgroundTimerExists: TSQLRestBackgroundTimer;
begin
  if fBackgroundTimer=nil then
    fBackgroundTimer := TSQLRestBackgroundTimer.Create(self);
  result := fBackgroundTimer;
end;

function TSQLRest.TimerEnable(aOnProcess: TOnSynBackgroundTimerProcess;
  aOnProcessSecs: cardinal): TSynBackgroundTimer;
begin
  result := nil;
  if self=nil then
    exit;
  if aOnProcessSecs=0 then begin
    TimerDisable(aOnProcess);
    exit;
  end;
  result := EnsureBackgroundTimerExists;
  result.Enable(aOnProcess,aOnProcessSecs);
end;

function TSQLRest.TimerDisable(aOnProcess: TOnSynBackgroundTimerProcess): boolean;
begin
  if (self=nil) or (fBackgroundTimer=nil) then
    result := false else
    result := fBackgroundTimer.Disable(aOnProcess);
end;

function TSQLRest.AsynchBatchStart(Table: TSQLRecordClass;
  SendSeconds, PendingRowThreshold, AutomaticTransactionPerRow: integer;
  Options: TSQLRestBatchOptions): boolean;
begin
  if self=nil then
    result := false else
    result := EnsureBackgroundTimerExists.AsynchBatchStart(
      Table,SendSeconds,PendingRowThreshold,AutomaticTransactionPerRow,Options);
end;

function TSQLRest.AsynchBatchStop(Table: TSQLRecordClass): boolean;
begin
  if (self=nil) or (fBackgroundTimer=nil) or (fBackgroundTimer.fBackgroundBatch=nil) then
    result := false else
    result := fBackgroundTimer.AsynchBatchStop(Table);
end;

function TSQLRest.AsynchBatchAdd(Value: TSQLRecord; SendData,ForceID: boolean;
  const CustomFields: TSQLFieldBits; DoNotAutoComputeFields: boolean): integer;
begin
  if (self=nil) or (fBackgroundTimer=nil) or (fBackgroundTimer.fBackgroundBatch=nil) then
    result := -1 else
    result := fBackgroundTimer.AsynchBatchAdd(
      Value,SendData,ForceID,CustomFields,DoNotAutoComputeFields);
end;

function TSQLRest.AsynchBatchRawAdd(Table: TSQLRecordClass; const SentData: RawUTF8): integer;
begin
  if (self=nil) or (fBackgroundTimer=nil) or (fBackgroundTimer.fBackgroundBatch=nil) then
    result := -1 else
    result := fBackgroundTimer.AsynchBatchRawAdd(Table,SentData);
end;

procedure TSQLRest.AsynchBatchRawAppend(Table: TSQLRecordClass; SentData: TTextWriter);
begin
  if (self<>nil) and (fBackgroundTimer<>nil) and (fBackgroundTimer.fBackgroundBatch<>nil) then
    fBackgroundTimer.AsynchBatchRawAppend(Table,SentData);
end;

function TSQLRest.AsynchBatchUpdate(Value: TSQLRecord;
  const CustomFields: TSQLFieldBits; DoNotAutoComputeFields: boolean): integer;
begin
  if (self=nil) or (fBackgroundTimer=nil) or (fBackgroundTimer.fBackgroundBatch=nil) then
    result := -1 else
    result := fBackgroundTimer.AsynchBatchUpdate(Value,CustomFields,DoNotAutoComputeFields);
end;

function TSQLRest.AsynchBatchDelete(Table: TSQLRecordClass; ID: TID): integer;
begin
  if (self=nil) or (fBackgroundTimer=nil) or (fBackgroundTimer.fBackgroundBatch=nil) then
    result := -1 else
    result := fBackgroundTimer.AsynchBatchDelete(Table,ID);
end;

procedure TSQLRest.AsynchRedirect(const aGUID: TGUID;
  const aDestinationInterface: IInvokable; out aCallbackInterface;
  const aOnResult: TOnAsynchRedirectResult);
begin
  if self<>nil then
    EnsureBackgroundTimerExists.AsynchRedirect(
      aGUID,aDestinationInterface,aCallbackInterface,aOnResult);
end;

procedure TSQLRest.AsynchRedirect(const aGUID: TGUID;
  const aDestinationInstance: TInterfacedObject; out aCallbackInterface;
  const aOnResult: TOnAsynchRedirectResult);
begin
  if self<>nil then
    EnsureBackgroundTimerExists.AsynchRedirect(
      aGUID,aDestinationInstance,aCallbackInterface,aOnResult);
end;

procedure TSQLRest.AsynchInterning(Interning: TRawUTF8Interning;
  InterningMaxRefCount, PeriodMinutes: integer);
begin
  if self<>nil then
    EnsureBackgroundTimerExists.AsynchInterning(
      Interning,InterningMaxRefCount,PeriodMinutes);
end;

function TSQLRest.SystemUseTrack(periodSec: integer): TSystemUse;
begin
  result := nil;
  if self=nil then
    exit;
  result := TSystemUse.Current;
  if (result.Timer=nil) or
     ((BackgroundTimer<>nil) and (result.Timer=BackgroundTimer)) then begin
    if periodSec>0 then
      result.Timer := EnsureBackgroundTimerExists;
    TimerEnable(result.BackgroundExecute,periodSec); // disable if periodSec=0
  end;
end;

procedure DoSign(const signer: TSynSigner; const url,body: RawUTF8; bodylen: integer;
  out hash: THash512Rec);
var L: integer;
    P: PAnsiChar;
    sign: TSynSigner;
begin
  sign := signer; // thread-safe copy
  P := pointer(url);
  L := length(url);
  if P^='/' then begin
    inc(P);
    dec(L);
  end;
  sign.Update(P,L);
  sign.Update(pointer(body),bodylen);
  sign.Final(hash);
end;

procedure TSQLRest.InternalCustomDecrypt(Sender: TSQLRest; var Body,Head,Url: RawUTF8);
var ct: RawUTF8;
    L: integer;
    hash: THash512Rec;
begin
  if (fCustomEncryptContentPrefix='') or (Body='') or (Sender<>self) or
     (Url='') or IdemPChar(pointer(Url),pointer(fCustomEncryptUrlIgnore)) then
    exit;
  FindNameValue(Head,HEADER_CONTENT_TYPE_UPPER,ct);
  if IdemPChar(pointer(ct),pointer(fCustomEncryptContentPrefixUpper)) then begin
    if fCustomEncryptAES<>nil then begin
      // decrypt using PKCS7 + initial random/unique IV at the beginning
      Body := fCustomEncryptAES.DecryptPKCS7(Body,true,false);
      if Body='' then begin
        InternalLog('CustomEncrypt %.DecryptPKCS7 reject',[fCustomEncryptAES.ClassType],sllUserAuth);
        exit;
      end;
    end;
    if fCustomEncryptCompress<>nil then begin
      // optionally uncompresss Body+signature
      Body := fCustomEncryptCompress.Decompress(Body);
      if Body='' then begin
        InternalLog('CustomEncrypt %.Decompress reject %',[fCustomEncryptCompress.ClassType]);
        exit;
      end;
    end;
    L := length(Body)-fCustomEncryptSign.SignatureSize;
    if (L>0) and (fCustomEncryptSign.SignatureSize<>0) then begin
      // validate the binary signature of supplied Url+Body at the Body end
      DoSign(fCustomEncryptSign,Url,Body,L,hash);
      if not CompareMemFixed(@hash,@PByteArray(Body)[L],fCustomEncryptSign.SignatureSize) then begin
        Body := '';
        InternalLog('CustomEncrypt % reject',[ToText(fCustomEncryptSign.Algo)^],sllUserAuth);
        exit;
      end;
      SetLength(Body,L);
    end;
    system.delete(ct,1,length(fCustomEncryptContentPrefix));
    UpdateIniNameValue(Head,'',HEADER_CONTENT_TYPE_UPPER,ct);
  end else begin
    Body := '';
    InternalLog('CustomEncrypt no % -> reject',[fCustomEncryptContentPrefix]);
  end;
end;

procedure TSQLRest.InternalCustomEncrypt(Sender: TSQLRest; var Body,Head,Url: RawUTF8);
var ct: RawUTF8;
    L: integer;
    hash: THash512Rec;
begin
  if (fCustomEncryptContentPrefix='') or (Body='') or (Sender<>self) or
     (Url='') or IdemPChar(pointer(Url),pointer(fCustomEncryptUrlIgnore)) then
    exit;
  if fCustomEncryptSign.SignatureSize<>0 then begin
    // append the binary signature of supplied Url+Body to the Body
    L := length(Body);
    DoSign(fCustomEncryptSign,Url,Body,L,hash);
    SetLength(Body,L+fCustomEncryptSign.SignatureSize);
    MoveSmall(@hash,@PByteArray(Body)[L],fCustomEncryptSign.SignatureSize);
  end;
  if fCustomEncryptCompress<>nil then
    // optionally compresss Body+signature
    Body := fCustomEncryptCompress.Compress(Body);
  if fCustomEncryptAES<>nil then
    // encrypt using PKCS7 + initial random/unique IV at the beginning
    Body := fCustomEncryptAES.EncryptPKCS7(Body,true);
  FindNameValue(Head,HEADER_CONTENT_TYPE_UPPER,ct);
  if ct='' then // not specified -> append 'application/json'
    ct := JSON_CONTENT_TYPE_VAR;
  UpdateIniNameValue(Head,HEADER_CONTENT_TYPE,HEADER_CONTENT_TYPE_UPPER,
    fCustomEncryptContentPrefix+ct)
end;

procedure TSQLRest.SetCustomEncryption(aes: TAESAbstract; sign: PSynSigner;
  comp: TAlgoCompress; const uriignore: RawUTF8);
var tmp: PShortString; // temp variable to circumvent FPC bug
    s: RawUTF8;
begin
  fCustomEncryptContentPrefix := ''; // disable encryption
  fCustomEncryptCompress := nil;
  fCustomEncryptUrlIgnore := '';
  FreeAndNil(fCustomEncryptAES);
  fOnDecryptBody := nil;
  fOnEncryptBody := nil;
  fCustomEncryptAES := aes;
  if aes=nil then
    if sign=nil then
      exit else
      fCustomEncryptContentPrefix := '0' else begin
    tmp := ClassNameShort(aes); // TAESECB_API -> 'AESECB'
    FastSetString(s,@tmp^[2],6);
    fCustomEncryptContentPrefix := s+UInt32ToUtf8(aes.KeySize);
  end;
  if (sign=nil) or (sign^.SignatureSize=0) then begin
    FillCharFast(fCustomEncryptSign,SizeOf(fCustomEncryptSign),0);
    fCustomEncryptContentPrefix := fCustomEncryptContentPrefix+'0/';
  end else begin
    fCustomEncryptSign := sign^;
    tmp := ToText(sign^.Algo); // saSha3384 -> 'sha3384'
    FastSetString(s,@tmp^[3],ord(tmp^[0])-2);
    fCustomEncryptContentPrefix := fCustomEncryptContentPrefix+s+'/';
  end;
  fCustomEncryptContentPrefix := LowerCase(fCustomEncryptContentPrefix);
  fCustomEncryptContentPrefixUpper := UpperCase(fCustomEncryptContentPrefix);
  fCustomEncryptCompress := comp;
  fCustomEncryptUrlIgnore := UpperCase(uriignore);
  fOnDecryptBody := InternalCustomDecrypt;
  fOnEncryptBody := InternalCustomEncrypt;
end;

procedure TSQLRest.AdministrationExecute(const DatabaseName,SQL: RawUTF8;
  var result: TServiceCustomAnswer);
begin
  if (SQL<>'') and (SQL[1]='#') then begin
    // pseudo SQL for a given TSQLRest[Server] instance
    case IdemPCharArray(@SQL[2],['TIME','MODEL','REST','HELP']) of
    0: result.Content := Int64ToUtf8(ServerTimestamp);
    1: result.Content := ObjectToJSON(Model);
    2: result.Content := ObjectToJSON(self);
    3: begin
      result.Content[length(result.Content)] := '|';
      result.Content := result.Content+'#time|#model|#rest"';
    end;
    end;
  end else
  if isSelect(pointer(SQL)) then
    result.Content := ExecuteJson(Model.GetTablesFromSQLSelect(SQL),SQL) else
    Execute(SQL);
end;

function TSQLRest.EngineUpdateFieldIncrement(TableModelIndex: integer;
  ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean;
var Value: Int64;
    Table: TSQLRecordClass;
begin
  if (TableModelIndex<0) or (ID<0) then
    result := false else begin
    Table := Model.Tables[TableModelIndex];
    result := OneFieldValue(Table,FieldName,'ID=?',[],[ID],Value) and
              UpdateField(Table,ID,FieldName,[Value+Increment]);
  end;
end;

procedure TSQLRest.SetRoutingClass(aServicesRouting: TSQLRestServerURIContextClass);
begin
  if self<>nil then
    if aServicesRouting<>fRoutingClass then
      if (aServicesRouting=nil) or (aServicesRouting=TSQLRestServerURIContext) then
         raise EServiceException.CreateUTF8('Unexpected %.SetRoutingClass(%)',
           [self,aServicesRouting]) else
         fRoutingClass := aServicesRouting;
end;

function TSQLRest.MultiFieldValue(Table: TSQLRecordClass;
  const FieldName: array of RawUTF8; var FieldValue: array of RawUTF8;
  WhereID: TID): boolean;
begin
  result := MultiFieldValue(Table,FieldName,FieldValue,
    'RowID=:('+Int64ToUtf8(WhereID)+'):');
end;

function TSQLRest.OneFieldValue(Table: TSQLRecordClass; const FieldName,
  WhereClause: RawUTF8): RawUTF8;
var Res: array[0..0] of RawUTF8;
begin
  if MultiFieldValue(Table,[FieldName],Res,WhereClause) then
    result := Res[0] else
    result := '';
end;

function TSQLRest.OneFieldValueInt64(Table: TSQLRecordClass; const FieldName,
  WhereClause: RawUTF8; Default: Int64): Int64;
var Res: array[0..0] of RawUTF8;
begin
  if not MultiFieldValue(Table,[FieldName],Res,WhereClause) or
     not ToInt64(Res[0],result) then
    result := Default;
end;

function TSQLRest.OneFieldValue(Table: TSQLRecordClass; const FieldName: RawUTF8;
  const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const): RawUTF8;
begin
  result := OneFieldValue(Table,FieldName,FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere));
end;

function TSQLRest.OneFieldValue(Table: TSQLRecordClass;
  const FieldName: RawUTF8; const WhereClauseFmt: RawUTF8;
  const Args, Bounds: array of const): RawUTF8;
begin
  result := OneFieldValue(Table,FieldName,FormatUTF8(WhereClauseFmt,Args,Bounds));
end;

function TSQLRest.OneFieldValue(Table: TSQLRecordClass;
  const FieldName: RawUTF8; WhereID: TID): RawUTF8;
var Res: array[0..0] of RawUTF8;
begin
  if (WhereID>0) and
     MultiFieldValue(Table,[FieldName],Res,'RowID=:('+Int64ToUtf8(WhereID)+'):') then
    result := Res[0] else
    result := '';
end;

function TSQLRest.MemberExists(Table: TSQLRecordClass; ID: TID): boolean;
begin
  if fCache.Retrieve(Model.GetTableIndexExisting(Table),ID)<>'' then
    result := true else
    result := OneFieldValue(Table,'RowID',ID)<>''; // try from DB
end;

function TSQLRest.OneFieldValue(Table: TSQLRecordClass; const FieldName: RawUTF8;
  const WhereClauseFmt: RawUTF8; const Args, Bounds: array of const;
  out Data: Int64): boolean;
var Res: array[0..0] of RawUTF8;
    err: integer;
    where: RawUTF8;
begin
  result := false;
  where := FormatUTF8(WhereClauseFmt,Args,Bounds);
  if MultiFieldValue(Table,[FieldName],Res,where) then
    if Res[0]<>'' then begin
      Data := GetInt64(pointer(Res[0]),err);
      if err=0 then
        result := true;
    end;
end;

function TSQLRest.OneFieldValues(Table: TSQLRecordClass; const FieldName,
  WhereClause: RawUTF8; out Data: TRawUTF8DynArray): boolean;
var T: TSQLTableJSON;
begin
  result := false;
  T := MultiFieldValues(Table,FieldName,WhereClause);
  if T<>nil then
    try
      result := T.GetRowValues(0,Data)>0;
    finally
      T.Free;
    end;
end;

function TSQLRest.OneFieldValues(Table: TSQLRecordClass; const FieldName,
  WhereClause: RawUTF8; Strings: TStrings; IDToIndex: PID=nil): Boolean;
var Row: integer;
    aID: TID;
    T: TSQLTableJSON;
begin
  result := false;
  if (Strings<>nil) and (self<>nil) and (Table<>nil) then
  try
    {$ifndef LVCL}
    Strings.BeginUpdate;
    {$endif}
    Strings.Clear;
    T := ExecuteList([Table],
      SQLFromSelect(Table.SQLTableName,'ID,'+FieldName,WhereClause,''));
    if T<>nil then
    try
      if (T.FieldCount=2) and (T.fRowCount>0) then begin
        for Row := 1 to T.fRowCount do begin // ignore Row 0 i.e. field names
          aID := GetInt64(T.Get(Row,0));
          Strings.AddObject(T.GetString(Row,1),pointer(PtrInt(aID)));
          if (IDToIndex<>nil) and (aID=IDToIndex^) then begin
            IDToIndex^ := Row-1;
            IDToIndex := nil; // set once
          end;
        end;
        result := true;
      end;
    finally
      T.Free;
    end;
  finally
    {$ifndef LVCL}
    Strings.EndUpdate;
    {$endif}
  end;
  if IDToIndex<>nil then
    IDToIndex^ := -1; // ID not found
end;

function TSQLRest.OneFieldValues(Table: TSQLRecordClass; const FieldName,
  WhereClause, Separator: RawUTF8): RawUTF8;
var i, Len, SepLen, L: integer;
    Lens: TIntegerDynArray;
    T: TSQLTableJSON;
    P: PUTF8Char;
begin
  result := '';
  T := MultiFieldValues(Table,FieldName,WhereClause);
  if T<>nil then
  try
    if (T.FieldCount<>1) or (T.fRowCount<=0) then
      exit;
    // calculate row values CSV needed memory
    SetLength(Lens,T.fRowCount);
    SepLen := length(Separator);
    Len := 0;
    for i := 1 to T.fRowCount do begin
      L := StrLen(T.fResults[i]); // ignore fResults[0] i.e. field name
      inc(Len,L+SepLen);
      Lens[i-1] := L;
    end;
    dec(Len,SepLen);
    SetLength(result,Len);
    // add row values as CSV
    P := pointer(result);
    i := 1;
    repeat
      L := Lens[i-1];
      if L<>0 then begin
        MoveFast(T.fResults[i]^,P^,L);
        inc(P,L);
      end;
      if i=T.fRowCount then
        break;
      MoveFast(pointer(Separator)^,P^,SepLen);
      inc(P,SepLen);
      inc(i);
    until false;
    //assert(P-pointer(result)=Len);
  finally
    T.Free;
  end;
end;

function TSQLRest.OneFieldValues(Table: TSQLRecordClass; const FieldName,
  WhereClause: RawUTF8; var Data: TInt64DynArray; SQL: PRawUTF8=nil): boolean;
var T: TSQLTableJSON;
    V: Int64;
    Prop: RawUTF8;
    P: PUTF8Char;
begin
  Data := nil;
  // handle naive expressions like SELECT ID from Table where ID=10
  if IsRowID(pointer(FieldName)) and (length(WhereClause)>2) then begin
    P := pointer(WhereClause);
    GetNextFieldProp(P,Prop);
    if IsRowIDShort(Prop) and (StrPosI('AND',P)=nil) and (StrPosI('OR',P)=nil) then
      case P^ of
      '=': begin // SELECT RowID from Table where RowID=10
        P := GotoNextNotSpace(P+1);
        if PWord(P)^=ord(':')+ord('(')shl 8 then
          inc(P,2); // handle inlined parameters
        SetInt64(P,V);
        if V>0 then begin
          SetLength(Data,1);
          Data[0] := V;
          result := true;
          exit;
        end;
      end;
      'i','I': if P[1] in ['n','N'] then begin
        P := GotoNextNotSpace(P+2);
        if (P^='(') and (GotoNextNotSpace(P+1)^ in ['0'..'9']) then begin
          CSVToInt64DynArray(P+1,Data);
          if Data<>nil then begin
            result := true;
            exit;
          end;
        end;
      end;
      end;
  end;
  // retrieve the content from database
  result := false;
  T := MultiFieldValues(Table,FieldName,WhereClause);
  if T<>nil then
  try
    if (T.FieldCount<>1) or (T.fRowCount<=0) then
      exit;
    T.GetRowValues(0,Data);
    if SQL<>nil then
      SQL^ := T.QuerySQL;
    result := true;
  finally
    T.Free;
  end;
end;

function TSQLRest.SQLComputeForSelect(Table: TSQLRecordClass;
  const FieldNames, WhereClause: RawUTF8): RawUTF8;
begin
  result := '';
  if (self=nil) or (Table=nil) then
    exit;
  if FieldNames='' then
    result := Model.Props[Table].SQLFromSelectWhere('*',WhereClause) else
    with Table.RecordProps do
    if FieldNames='*' then
      result := SQLFromSelect(SQLTableName,SQLTableRetrieveAllFields,WhereClause,'') else
    if (PosExChar(',',FieldNames)=0) and (PosExChar('(',FieldNames)=0) and
       not IsFieldName(FieldNames) then
      result := '' else // prevent SQL error
      result := SQLFromSelect(SQLTableName,FieldNames,WhereClause,'');
end;

function TSQLRest.MultiFieldValues(Table: TSQLRecordClass;
  const FieldNames, WhereClause: RawUTF8): TSQLTableJSON;
var sql: RawUTF8;
begin
  sql := SQLComputeForSelect(Table,FieldNames,WhereClause);
  if sql='' then
    result := nil else
    result := ExecuteList([Table],sql);
end;

function TSQLRest.MultiFieldValues(Table: TSQLRecordClass; const FieldNames: RawUTF8;
  const WhereClauseFormat: RawUTF8; const BoundsSQLWhere: array of const): TSQLTableJSON;
var where: RawUTF8;
begin
  where := FormatUTF8(WhereClauseFormat,[],BoundsSQLWhere);
  result := MultiFieldValues(Table,FieldNames,where);
end;

function TSQLRest.MultiFieldValues(Table: TSQLRecordClass;
  const FieldNames: RawUTF8; const WhereClauseFormat: RawUTF8;
  const Args, Bounds: array of const): TSQLTableJSON;
var where: RawUTF8;
begin
  where := FormatUTF8(WhereClauseFormat,Args,Bounds);
  result := MultiFieldValues(Table,FieldNames,where);
end;

function TSQLRest.MultiFieldValue(Table: TSQLRecordClass;
  const FieldName: array of RawUTF8; var FieldValue: array of RawUTF8;
  const WhereClause: RawUTF8): boolean;
var SQL: RawUTF8;
    n,i: integer;
    T: TSQLTableJSON;
    P: PUTF8Char;
begin
  result := false;
  n := length(FieldName);
  if (self<>nil) and (Table<>nil) and (n=length(FieldValue)) then
  with Table.RecordProps do begin
    if (n=1) and IdemPChar(pointer(FieldName[0]),'COUNT(*)') then
      SQL := 'SELECT COUNT(*) FROM '+SQLTableName+SQLFromWhere(WhereClause) else begin
      for i := 0 to high(FieldName) do
        if not IsFieldNameOrFunction(FieldName[i]) then
          exit else // prevent SQL error or security breach
          if SQL='' then
            SQL := 'SELECT '+FieldName[i] else
            SQL := SQL+','+FieldName[i];
      SQL := SQL+' FROM '+SQLTableName+SQLFromWhere(WhereClause)+' LIMIT 1';
    end;
    T := ExecuteList([Table],SQL);
    if T<>nil then
    try
      if (T.FieldCount<>length(FieldName)) or (T.fRowCount<=0) then
        exit;
      // get field values from the first (and unique) row
      for i := 0 to T.FieldCount-1 do begin
        P := T.fResults[T.FieldCount+i];
        FastSetString(FieldValue[i],P,StrLen(P));
      end;
      result := true;
    finally
      T.Free;
    end;
  end;
end;

function TSQLRest.Retrieve(const SQLWhere: RawUTF8; Value: TSQLRecord;
  const aCustomFieldsCSV: RawUTF8): boolean;
var T: TSQLTable;
begin
  result := false;
  if (self=nil) or (Value=nil) then
    exit;
  T := MultiFieldValues(PSQLRecordClass(Value)^,aCustomFieldsCSV,SQLWhere);
  if T<>nil then
    try
      if T.fRowCount>=1 then begin
        Value.FillFrom(T,1); // fetch data from first result row
        result := true;
      end else
        Value.fID := 0;
    finally
      T.Free;
    end;
end;

function TSQLRest.RetrieveList(Table: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
  const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8): TObjectList;
var T: TSQLTable;
begin
  result := nil;
  if (self=nil) or (Table=nil) then
    exit;
  T := MultiFieldValues(Table,aCustomFieldsCSV,FormatSQLWhere,BoundsSQLWhere);
  if T<>nil then
  try
    result := TObjectList.Create;
    T.ToObjectList(result,Table);
  finally
    T.Free;
  end;
end;

function TSQLRest.RetrieveListJSON(Table: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
  const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8;
  aForceAJAX: boolean): RawJSON;
var where: RawUTF8;
begin
  where := FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere);
  result := RetrieveListJSON(Table,where,aCustomFieldsCSV,aForceAJAX)
end;

function TSQLRest.RetrieveListJSON(Table: TSQLRecordClass; const SQLWhere: RawUTF8;
  const aCustomFieldsCSV: RawUTF8; aForceAJAX: boolean): RawJSON;
var sql: RawUTF8;
begin
  sql := SQLComputeForSelect(Table,aCustomFieldsCSV,SQLWhere);
  if sql='' then
    result := '' else
    result := EngineList(sql,aForceAJAX);
end;

function TSQLRest.RetrieveListObjArray(var ObjArray; Table: TSQLRecordClass;
  const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
  const aCustomFieldsCSV: RawUTF8): boolean;
var T: TSQLTable;
begin
  result := false;
  if (self=nil) or (Table=nil) then
    exit;
  T := MultiFieldValues(Table,aCustomFieldsCSV,FormatSQLWhere,BoundsSQLWhere);
  if T<>nil then
  try
    result := T.ToObjArray(ObjArray,Table);
  finally
    T.Free;
  end;
end;

procedure TSQLRest.AppendListAsJsonArray(Table: TSQLRecordClass;
  const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
  const OutputFieldName: RawUTF8; W: TJSONSerializer; const CustomFieldsCSV: RawUTF8);
var Rec: TSQLRecord;
begin
  if (self=nil) or (Table=nil) or (W=nil) then
    exit;
  Rec := Table.CreateAndFillPrepare(Self,FormatSQLWhere,BoundsSQLWhere,CustomFieldsCSV);
  try
    Rec.AppendFillAsJsonArray(OutputFieldName,W,Rec.fFill.TableMapFields);
  finally
    Rec.Free;
  end;
end;

function TSQLRest.RTreeMatch(DataTable: TSQLRecordClass;
  const DataTableBlobFieldName: RawUTF8; RTreeTable: TSQLRecordRTreeClass;
  const DataTableBlobField: RawByteString; var DataID: TIDDynArray): boolean;
var Blob: PPropInfo;
    Res: TSQLTableJSON;
    BDouble: TSQLRecordTreeCoords;
    BInteger: TSQLRecordTreeCoordsInteger absolute BDouble;
    Where, SQL: RawUTF8;
    Data, RTree: TSQLRecordProperties;
    i: integer;
begin
  result := false;
  if (self=nil) or (DataTable=nil) or (RTreeTable=nil) or (DataTableBlobField='') then
    exit;
  RTree := RTreeTable.RecordProps;
  Data := DataTable.RecordProps;
  Blob :=  Data.BlobFieldPropFromRawUTF8(DataTableBlobFieldName);
  if Blob=nil then
    exit;
  if RTreeTable.InheritsFrom(TSQLRecordRTree) then begin
    TSQLRecordRTree(RTreeTable).BlobToCoord(pointer(DataTableBlobField)^,BDouble);
    for i := 0 to (RTree.RTreeCoordBoundaryFields shr 1)-1 do
      Where := FormatUTF8('%%>=:(%): and %<=:(%): and ',
        [Where,RTree.Fields.List[i*2].Name,BDouble[i].Min*(1-0.00000012),
         RTree.Fields.List[i*2+1].Name,BDouble[i].Max*(1+0.00000012)]);
    { from http://sqlite.org/rtree.html:
      For a "contained-within" style query, rounding the bounding boxes outward
      might cause some entries to be excluded from the result set if the edge of
      the entry bounding box corresponds to the edge of the query bounding box.
      To guard against this, applications should expand their contained-within
      query boxes slightly (by 0.000012%) by rounding down the lower coordinates
      and rounding up the top coordinates, in each dimension. }
  end else
  if RTreeTable.InheritsFrom(TSQLRecordRTreeInteger) then begin
    TSQLRecordRTreeInteger(RTreeTable).BlobToCoord(pointer(DataTableBlobField)^,BInteger);
    for i := 0 to (RTree.RTreeCoordBoundaryFields shr 1)-1 do
      Where := FormatUTF8('%%>=:(%): and %<=:(%): and ',
        [Where,RTree.Fields.List[i*2].Name,BInteger[i].Min,
         RTree.Fields.List[i*2+1].Name,BInteger[i].Max]);
  end else
    exit;
  FormatUTF8('select %.RowID from %,% where %.RowID=%.RowID and %%(%,:(%):);',
      [RTree.SQLTableName,Data.SQLTableName,RTree.SQLTableName,Data.SQLTableName,
       Where,RTreeTable.RTreeSQLFunctionName,Data.SQLTableName,
       BinToBase64WithMagic(DataTableBlobField)],sql);
  Res := ExecuteList([DataTable,RTreeTable],sql);
  if Res<>nil then
  try
    if (Res.FieldCount<>1) or (Res.fRowCount<=0) then
      exit;
    Res.GetRowValues(0,TInt64DynArray(DataID));
    result := true;
  finally
    Res.Free;
  end;
end;

{$ifndef NOVARIANTS}
function TSQLRest.RetrieveDocVariantArray(Table: TSQLRecordClass; const ObjectName: RawUTF8;
  const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
  const CustomFieldsCSV: RawUTF8; FirstRecordID,LastRecordID: PID): variant;
var T: TSQLTable;
    res: variant;
begin
  TVarData(res).VType := varNull;
  if (self<>nil) and (Table<>nil) then begin
    T := MultiFieldValues(Table,CustomFieldsCSV,FormatSQLWhere,BoundsSQLWhere);
    if T<>nil then
    try
      T.ToDocVariant(res,{readonly=}false); // not readonly -> TDocVariant dvArray
      if FirstRecordID<>nil then
        FirstRecordID^ := T.IDColumnHiddenValue(1);
      if LastRecordID<>nil then
        LastRecordID^ := T.IDColumnHiddenValue(T.fRowCount);
    finally
      T.Free;
    end;
  end;
  if ObjectName<>'' then
    result := _ObjFast([ObjectName,res]) else
    result := res;
end;

function TSQLRest.RetrieveOneFieldDocVariantArray(Table: TSQLRecordClass;
  const FieldName, FormatSQLWhere: RawUTF8;
  const BoundsSQLWhere: array of const): variant;
var T: TSQLTable;
    row: Integer;
    res: TDocVariantData absolute result;
begin
  VarClear(result);
  if (self<>nil) and (Table<>nil) then begin
    T := MultiFieldValues(Table,FieldName,FormatSQLWhere,BoundsSQLWhere);
    if T<>nil then
    try
      res.InitFast(T.fRowCount,dvArray);
      res.SetCount(T.fRowCount);
      for row := 1 to T.fRowCount do
        T.GetAsVariant(row,0,res.Values[row-1],false,false,false,JSON_OPTIONS_FAST);
    finally
      T.Free;
    end;
  end;
end;

function TSQLRest.RetrieveDocVariantArray(Table: TSQLRecordClass;
  const ObjectName, CustomFieldsCSV: RawUTF8; FirstRecordID,LastRecordID: PID): variant;
begin
  result := RetrieveDocVariantArray(Table,ObjectName,'',[],CustomFieldsCSV,
    FirstRecordID,LastRecordID);
end;

function TSQLRest.RetrieveDocVariant(Table: TSQLRecordClass;
  const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
  const CustomFieldsCSV: RawUTF8): variant;
var T: TSQLTable;
    bits: TSQLFieldBits;
    Rec: TSQLRecord;
    ID: TID;
begin
  SetVariantNull(result);
  if (self<>nil) and (Table<>nil) then begin
    with Table.RecordProps do // optimized primary key direct access
    if Cache.IsCached(Table) and (length(BoundsSQLWhere)=1) and
       VarRecToInt64(BoundsSQLWhere[0],Int64(ID)) and
       FieldBitsFromCSV(CustomFieldsCSV,bits) and
       (IdemPropNameU('RowID=?',FormatSQLWhere) or
        IdemPropNameU('ID=?',FormatSQLWhere)) then begin
      if IsZero(bits) then // get all simple fields, like MultiFieldValues()
        bits := SimpleFieldsBits[soSelect];
      if bits-SimpleFieldsBits[soSelect]=[] then begin
        Rec := Table.Create(self,ID); // use the cache
        try
          Rec.GetAsDocVariant(true,bits,result,nil,{"id"=}true);
        finally
          Rec.Free;
        end;
        exit;
      end;
    end;
    T := MultiFieldValues(Table,CustomFieldsCSV,FormatSQLWhere,BoundsSQLWhere);
    if T<>nil then
    try
      T.ToDocVariant(1,result)
    finally
      T.Free;
    end;
  end;
end;

{$endif}

function TSQLRest.Retrieve(aID: TID; Value: TSQLRecord;
  ForUpdate: boolean): boolean;
var TableIndex: integer; // used by EngineRetrieve() for SQL statement caching
    Resp: RawUTF8;
begin // this version handles locking and use fast EngineRetrieve() method
  // check parameters
  result := false;
  if Value=nil  then
    exit; // avoid GPF
  Value.fID := 0;
  if (self=nil) or (aID=0) then
    exit;
  TableIndex := Model.GetTableIndexExisting(PSQLRecordClass(Value)^);
  // try to lock before retrieval (if ForUpdate)
  if ForUpdate and not Model.Lock(TableIndex,aID) then
    exit;
  // try to retrieve existing JSON from internal cache
  Resp := fCache.Retrieve(TableIndex,aID);
  if Resp='' then begin
    // get JSON object '{...}' in Resp from corresponding EngineRetrieve() method
    Resp := EngineRetrieve(TableIndex,aID);
    if Resp='' then begin
      fCache.NotifyDeletion(TableIndex,aID);
      exit;
    end;
    fCache.Notify(Tableindex,aID,Resp,soSelect);
  end;
  Value.fID := aID; // Resp may not contain the "RowID": field after Update
  // fill Value from JSON if was correctly retrieved
  Value.FillFrom(Resp);
  result := true;
end;

function TSQLRest.Retrieve(const WhereClauseFmt: RawUTF8;
  const Args,Bounds: array of const; Value: TSQLRecord; const aCustomFieldsCSV: RawUTF8): boolean;
var where: RawUTF8;
begin
  where := FormatUTF8(WhereClauseFmt,Args,Bounds);
  result := Retrieve(where,Value,aCustomFieldsCSV);
end;

function TSQLRest.Retrieve(Reference: TRecordReference; ForUpdate: boolean): TSQLRecord;
var aClass: TSQLRecordClass;
begin
  result := nil;
  if (self=nil) or (RecordRef(Reference).ID=0) then
    exit;
  aClass := RecordRef(Reference).Table(Model);
  if aClass=nil then
    exit;
  result := aClass.Create(self,RecordRef(Reference).ID,ForUpdate);
  if result.fID=0 then
    FreeAndNil(result); // error during value retrieval
end;

function TSQLRest.Retrieve(aPublishedRecord, aValue: TSQLRecord): boolean;
begin
  result := Retrieve(aPublishedRecord.ID,aValue);
end;

function TSQLRest.UnLock(Rec: TSQLRecord): boolean;
begin
  if (self=nil) or (Rec=nil) or (Rec.fID<=0) then
    result := false else
    result := UnLock(PSQLRecordClass(Rec)^,Rec.fID);
end;

procedure TSQLRest.Commit(SessionID: cardinal; RaiseException: boolean);
begin
  if self<>nil then begin
    fAcquireExecution[execORMWrite].Safe.Lock;
    try
      if (fTransactionActiveSession<>0) and
         (fTransactionActiveSession=SessionID) then begin
        fTransactionActiveSession := 0; // by default, just release flag
        fTransactionTable := nil;
      end;
    finally
      fAcquireExecution[execORMWrite].Safe.UnLock;
    end;
  end;
end;

procedure TSQLRest.RollBack(SessionID: cardinal);
begin
  if self<>nil then begin
    fAcquireExecution[execORMWrite].Safe.Lock;
    try
      if (fTransactionActiveSession<>0) and
         (fTransactionActiveSession=SessionID) then begin
        fTransactionActiveSession := 0; // by default, just release flag
        fTransactionTable := nil;
      end;
    finally
      fAcquireExecution[execORMWrite].Safe.UnLock;
    end;
  end;
end;

function TSQLRest.TransactionBegin(aTable: TSQLRecordClass; SessionID: cardinal): boolean;
begin
  result := false;
  fAcquireExecution[execORMWrite].Safe.Lock;
  try
    if fTransactionActiveSession=0 then begin // nested transactions are not allowed
      fTransactionActiveSession := SessionID;
      fTransactionTable := aTable;
      result := true;
    end;
  finally
    fAcquireExecution[execORMWrite].Safe.UnLock;
  end;
end;

function TSQLRest.TransactionActiveSession: cardinal;
begin
  if self=nil then
    result := 0 else begin
    fAcquireExecution[execORMWrite].Safe.Lock;
    try
      result := fTransactionActiveSession;
    finally
      fAcquireExecution[execORMWrite].Safe.UnLock;
    end;
  end;
end;

function TSQLRest.BatchSend(Batch: TSQLRestBatch;
  var Results: TIDDynArray): integer;
var Data: RawUTF8;
begin
  result := HTTP_BADREQUEST;
  if (self=nil) or (Batch=nil) then // no opened BATCH sequence
    exit;
  InternalLog('BatchSend %',[Batch]);
  if Batch.PrepareForSending(Data) then
    if Data='' then // i.e. Batch.Count=0
      result := HTTP_SUCCESS else
      try
        result := EngineBatchSend(Batch.Table,Data,Results,Batch.Count);
      except
        on Exception do // e.g. from TSQLRestServer.EngineBatchSend()
          result := HTTP_SERVERERROR;
      end;
end;

function TSQLRest.BatchSend(Batch: TSQLRestBatch): integer;
var DummyRes: TIDDynArray;
begin
  result := BatchSend(Batch,DummyRes);
end;

function TSQLRest.RecordCanBeUpdated(Table: TSQLRecordClass; ID: TID;
  Action: TSQLEvent; ErrorMsg: PRawUTF8=nil): boolean;
begin
  result := true; // accept by default -> override this method to customize this
end;

function TSQLRest.Delete(Table: TSQLRecordClass; ID: TID): boolean;
var tableIndex: integer;
begin
  tableIndex := Model.GetTableIndexExisting(Table);
  if not RecordCanBeUpdated(Table,ID,seDelete) then
    result := false else begin
    fCache.NotifyDeletion(tableIndex,ID);
    fAcquireExecution[execORMWrite].fSafe.Lock;
    try // may be within a batch in another thread
      result := EngineDelete(tableIndex,ID);
    finally
      fAcquireExecution[execORMWrite].fSafe.Unlock;
    end;
  end;
end;

function TSQLRest.InternalDeleteNotifyAndGetIDs(Table: TSQLRecordClass;
  const SQLWhere: RawUTF8; var IDs: TIDDynArray): boolean;
var tableIndex, i: integer;
begin
  tableIndex := Model.GetTableIndexExisting(Table);
  result := false;
  if OneFieldValues(Table,'RowID',SQLWhere,TInt64DynArray(IDs)) and
     (IDs<>nil) then begin
    for i := 0 to length(IDs)-1 do
      if not RecordCanBeUpdated(Table,IDs[i],seDelete) then
        exit;
    fCache.NotifyDeletions(tableIndex,TInt64DynArray(IDs));
  end;
  result := true;
end;

function TSQLRest.Delete(Table: TSQLRecordClass; const SQLWhere: RawUTF8): boolean;
var IDs: TIDDynArray;
begin
  if InternalDeleteNotifyAndGetIDs(Table,SQLWhere,IDs) then begin
    fAcquireExecution[execORMWrite].fSafe.Lock;
    try // may be within a batch in another thread
      result := EngineDeleteWhere(Model.GetTableIndexExisting(Table),SQLWhere,IDs);
    finally
      fAcquireExecution[execORMWrite].fSafe.Unlock;
    end;
  end else
    result := false;
end;

function TSQLRest.Delete(Table: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
  const BoundsSQLWhere: array of const): boolean;
var where: RawUTF8;
begin
  where := FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere);
  result := Delete(Table,where);
end;

function TSQLRest.Update(Value: TSQLRecord; const CustomFields: TSQLFieldBits;
  DoNotAutoComputeFields: boolean): boolean;
var JSONValues: RawUTF8;
    TableIndex: integer;
    FieldBits: TSQLFieldBits;
begin
  if (self=nil) or (Value=nil) or (Value.fID=0) or
    not RecordCanBeUpdated(PSQLRecordClass(Value)^,Value.fID,seUpdate) then begin
    result := false; // current user don't have enough right to update this record
    exit;
  end;
  TableIndex := Model.GetTableIndexExisting(PSQLRecordClass(Value)^);
  if not DoNotAutoComputeFields then
    Value.ComputeFieldsBeforeWrite(self,seUpdate); // update sftModTime fields
  if IsZero(CustomFields) then
    if (Value.fFill<>nil) and (Value.fFill.Table<>nil) and
       (Value.fFill.fTableMapRecordManyInstances=nil) then
      // within FillPrepare/FillOne loop: update ID, TModTime and mapped fields
      FieldBits := Value.fFill.fTableMapFields+Value.RecordProps.FieldBits[sftModTime] else
      // update all simple/custom fields (also for FillPrepareMany)
      FieldBits := Value.RecordProps.SimpleFieldsBits[soUpdate] else
    // CustomFields<>[] -> update specified (and TModTime fields)
    if DoNotAutoComputeFields then
      FieldBits := CustomFields else
      FieldBits := CustomFields+Value.RecordProps.FieldBits[sftModTime];
  if IsZero(FieldBits) then begin
    result := true; // a TSQLRecord with NO simple fields (e.g. ID/blob pair)
    exit;
  end;
  fCache.Notify(Value,soUpdate); // will serialize Value (JSONValues may not be enough)
  JSONValues := Value.GetJSONValues(true,false,FieldBits);
  fAcquireExecution[execORMWrite].fSafe.Lock;
  try // may be within a batch in another thread
    result := EngineUpdate(TableIndex,Value.fID,JSONValues);
  finally
    fAcquireExecution[execORMWrite].fSafe.UnLock;
  end;
end;

function TSQLRest.Update(Value: TSQLRecord; const CustomCSVFields: RawUTF8;
  DoNotAutoComputeFields: boolean): boolean;
begin
  if (self=nil) or (Value=nil) then
    result := false else
    result := Update(Value,Value.RecordProps.FieldBitsFromCSV(CustomCSVFields),
      DoNotAutoComputeFields);
end;

function TSQLRest.Update(aTable: TSQLRecordClass; aID: TID;
  const aSimpleFields: array of const): boolean;
var Value: TSQLRecord;
begin
  result := false; // means error
  if (self=nil) or (aTable=nil) or (aID=0) then
    exit;
  Value := aTable.Create;
  try
    if not Value.SimplePropertiesFill(aSimpleFields) then
      exit;
    Value.fID := aID;
    result := Update(Value);
  finally
    Value.Free;
  end;
end;

function TSQLRest.UpdateField(Table: TSQLRecordClass; ID: TID;
  const FieldName: RawUTF8; const FieldValue: array of const): boolean;
var tableIndex: integer;
begin
  tableIndex := Model.GetTableIndexExisting(Table);
  result := UpdateField(Table,'RowID',[ID],FieldName,FieldValue);
  if result then
    fCache.NotifyDeletion(tableIndex,ID);
end;

function TSQLRest.UpdateField(Table: TSQLRecordClass;
  const WhereFieldName: RawUTF8; const WhereFieldValue: array of const;
  const FieldName: RawUTF8; const FieldValue: array of const): boolean;
var tableIndex: integer;
    SetValue,WhereValue: RawUTF8;
begin
  result := false;
  if (length(FieldValue)<>1) or (WhereFieldName='') or (length(WhereFieldValue)<>1) then
    exit;
  VarRecToInlineValue(WhereFieldValue[0],WhereValue);
  VarRecToInlineValue(FieldValue[0],SetValue);
  tableIndex := Model.GetTableIndexExisting(Table);
  result := EngineUpdateField(tableIndex,FieldName,SetValue,WhereFieldName,WhereValue);
  // warning: this may not update the internal cache
end;

{$ifndef NOVARIANTS}

function TSQLRest.UpdateField(Table: TSQLRecordClass; ID: TID;
  const FieldName: RawUTF8; const FieldValue: Variant): boolean;
var tableIndex: integer;
begin
  tableIndex := Model.GetTableIndexExisting(Table);
  result := UpdateField(Table,'RowID',ID,FieldName,FieldValue);
  if result then
    fCache.NotifyDeletion(tableIndex,ID);
end;

function TSQLRest.UpdateField(Table: TSQLRecordClass;
  const WhereFieldName: RawUTF8; const WhereFieldValue: Variant;
  const FieldName: RawUTF8; const FieldValue: Variant): boolean;
var tableIndex: integer;
    SetValue,WhereValue: RawUTF8;
begin
  VariantToInlineValue(WhereFieldValue,WhereValue);
  VariantToInlineValue(FieldValue,SetValue);
  tableIndex := Model.GetTableIndexExisting(Table);
  result := EngineUpdateField(TableIndex,FieldName,SetValue,WhereFieldName,WhereValue);
  // warning: this may not update the internal cache
end;

function TSQLRest.UpdateField(Table: TSQLRecordClass; const IDs: array of Int64;
  const FieldName: RawUTF8; const FieldValue: variant): boolean;
var SetValue,Where: RawUTF8;
    tableindex: integer;
begin
  tableIndex := Model.GetTableIndexExisting(Table);
  VariantToInlineValue(FieldValue,SetValue);
  Where := SelectInClause('RowID',IDs,'',INLINED_MAX);
  if length(IDs)<=INLINED_MAX then
    result := ExecuteFmt('update % set %=:(%): where %', [Table.SQLTableName,
      FieldName,SetValue,Where]) else // don't cache such a statement
    result := ExecuteFmt('update % set %=% where %', [Table.SQLTableName,
      FieldName,SetValue,Where]);
  if result then
    fCache.NotifyDeletions(tableIndex,IDs);
end;

{$endif NOVARIANTS}

function TSQLRest.UpdateFieldIncrement(Table: TSQLRecordClass; ID: TID;
  const FieldName: RawUTF8; Increment: Int64): boolean;
var tableIndex: integer;
begin
  if ID<>0 then begin
    tableIndex := Model.GetTableIndexExisting(Table);
    result := EngineUpdateFieldIncrement(tableIndex,ID,FieldName,Increment);
    if fCache<>nil then
      fCache.NotifyDeletion(tableIndex,ID);
  end else
    result := false;
end;

procedure TSQLRest.GetJSONValuesForAdd(TableIndex: integer; Value: TSQLRecord;
  ForceID, DoNotAutoComputeFields, WithBlobs: boolean;
  CustomFields: PSQLFieldBits; var result: RawUTF8);
var fields: TSQLFieldBits;
    props: TSQLRecordProperties;
begin
  if not DoNotAutoComputeFields then // update TModTime/TCreateTime fields
    Value.ComputeFieldsBeforeWrite(self,seAdd);
  if Model.TableProps[TableIndex].Kind in INSERT_WITH_ID then
    ForceID := true;
  if (Model.fIDGenerator<>nil) and (Model.fIDGenerator[TableIndex]<>nil) then begin
    if (Value.fID=0) or not ForceID then begin
      Value.fID := Model.fIDGenerator[TableIndex].ComputeNew;
      ForceID := true;
    end;
  end else
    if Value.fID=0 then
      ForceID := false;
  props := Value.RecordProps;
  if CustomFields <> nil then
    if DoNotAutoComputeFields then
      fields := CustomFields^*props.CopiableFieldsBits else
      fields := CustomFields^*props.CopiableFieldsBits+props.ComputeBeforeAddFieldsBits else
    if withBlobs then
      fields := props.CopiableFieldsBits else
      fields := props.SimpleFieldsBits[soInsert];
  if not ForceID and IsZero(fields) then
    result := '' else
    result := Value.GetJSONValues(true,ForceID,fields);
end;

function TSQLRest.InternalAdd(Value: TSQLRecord; SendData: boolean;
  CustomFields: PSQLFieldBits; ForceID, DoNotAutoComputeFields: boolean): TID;
var json: RawUTF8;
    TableIndex: integer;
begin
  if Value=nil then begin
    result := 0;
    exit;
  end;
  TableIndex := Model.GetTableIndexExisting(PSQLRecordClass(Value)^);
  if SendData then
    GetJSONValuesForAdd(TableIndex,Value,ForceID,DoNotAutoComputeFields,false,CustomFields,json) else
    json := '';
  // on success, returns the new RowID value; on error, returns 0
  fAcquireExecution[execORMWrite].fSafe.Lock;
  try // may be within a batch in another thread
    result := EngineAdd(TableIndex,json); // will call static if necessary
  finally
    fAcquireExecution[execORMWrite].fSafe.Unlock;
  end;
  // on success, Value.ID is updated with the new RowID
  Value.fID := result;
  if SendData and (result<>0) then
    fCache.Notify(PSQLRecordClass(Value)^,result,json,soInsert);
end;

function TSQLRest.Add(Value: TSQLRecord; SendData,ForceID,DoNotAutoComputeFields: boolean): TID;
begin
  result := InternalAdd(Value,SendData,nil,ForceID,DoNotAutoComputeFields);
end;

function TSQLRest.Add(Value: TSQLRecord; const CustomCSVFields: RawUTF8;
  ForceID, DoNotAutoComputeFields: boolean): TID;
var f: TSQLFieldBits;
begin
  with Value.RecordProps do
    if CustomCSVFields='*' then // FieldBitsFromCSV('*') will use [soSelect]
      f := SimpleFieldsBits[soInsert] else
      f := FieldBitsFromCSV(CustomCSVFields);
  result := InternalAdd(Value,true,@f,ForceID,DoNotAutoComputeFields);
end;

function TSQLRest.Add(Value: TSQLRecord; const CustomFields: TSQLFieldBits;
  ForceID, DoNotAutoComputeFields: boolean): TID;
begin
  result := InternalAdd(Value,true,@CustomFields,ForceID,DoNotAutoComputeFields);
end;

function TSQLRest.AddSimple(aTable: TSQLRecordClass; const aSimpleFields: array of const;
  ForcedID: TID): TID;
var Value: TSQLRecord;
begin
  result := 0; // means error
  if (self=nil) or (aTable=nil) then
    exit;
  Value := aTable.Create;
  try
    if Value.SimplePropertiesFill(aSimpleFields) then begin
      if ForcedID<>0 then
        Value.fID := ForcedID;
      result := Add(Value,true,(ForcedID<>0));
    end;
  finally
    Value.Free;
  end;
end;

function TSQLRest.AddWithBlobs(Value: TSQLRecord;
  ForceID, DoNotAutoComputeFields: boolean): TID;
var TableIndex: integer;
    json: RawUTF8;
begin
  if Value=nil then begin
    result := 0;
    exit;
  end;
  TableIndex := Model.GetTableIndexExisting(PSQLRecordClass(Value)^);
  GetJSONValuesForAdd(TableIndex,Value,ForceID,DoNotAutoComputeFields,true,nil,json);
  // on success, returns the new RowID value; on error, returns 0
  fAcquireExecution[execORMWrite].fSafe.Lock;
  try // may be within a batch in another thread
    result := EngineAdd(TableIndex,json); // will call static if necessary
  finally
    fAcquireExecution[execORMWrite].fSafe.Unlock;
  end;
  // on success, Value.ID is updated with the new RowID
  Value.fID := result;
  // here fCache.Notify is not called, since the JSONValues is verbose
end;

function TSQLRest.AddOrUpdate(Value: TSQLRecord; ForceID: boolean): TID;
begin
  if (self=nil) or (Value=nil) then begin
    result := 0;
    exit;
  end;
  if ForceID or (Value.fID=0) then begin
    result := Add(Value,true,ForceID);
    if (result<>0) or (Value.fID=0) then
      exit;
  end;
  if Update(Value) then
    result := Value.fID else
    result := 0;
end;

procedure TSQLRest.QueryAddCustom(aTypeInfo: pointer; aEvent: TSQLQueryEvent;
  const aOperators: TSQLQueryOperators);
var Enum: PEnumType;
    i,n: integer;
begin
  if (self=nil) or not Assigned(aEvent)  or
     (aTypeInfo=nil) or (PTypeInfo(aTypeInfo)^.Kind<>tkEnumeration) then
    exit;
  Enum := PTypeInfo(aTypeInfo)^.EnumBaseType;
  n := length(QueryCustom);
  SetLength(QueryCustom,n+Enum^.MaxValue+1);
  for i := 0 to Enum^.MaxValue do
    with QueryCustom[i+n] do begin
      EnumType := Enum;
      EnumIndex := i;
      Event := aEvent;
      Operators := aOperators;
    end;
end;

class function TSQLRest.QueryIsTrue(aTable: TSQLRecordClass; aID: TID;
  FieldType: TSQLFieldType; Value: PUTF8Char; Operator: integer;
  Reference: PUTF8Char): boolean;
begin // use mostly the same fast comparison functions as for sorting
  result := false;
  if aID=0 then
    exit; // invalid input field
  if Reference=nil then
    exit; // avoid most GPF
  if FieldType=sftMany then
    exit; // nothing is stored directly, but in a separate pivot table
  if FieldType in [sftUnknown,sftBlob,sftBlobDynArray,sftBlobCustom,sftObject,
    sftUTF8Custom{$ifndef NOVARIANTS},sftVariant,sftNullable{$endif}] then
    FieldType := sftUTF8Text; // unknown or blob fields are compared as UTF-8
  { TODO: handle proper sftBlobDynArray/sftBlobCustom/sftBlobRecord comparison }
  case TSQLQueryOperator(Operator) of
    qoNone:
      result := true;
    qoEqualTo:
      result := SQLFieldTypeComp[FieldType](Value,Reference)=0;
    qoNotEqualTo:
      result := SQLFieldTypeComp[FieldType](Value,Reference)<>0;
    qoLessThan:
      result := SQLFieldTypeComp[FieldType](Value,Reference)<0;
    qoLessThanOrEqualTo:
      result := SQLFieldTypeComp[FieldType](Value,Reference)<=0;
    qoGreaterThan:
      result := SQLFieldTypeComp[FieldType](Value,Reference)>0;
    qoGreaterThanOrEqualTo:
      result := SQLFieldTypeComp[FieldType](Value,Reference)>=0;
    qoEqualToWithCase:
      result := StrComp(Value,Reference)=0;
    qoNotEqualToWithCase:
      result := StrComp(Value,Reference)<>0;
    qoContains:
      result := PosIU(Reference,Value)<>0;
    qoBeginWith:
      result := IdemPCharU(Value,Reference);
    qoSoundsLikeEnglish,
    qoSoundsLikeFrench,
    qoSoundsLikeSpanish:
      result := PSynSoundEx(Reference)^.UTF8(Value);
  end;
end;

function TSQLRest.RetrieveBlob(Table: TSQLRecordClass; aID: TID;
  const BlobFieldName: RawUTF8; out BlobStream: THeapMemoryStream): boolean;
var BlobData: TSQLRawBlob;
begin
  BlobStream := THeapMemoryStream.Create;
  result := RetrieveBlob(Table,aID,BlobFieldName,BlobData);
  if not result or (BlobData='') then
    exit;
  if BlobStream.Write(pointer(BlobData)^,length(BlobData))<>length(BlobData) then
    result := false;
  BlobStream.Seek(0,soFromBeginning); // rewind
end;

function TSQLRest.UpdateBlob(Table: TSQLRecordClass; aID: TID;
  const BlobFieldName: RawUTF8; BlobData: TStream): boolean;
var Blob: TSQLRawBlob;
    L: integer;
begin
  result := false;
  if (self=nil) or (BlobData=nil) then
    exit;
  L := BlobData.Seek(0,soFromEnd);
  SetLength(Blob,L);
  BlobData.Seek(0,soFromBeginning);
  if BlobData.Read(pointer(Blob)^,L)<>L then
    exit;
  result := UpdateBlob(Table,aID,BlobFieldName,Blob);
end;

function TSQLRest.UpdateBlob(Table: TSQLRecordClass; aID: TID;
  const BlobFieldName: RawUTF8; BlobData: pointer; BlobSize: integer): boolean;
var Blob: TSQLRawBlob;
begin
  if (self=nil) or (BlobData=nil) or (BlobSize<0) then
    result := false else begin
    SetString(Blob,PAnsiChar(BlobData),BlobSize);
    result := UpdateBlob(Table,aID,BlobFieldName,Blob);
  end;
end;

function TSQLRest.RetrieveBlob(Table: TSQLRecordClass; aID: TID;
  const BlobFieldName: RawUTF8; out BlobData: TSQLRawBlob): boolean;
var BlobField: PPropInfo;
begin
  result := false;
  if (self=nil) or (aID<=0) then
    exit;
  BlobField := Table.RecordProps.BlobFieldPropFromRawUTF8(BlobFieldName);
  if BlobField=nil then
    exit;
  result := EngineRetrieveBlob(
    Model.GetTableIndexExisting(Table),aID,BlobField,BlobData);
end;

function TSQLRest.UpdateBlob(Table: TSQLRecordClass; aID: TID;
  const BlobFieldName: RawUTF8; const BlobData: TSQLRawBlob): boolean;
var BlobField: PPropInfo;
begin
  result := false;
  if (self=nil) or (aID<=0) or not RecordCanBeUpdated(Table,aID,seUpdate) then
    exit;
  BlobField := Table.RecordProps.BlobFieldPropFromRawUTF8(BlobFieldName);
  if BlobField=nil then
    exit;
  result := EngineUpdateBlob(
    Model.GetTableIndexExisting(Table),aID,BlobField,BlobData);
end;

function TSQLRest.UpdateBlobFields(Value: TSQLRecord): boolean;
var BlobData: RawByteString;
    TableIndex, i: integer;
begin
  result := false;
  if (Value=nil) or (Value.fID<=0) then
    exit;
  with Value.RecordProps do
  if BlobFields<>nil then begin
    TableIndex := self.fModel.GetTableIndexExisting(PSQLRecordClass(Value)^);
    for i := 0 to length(BlobFields)-1 do begin
      BlobFields[i].PropInfo.GetLongStrProp(Value,BlobData);
      if not EngineUpdateBlob(TableIndex,Value.fID,BlobFields[i].PropInfo,BlobData) then
        exit;
    end;
  end;
  result := true;
end;

function TSQLRest.RetrieveBlobFields(Value: TSQLRecord): boolean;
var BlobData: TSQLRawBlob;
    TableIndex, i: integer;
begin
  result := false;
  if (Self=nil) or (Value=nil) or (Value.fID<=0) then
    exit;
  with Value.RecordProps do
  if BlobFields<>nil then begin
    TableIndex := self.fModel.GetTableIndexExisting(PSQLRecordClass(Value)^);
    for i := 0 to length(BlobFields)-1 do
      if EngineRetrieveBlob(TableIndex,Value.fID,BlobFields[i].PropInfo,BlobData) then
        BlobFields[i].PropInfo.SetLongStrProp(Value,BlobData) else
        exit;
  end;
  result := true;
end;

function TSQLRest.TableRowCount(Table: TSQLRecordClass): Int64;
var T: TSQLTableJSON;
begin
  if (self=nil) or (Table=nil) then
    T := nil else
    T := ExecuteList([Table],'SELECT Count(*) FROM '+Table.RecordProps.SQLTableName);
  if T<>nil then
  try
    Result := T.GetAsInt64(1,0);
  finally
    T.Free;
  end else
    Result := -1;
end;

function TSQLRest.TableHasRows(Table: TSQLRecordClass): boolean;
var T: TSQLTableJSON;
begin
  if (self=nil) or (Table=nil) then
    T := nil else
    T := ExecuteList([Table],'SELECT RowID FROM '+Table.RecordProps.SQLTableName+' LIMIT 1');
  if T<>nil then
  try
    Result := T.fRowCount>0;
  finally
    T.Free;
  end else
    Result := false;
end;

function TSQLRest.TableMaxID(Table: TSQLRecordClass): TID;
var T: TSQLTableJSON;
begin
  if (self=nil) or (Table=nil) then
    T := nil else
    T := ExecuteList([Table],'SELECT max(RowID) FROM '+Table.RecordProps.SQLTableName);
  if T<>nil then
  try
    Result := T.GetAsInt64(1,0);
  finally
    T.Free;
  end else
    Result := -1;
end;

function TSQLRest.ExecuteList(const Tables: array of TSQLRecordClass; const SQL: RawUTF8): TSQLTableJSON;
var JSON: RawUTF8;
begin
  JSON := EngineList(SQL,false);
  if JSON<>'' then
    result := TSQLTableJSON.CreateFromTables(Tables,SQL,JSON) else
    result := nil;
end;

function TSQLRest.ExecuteJson(const Tables: array of TSQLRecordClass;
  const SQL: RawUTF8; ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawJSON;
begin
  result := EngineList(SQL,ForceAjax,ReturnedRowCount);
end;

function TSQLRest.Execute(const aSQL: RawUTF8): boolean;
begin
  result := EngineExecute(aSQL);
end;

function TSQLRest.ExecuteFmt(const SQLFormat: RawUTF8;
  const Args: array of const): boolean;
var SQL: RawUTF8;
begin
  FormatUTF8(SQLFormat,Args,SQL);
  result := EngineExecute(SQL);
end;

function TSQLRest.ExecuteFmt(const SQLFormat: RawUTF8;
  const Args, Bounds: array of const): boolean;
var SQL: RawUTF8;
begin
  SQL := FormatUTF8(SQLFormat,Args,Bounds);
  result := EngineExecute(SQL);
end;

function TSQLRest.MainFieldValue(Table: TSQLRecordClass; ID: TID;
   ReturnFirstIfNoUnique: boolean=false): RawUTF8;
begin
  if (self=nil) or (Table=nil) or (ID<=0) then
    result := '' else begin
    result := Table.RecordProps.MainFieldName(ReturnFirstIfNoUnique);
    if result<>'' then
      result := OneFieldValue(Table,Result,ID);
  end;
end;

function TSQLRest.MainFieldID(Table: TSQLRecordClass; const Value: RawUTF8): TID;
var aMainField: integer;
begin
  result := 0;
  if (self<>nil) and (Value<>'') and (Table<>nil) then
  with Table.RecordProps do begin
    aMainField := MainField[false];
    if aMainField>=0 then
      SetID(OneFieldValue(Table,'RowID',
        Fields.List[aMainField].Name+'=:('+QuotedStr(Value,'''')+'):'),result);
  end;
end;

function TSQLRest.MainFieldIDs(Table: TSQLRecordClass; const Values: array of RawUTF8;
  out IDs: TIDDynArray): boolean;
var aMainField, id: TID;
begin
  if (self<>nil) and (high(Values)>=0) and (Table<>nil) then
    if high(Values)=0 then begin // handle special case of one Values[] item
      id := MainFieldID(Table,Values[0]);
      if id>0 then begin
        SetLength(IDs,1);
        IDs[0] := id;
      end;
    end else
    with Table.RecordProps do begin // request all Values[] IDs at once
      aMainField := MainField[false];
      if aMainField>=0 then
        OneFieldValues(Table,'RowID',
          SelectInClause(Fields.List[aMainField].Name,Values),TInt64DynArray(IDs));
    end;
  result := IDs<>nil;
end;

function TSQLRest.FTSMatch(Table: TSQLRecordFTS3Class;
  const WhereClause: RawUTF8; var DocID: TIDDynArray): boolean;
begin // FTS3 tables don't have any ID, but RowID or DocID
  result := OneFieldValues(Table,'RowID',WhereClause,TInt64DynArray(DocID));
end;

function TSQLRest.FTSMatch(Table: TSQLRecordFTS3Class;
  const MatchClause: RawUTF8; var DocID: TIDDynArray;
  const PerFieldWeight: array of double; limit,offset: integer): boolean;
var WhereClause: RawUTF8;
    i: integer;
begin
  result := false;
  with Table.RecordProps do
    if length(PerFieldWeight)<>length(SimpleFields) then
      exit else
    WhereClause := FormatUTF8('% MATCH ? ORDER BY rank(matchinfo(%)',
      [SQLTableName,SQLTableName],[MatchClause]);
  for i := 0 to high(PerFieldWeight) do
    WhereClause := FormatUTF8('%,?',[WhereClause],[PerFieldWeight[i]]);
  WhereClause := WhereClause+') DESC';
  if limit>0 then
    WhereClause := FormatUTF8('% LIMIT % OFFSET %',[WhereClause,limit,offset]);
  result := FTSMatch(Table,WhereClause,DocID);
end;

function TSQLRest.GetServerTimestamp: TTimeLog;
var Tix: cardinal;
begin
  Tix := GetTickCount64 shr 9; // resolution change 1 ms -> 512 ms
  if fServerTimestampCacheTix=Tix then
    result := fServerTimestampCacheValue.Value else begin
    fServerTimestampCacheTix := Tix;
    fServerTimestampCacheValue.From(NowUTC+fServerTimestampOffset);
    result := fServerTimestampCacheValue.Value;
  end;
end;

procedure TSQLRest.SetServerTimestamp(const Value: TTimeLog);
begin
  fServerTimestampOffset := PTimeLogBits(@Value)^.ToDateTime-NowUTC;
  if fServerTimestampOffset=0 then
    fServerTimestampOffset := 0.000001; // retrieve server date/time only once
end;

function TSQLRest.GetCache: TSQLRestCache;
begin
  if self=nil then
    result := nil else begin
    if fCache=nil then
      fCache := TSQLRestCache.Create(self);
    result := fCache;
  end;
end;

function TSQLRest.CacheOrNil: TSQLRestCache;
begin
  if self=nil then
    result := nil else
    result := fCache;
end;

function TSQLRest.CacheWorthItForTable(aTableIndex: cardinal): boolean;
begin
  result := true; // always worth caching by default
end;

procedure TSQLRest.BeginCurrentThread(Sender: TThread);
begin // nothing do to at this level -> see TSQLRestServer.BeginCurrentThread
end;

procedure TSQLRest.EndCurrentThread(Sender: TThread);
begin // most will be done e.g. in TSQLRestServer.EndCurrentThread
  {$ifdef WITHLOG}
  fLogFamily.OnThreadEnded(Sender);
  {$endif}
end;

procedure TSQLRest.WriteLock;
begin
  fAcquireExecution[execORMWrite].Safe.Lock;
end;

procedure TSQLRest.WriteUnLock;
begin
  fAcquireExecution[execORMWrite].Safe.UnLock;
end;

function TSQLRest.GetAcquireExecutionMode(Cmd: TSQLRestServerURIContextCommand): TSQLRestServerAcquireMode;
begin
  result := fAcquireExecution[Cmd].Mode;
end;

procedure TSQLRest.SetAcquireExecutionMode(Cmd: TSQLRestServerURIContextCommand; Value: TSQLRestServerAcquireMode);
begin
  fAcquireExecution[Cmd].Mode := Value;
end;

function TSQLRest.GetAcquireExecutionLockedTimeOut(Cmd: TSQLRestServerURIContextCommand): cardinal;
begin
  result := fAcquireExecution[Cmd].LockedTimeOut;
end;

procedure TSQLRest.SetAcquireExecutionLockedTimeOut(Cmd: TSQLRestServerURIContextCommand; Value: cardinal);
begin
  fAcquireExecution[Cmd].LockedTimeOut := Value;
end;

function TSQLRest.InternalBatchStart(Method: TSQLURIMethod;
  BatchOptions: TSQLRestBatchOptions): boolean;
begin
  result := false;
end;

procedure TSQLRest.InternalBatchStop;
begin
  raise EORMException.CreateUTF8('Unexpected %.InternalBatchStop',[self]);
end;

function TSQLRest.EngineBatchSend(Table: TSQLRecordClass; var Data: RawUTF8;
  var Results: TIDDynArray; ExpectedResultsCount: integer): integer;
begin
  raise EORMException.CreateUTF8('BATCH not supported by %',[self]);
end;

{$ifdef ISDELPHI2010} // Delphi 2009/2010 generics support is buggy :(

function TSQLRest.Service<T>: T;
var service: TServiceFactory;
begin
  service := fServices.Info(TypeInfo(T));
  if (service=nil) or not service.Get(result) then
    result := Default(T);
end;

function TSQLRest.RetrieveList<T>(const aCustomFieldsCSV: RawUTF8): TObjectList<T>;
begin
  result := RetrieveList<T>('',[],aCustomFieldsCSV);
end;

function TSQLRest.RetrieveList<T>(const FormatSQLWhere: RawUTF8;
  const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8): TObjectList<T>;
var Table: TSQLTable;
begin
  result := nil;
  if self=nil then
    exit;
  Table := MultiFieldValues(TSQLRecordClass(T),aCustomFieldsCSV,FormatSQLWhere,BoundsSQLWhere);
  if Table<>nil then
  try
    result := Table.ToObjectList<T>;
  finally
    Table.Free;
  end;
end;

{$endif}


{ TSQLRestCacheEntry }

procedure TSQLRestCacheEntry.Init;
begin
  Value.InitSpecific(TypeInfo(TSQLRestCacheEntryValueDynArray),
    Values,djInt64,@Count); // will search/sort by first ID: TID field
  Mutex.Init;
end;

procedure TSQLRestCacheEntry.Done;
begin
  Mutex.Done;
end;

procedure TSQLRestCacheEntry.Clear;
begin
  Mutex.Lock;
  try
    Value.Clear;
    CacheAll := false;
    CacheEnable := false;
    TimeOutMS := 0;
  finally
    Mutex.UnLock;
  end;
end;

procedure TSQLRestCacheEntry.FlushCacheEntry(Index: Integer);
begin
  if cardinal(Index)<cardinal(Count) then
    if CacheAll then
      Value.FastDeleteSorted(Index) else
      with Values[Index] do begin
        Timestamp512 := 0;
        JSON := '';
        Tag := 0;
      end;
end;

procedure TSQLRestCacheEntry.FlushCacheAllEntries;
var i: integer;
begin
  if not CacheEnable then
    exit;
  Mutex.Lock;
  try
    if CacheAll then
      Value.Clear else
      for i := 0 to Count-1 do
      with Values[i] do begin
        Timestamp512 := 0;
        JSON := '';
        Tag := 0;
      end;
  finally
    Mutex.UnLock;
  end;
end;

procedure TSQLRestCacheEntry.SetCache(aID: TID);
var Rec: TSQLRestCacheEntryValue;
    i: integer;
begin
  Mutex.Lock;
  try
    CacheEnable := true;
    if not CacheAll and not Value.FastLocateSorted(aID,i) and (i>=0) then begin
      Rec.ID := aID;
      Rec.Timestamp512 := 0; // indicates no value cache yet
      Rec.Tag := 0;
      Value.FastAddSorted(i,Rec);
    end; // do nothing if aID is already in Values[]
  finally
    Mutex.UnLock;
  end;
end;

procedure TSQLRestCacheEntry.SetJSON(aID: TID; const aJSON: RawUTF8; aTag: cardinal);
var Rec: TSQLRestCacheEntryValue;
    i: integer;
begin
  Rec.ID := aID;
  Rec.JSON := aJSON;
  Rec.Timestamp512 := GetTickCount64 shr 9;
  Rec.Tag := aTag;
  Mutex.Lock;
  try
    if Value.FastLocateSorted(Rec,i) then
      Values[i] := Rec else
      if CacheAll and (i>=0) then
        Value.FastAddSorted(i,Rec);
  finally
    Mutex.UnLock;
  end;
end;

procedure TSQLRestCacheEntry.SetJSON(aRecord: TSQLRecord);
begin  // soInsert = include all fields
  SetJSON(aRecord.fID,aRecord.GetJSONValues(true,false,soInsert));
end;

function TSQLRestCacheEntry.RetrieveJSON(aID: TID; var aJSON: RawUTF8;
  aTag: PCardinal): boolean;
var i: integer;
begin
  result := false;
  Mutex.Lock;
  try
    i := Value.Find(aID); // fast O(log(n)) binary search by first ID field
    if i>=0 then
      with Values[i] do
      if Timestamp512<>0 then // 0 when there is no JSON value cached
        if (TimeOutMS<>0) and ((GetTickCount64-TimeOutMS) shr 9>Timestamp512) then
          FlushCacheEntry(i) else begin
          if aTag<>nil then
            aTag^ := Tag;
          aJSON := JSON;
          result := true; // found a non outdated serialized value in cache
        end;
  finally
    Mutex.UnLock;
  end;
end;

function TSQLRestCacheEntry.RetrieveJSON(aID: TID; aValue: TSQLRecord;
  aTag: PCardinal): boolean;
var JSON: RawUTF8;
begin
  if RetrieveJSON(aID,JSON,aTag) then begin
    aValue.FillFrom(JSON);
    aValue.fID := aID; // override RowID field (may be not present after Update)
    result := true;
  end else
    result := false;
end;

function TSQLRestCacheEntry.CachedMemory(FlushedEntriesCount: PInteger): cardinal;
var i: integer;
    tix512: cardinal;
begin
  result := 0;
  if CacheEnable and (Count>0) then begin
    tix512 := (GetTickCount64-TimeOutMS) shr 9;
    Mutex.Lock;
    try
      for i := Count-1 downto 0 do
        with Values[i] do
        if Timestamp512<>0 then
          if (TimeOutMS<>0) and (tix512>Timestamp512) then begin
            FlushCacheEntry(i);
            if FlushedEntriesCount<>nil then
              inc(FlushedEntriesCount^);
          end else
            inc(result,length(JSON)+(SizeOf(TSQLRestCacheEntryValue)+16));
    finally
      Mutex.UnLock;
    end;
  end;
end;


{ TSQLRestCache }

constructor TSQLRestCache.Create(aRest: TSQLRest);
var i: PtrInt;
begin
  if aRest=nil then
    EBusinessLayerException.CreateUTF8('%.Create',[self]);
  fRest := aRest;
  SetLength(fCache,length(fRest.Model.Tables));
  for i := 0 to length(fCache)-1 do
    fCache[i].Init;
end;

destructor TSQLRestCache.Destroy;
var i: PtrInt;
begin
  for i := 0 to length(fCache)-1 do
    fCache[i].Done;
  inherited;
end;

function TSQLRestCache.CachedEntries: cardinal;
var i,j: PtrInt;
begin
  result := 0;
  if self<>nil then
    for i := 0 to length(fCache)-1 do
      with fCache[i] do
      if CacheEnable then begin
        Mutex.Lock;
        try
          for j := 0 to Count-1 do
            if Values[j].Timestamp512<>0 then
              inc(result);
        finally
          Mutex.UnLock;
        end;
      end;
end;

function TSQLRestCache.CachedMemory(FlushedEntriesCount: PInteger): cardinal;
var i: PtrInt;
begin
  result := 0;
  if FlushedEntriesCount<>nil then
    FlushedEntriesCount^ := 0;
  if self<>nil then
    for i := 0 to length(fCache)-1 do
      inc(result,fCache[i].CachedMemory(FlushedEntriesCount));
end;

function TSQLRestCache.SetTimeOut(aTable: TSQLRecordClass; aTimeoutMS: Cardinal): boolean;
var i: PtrInt;
begin
  result := false;
  if (self=nil) or (aTable=nil) then
    exit;
  i := Rest.Model.GetTableIndexExisting(aTable);
  if Rest.CacheWorthItForTable(i) then
    if Cardinal(i)<Cardinal(Length(fCache)) then
      with fCache[i] do begin
        Mutex.Lock;
        try
          TimeOutMS := aTimeOutMS;
        finally
          Mutex.UnLock;
        end;
        result := true;
      end;
end;

function TSQLRestCache.IsCached(aTable: TSQLRecordClass): boolean;
var i: cardinal;
begin
  result := false;
  if (self=nil) or (aTable=nil) then
    exit;
  i := Rest.Model.GetTableIndexExisting(aTable);
  if i<Cardinal(Length(fCache)) then
    if fCache[i].CacheEnable then
      result := true;
end;

function TSQLRestCache.SetCache(aTable: TSQLRecordClass): boolean;
var i: integer;
begin
  result := false;
  if (self=nil) or (aTable=nil) then
    exit;
  i := Rest.Model.GetTableIndexExisting(aTable);
  if Rest.CacheWorthItForTable(i) then
    if Cardinal(i)<Cardinal(Length(fCache)) then
      with fCache[i] do begin
        // global cache of all records of this table
        Mutex.Lock;
        try
          CacheEnable := true;
          CacheAll := true;
          Value.Clear;
          result := true;
        finally
          Mutex.UnLock;
        end;
      end;
end;

function TSQLRestCache.SetCache(aTable: TSQLRecordClass; aID: TID): boolean;
var i: cardinal;
begin
  result := false;
  if (self=nil) or (aTable=nil) or (aID<=0) then
    exit;
  i := Rest.Model.GetTableIndex(aTable);
  if i>=cardinal(Length(fCache)) then
    exit;
  if Rest.CacheWorthItForTable(i) then
    fCache[i].SetCache(aID);
  result := True;
end;

function TSQLRestCache.SetCache(aTable: TSQLRecordClass; const aIDs: array of TID): boolean;
var i: cardinal;
    j: PtrInt;
begin
  result := false;
  if (self=nil) or (aTable=nil) or (length(aIDs)=0) then
    exit;
  i := Rest.Model.GetTableIndex(aTable);
  if i>=cardinal(Length(fCache)) then
    exit;
  if Rest.CacheWorthItForTable(i) then
    for j := 0 to high(aIDs) do
      fCache[i].SetCache(aIDs[j]);
  result := True;
end;

function TSQLRestCache.SetCache(aRecord: TSQLRecord): boolean;
begin
  if (self=nil) or (aRecord=nil) or (aRecord.fID<=0) then
    result := false else
    result := SetCache(PSQLRecordClass(aRecord)^,aRecord.fID);
end;

procedure TSQLRestCache.Clear;
var i: PtrInt;
begin
  if self<>nil then
  for i := 0 to length(fCache)-1 do
    fCache[i].Clear;
end;

function TSQLRestCache.FillFromQuery(aTable: TSQLRecordClass; const FormatSQLWhere: RawUTF8;
  const BoundsSQLWhere: array of const): integer;
var rec: TSQLRecord;
    cache: ^TSQLRestCacheEntry;
begin
  result := 0;
  if self=nil then
    exit;
  cache := @fCache[fRest.Model.GetTableIndexExisting(aTable)];
  if not cache^.CacheEnable then
    exit;
  rec := aTable.CreateAndFillPrepare(fRest,FormatSQLWhere,BoundsSQLWhere);
  try
    while rec.FillOne do begin
      cache^.SetJSON(rec);
      inc(result);
    end;
  finally
    rec.Free;
  end;
end;

procedure TSQLRestCache.Flush;
var i: PtrInt;
begin
  if self<>nil then
  for i := 0 to length(fCache)-1 do
    fCache[i].FlushCacheAllEntries; // include *CriticalSection(Mutex)
end;

procedure TSQLRestCache.Flush(aTable: TSQLRecordClass);
begin
  if self<>nil then // includes *CriticalSection(Mutex):
    fCache[fRest.Model.GetTableIndexExisting(aTable)].FlushCacheAllEntries;
end;

procedure TSQLRestCache.Flush(aTable: TSQLRecordClass; aID: TID);
begin
  if self<>nil then
    with fCache[fRest.Model.GetTableIndexExisting(aTable)] do
    if CacheEnable then begin
      Mutex.Lock;
      try
        FlushCacheEntry(Value.Find(aID));
      finally
        Mutex.UnLock;
      end;
    end;
end;

procedure TSQLRestCache.Flush(aTable: TSQLRecordClass; const aIDs: array of TID);
var i: PtrInt;
begin
  if (self<>nil) and (length(aIDs)>0) then
    with fCache[fRest.Model.GetTableIndexExisting(aTable)] do
    if CacheEnable then begin
      Mutex.Lock;
      try
        for i := 0 to high(aIDs) do
          FlushCacheEntry(Value.Find(aIDs[i]));
      finally
        Mutex.UnLock;
      end;
    end;
end;

procedure TSQLRestCache.Notify(aTable: TSQLRecordClass; aID: TID;
  const aJSON: RawUTF8; aAction: TSQLOccasion);
begin
  if (self<>nil) and (aTable<>nil) and (aID>0) then
    Notify(fRest.Model.GetTableIndex(aTable),aID,aJSON,aAction);
end;

procedure TSQLRestCache.Notify(aRecord: TSQLRecord; aAction: TSQLOccasion);
var aTableIndex: cardinal;
begin
  if (self=nil) or (aRecord=nil) or (aRecord.fID<=0) or
     not (aAction in [soInsert,soUpdate]) then
    exit;
  aTableIndex := fRest.Model.GetTableIndex(PSQLRecordClass(aRecord)^);
  if aTableIndex<Cardinal(Length(fCache)) then
    with fCache[aTableIndex] do
      if CacheEnable then
        SetJSON(aRecord);
end;

procedure TSQLRestCache.Notify(aTableIndex: integer; aID: TID;
  const aJSON: RawUTF8; aAction: TSQLOccasion);
begin
  if (self<>nil) and (aID>0) and (aAction in [soSelect,soInsert,soUpdate]) and
     (aJSON<>'') and (Cardinal(aTableIndex)<Cardinal(Length(fCache))) then
    with fCache[aTableIndex] do
      if CacheEnable then
        SetJSON(aID,aJSON);
end;

procedure TSQLRestCache.NotifyDeletion(aTableIndex: integer; aID: TID);
begin
  if (self<>nil) and (aID>0) and
     (Cardinal(aTableIndex)<Cardinal(Length(fCache))) then
    with fCache[aTableIndex] do
    if CacheEnable then begin
      Mutex.Lock;
      try
        FlushCacheEntry(Value.Find(aID));
      finally
        Mutex.UnLock;
      end;
    end;
end;

procedure TSQLRestCache.NotifyDeletions(aTableIndex: integer; const aIDs: array of Int64);
var i: PtrInt;
begin
  if (self<>nil) and (high(aIDs)>=0) and
     (Cardinal(aTableIndex)<Cardinal(Length(fCache))) then
    with fCache[aTableIndex] do
    if CacheEnable then begin
      Mutex.Lock;
      try
        for i := 0 to high(aIDs) do
          FlushCacheEntry(Value.Find(aIDs[i]));
      finally
        Mutex.UnLock;
      end;
    end;
end;

procedure TSQLRestCache.NotifyDeletion(aTable: TSQLRecordClass; aID: TID);
begin
  if (self<>nil) and (aTable<>nil) and (aID>0) then
    NotifyDeletion(fRest.Model.GetTableIndex(aTable),aID);
end;

function TSQLRestCache.Retrieve(aID: TID; aValue: TSQLRecord): boolean;
var TableIndex: cardinal;
begin
  result := false;
  if (self=nil) or (aValue=nil) or (aID<=0) then
    exit;
  TableIndex := fRest.Model.GetTableIndexExisting(PSQLRecordClass(aValue)^);
  if TableIndex<cardinal(Length(fCache)) then
    with fCache[TableIndex] do
      if CacheEnable and RetrieveJSON(aID,aValue) then
        result := true;
end;

function TSQLRestCache.Retrieve(aTableIndex: integer; aID: TID): RawUTF8;
begin
  result := '';
  if (self<>nil) and (aID>0) and
     (Cardinal(aTableIndex)<Cardinal(Length(fCache))) then
    with fCache[aTableIndex] do
      if CacheEnable then
        RetrieveJSON(aID,result);
end;


{ TSQLRestThread }

constructor TSQLRestThread.Create(aRest: TSQLRest;
  aOwnRest, aCreateSuspended: boolean);
begin
  if aRest=nil then
    raise EORMException.CreateUTF8('%.Create(aRest=nil)',[self]);
  fSafe.Init;
  fRest := aRest;
  fOwnRest := aOwnRest;
  if fThreadName='' then
    FormatUTF8('% %',[self,fRest.Model.Root],fThreadName);
  fEvent := TEvent.Create(nil,false,false,'');
  inherited Create(aCreateSuspended);
end;

procedure TSQLRestThread.WaitForNotExecuting(maxMS: integer);
var endtix: Int64;
begin
  if fExecuting then begin
    endtix := SynCommons.GetTickCount64+maxMS;
    repeat
      SleepHiRes(1); // wait for InternalExecute to finish
    until not fExecuting or (SynCommons.GetTickCount64>=endtix);
  end;
end;

destructor TSQLRestThread.Destroy;
begin
  if fExecuting then begin
    Terminate; // will notify Execute that the process is finished
    WaitForNotExecuting;
  end;
  inherited Destroy;
  if fOwnRest and (fRest<>nil) then begin
    {$ifdef WITHLOG}
    if GetCurrentThreadId=ThreadID then begin
      fRest.fLogFamily := nil; // no log after fRest.EndCurrentThread(self)
      fRest.fLogClass := nil;
    end;
    {$endif}
    FreeAndNil(fRest);
  end;
  fSafe.Done;
  fEvent.Free;
end;

function TSQLRestThread.SleepOrTerminated(MS: integer): boolean;
var endtix: Int64;
begin
  result := true; // notify Terminated
  if (self = nil) or Terminated then
    exit;
  endtix := SynCommons.GetTickCount64+MS;
  repeat
    FixedWaitFor(fEvent,MS);
    if Terminated then
      exit;
  until (MS<32) or (SynCommons.GetTickCount64>=endtix);
  result := false; // normal delay expiration
end;

procedure TSQLRestThread.Execute;
begin
  {$ifdef WITHLOG}
  fLog := fRest.LogClass.Add;
  {$endif}
  SetCurrentThreadName('%',[fThreadName]);
  fRest.BeginCurrentThread(self);
  try
    fExecuting := true;
    try
      InternalExecute;
    except
      on E: Exception do
        {$ifdef WITHLOG}
        fLog.Add.Log(sllError,'Unhandled % in %.Execute -> abort',[E,ClassType],self);
        {$endif}
    end;
  finally
    fRest.EndCurrentThread(self);
    fLog := nil; // no log after EndCurrentThread
    fExecuting := false;
  end;
end;

{$ifndef HASTTHREADSTART}
procedure TSQLRestThread.Start;
begin
  Resume;
end;
{$endif}

{$ifndef HASTTHREADTERMINATESET}
procedure TSQLRestThread.Terminate;
begin
  inherited Terminate; // FTerminated := True
  TerminatedSet;
end;
{$endif}

procedure TSQLRestThread.TerminatedSet;
begin
  fEvent.SetEvent;
end;


{ TSQLRestURIParams }

procedure TSQLRestURIParams.Init;
begin
  OutStatus := 0;
  OutInternalState := 0;
  RestAccessRights := nil;
  LowLevelConnectionID := 0;
  byte(LowLevelFlags) := 0;
end;

procedure TSQLRestURIParams.Init(const aURI,aMethod,aInHead,aInBody: RawUTF8);
begin
  Init;
  Url := aURI;
  Method := aMethod;
  InHead := aInHead;
  InBody := aInBody;
end;

function TSQLRestURIParams.InBodyType(GuessJSONIfNoneSet: boolean): RawUTF8;
begin
  FindNameValue(InHead,HEADER_CONTENT_TYPE_UPPER,result);
  if GuessJSONIfNoneSet and (result='') then
    result := JSON_CONTENT_TYPE_VAR;
end;

function TSQLRestURIParams.InBodyTypeIsJson(GuessJSONIfNoneSet: boolean): boolean;
begin
  result := IdemPChar(pointer(InBodyType(GuessJSONIfNoneSet)),JSON_CONTENT_TYPE_UPPER);
end;

function TSQLRestURIParams.OutBodyType(GuessJSONIfNoneSet: boolean): RawUTF8;
begin
  FindNameValue(OutHead,HEADER_CONTENT_TYPE_UPPER,result);
  if GuessJSONIfNoneSet and (result='') then
    result := JSON_CONTENT_TYPE_VAR;
end;

function TSQLRestURIParams.OutBodyTypeIsJson(GuessJSONIfNoneSet: boolean): boolean;
begin
  result := IdemPChar(pointer(OutBodyType(GuessJSONIfNoneSet)),JSON_CONTENT_TYPE_UPPER);
end;

function TSQLRestURIParams.Header(UpperName: PAnsiChar): RawUTF8;
begin
  FindNameValue(InHead,UpperName,result);
end;

function TSQLRestURIParams.HeaderOnce(var Store: RawUTF8; UpperName: PAnsiChar): RawUTF8;
begin
  if (Store='') and (@self<>nil) then begin
    FindNameValue(InHead,UpperName,result);
    if result='' then
      Store := NULL_STR_VAR else // ensure header is parsed only once
      Store := result;
  end else
    if pointer(Store)=pointer(NULL_STR_VAR) then
      result := '' else
      result := Store;
end;


{ TSQLRestClientCallbacks }

constructor TSQLRestClientCallbacks.Create(aOwner: TSQLRestClientURI);
begin
  inherited Create;
  Owner := aOwner;
end;

function TSQLRestClientCallbacks.FindIndex(aID: integer): integer;
begin
  if self<>nil then
    for result := 0 to Count-1 do
      if List[result].ID=aID then
        exit;
  result := -1;
end;

function TSQLRestClientCallbacks.FindEntry(var aItem: TSQLRestClientCallbackItem): boolean;
var i: Integer;
    P: PSQLRestClientCallbackItem;
begin
  result := false;
  if self=nil then
    exit;
  fSafe.Lock;
  try
    P := pointer(List);
    for i := 1 to Count do
      if P^.ID=aItem.ID then begin
        if P^.Instance<>nil then begin
          result := true;
          aItem := P^;
        end;
        exit;
      end else
      inc(P);
  finally
    Safe.UnLock;
  end;
end;

function TSQLRestClientCallbacks.FindAndRelease(aID: integer): boolean;
var i: Integer;
begin
  result := false;
  if self=nil then
    exit;
  fSafe.Lock;
  try
    i := FindIndex(aID);
    if i<0 then
      exit;
    List[i].ReleasedFromServer := True;
  finally
    Safe.UnLock;
  end;
  result := true;
end;

function TSQLRestClientCallbacks.UnRegisterByIndex(index: integer): boolean;
begin
  result := false;
  if cardinal(index)>=cardinal(Count) then
    exit;
  with List[index] do
    if not ReleasedFromServer then
    try
      if Owner.FakeCallbackUnregister(Factory,ID,Instance) then
        result := true;
    except
      // ignore errors at this point, and continue
    end;
  dec(Count);
  if index<Count then
    MoveFast(List[index+1],List[index],(Count-index)*SizeOf(List[index]));
end;

function TSQLRestClientCallbacks.UnRegister(aInstance: pointer): boolean;
var i: integer;
begin
  result := false;
  if (self=nil) or (Count=0) then
    exit;
  Safe.Lock;
  try
    for i := Count-1 downto 0 do
      if List[i].Instance=aInstance then
        if UnRegisterByIndex(i) then
          result := true else
          break;
  finally
    Safe.UnLock;
  end;
end;

procedure TSQLRestClientCallbacks.DoRegister(aID: integer;
  aInstance: pointer; aFactory: TInterfaceFactory);
begin
  if aID<=0 then
    exit;
  Safe.Lock;
  try
    if length(List)>=Count then
      SetLength(List,Count+32);
    with List[Count] do begin
      ID := aID;
      Instance := aInstance;
      Factory := aFactory;
    end;
    inc(Count);
  finally
    Safe.UnLock;
  end;
end;

function TSQLRestClientCallbacks.DoRegister(aInstance: pointer;
  aFactory: TInterfaceFactory): integer;
begin
  result := InterlockedIncrement(fCurrentID);
  DoRegister(result,aInstance,aFactory);
end;



{ TSQLRestClientURI }

function TSQLRestClientURI.EngineExecute(const SQL: RawUTF8): boolean;
begin
  result := URI(Model.Root,'POST',nil,nil,@SQL).Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
end;

function TSQLRestClientURI.URIGet(Table: TSQLRecordClass; ID: TID;
  var Resp: RawUTF8; ForUpdate: boolean=false): Int64Rec;
const METHOD: array[boolean] of RawUTF8 = ('GET','LOCK');
begin
  result := URI(Model.getURIID(Table,ID),METHOD[ForUpdate],@Resp,nil,nil);
end;

function TSQLRestClientURI.UnLock(Table: TSQLRecordClass; aID: TID): boolean;
begin
  if (self=nil) or not Model.UnLock(Table,aID) then
    result := false else // was not locked by the client
    result := URI(Model.getURIID(Table,aID),'UNLOCK').Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
end;

function TSQLRestClientURI.ExecuteList(const Tables: array of TSQLRecordClass;
  const SQL: RawUTF8): TSQLTableJSON;
var Resp: RawUTF8;
begin
  if self=nil then
    result := nil else
  with URI(Model.Root,'GET',@Resp,nil,@SQL) do
    if Lo=HTTP_SUCCESS then begin // GET with SQL sent
      if high(Tables)=0 then
        result := TSQLTableJSON.CreateFromTables([Tables[0]],SQL,Resp) else
        result := TSQLTableJSON.CreateFromTables(Tables,SQL,Resp);
      result.fInternalState := Hi;
    end else // get data
    result := nil;
end;

function TSQLRestClientURI.ServerInternalState: cardinal;
begin
  if (Self=nil) or (Model=nil) then // avoid GPF
    result := cardinal(-1) else
    result := URI(Model.Root,'STATE').Hi;
end;

function TSQLRestClientURI.ServerCacheFlush(aTable: TSQLRecordClass; aID: TID): boolean;
var aResp: RawUTF8;
begin
  if (Self=nil) or (Model=nil) then // avoid GPF
    result := false else
    result := CallBackGet('CacheFlush',[],aResp,aTable,aID) in [HTTP_SUCCESS,HTTP_NOCONTENT];
end;

function TSQLRestClientURI.ServerTimestampSynchronize: boolean;
var status: integer;
    aResp: RawUTF8;
begin
  if self=nil then begin
    result := false;
    exit;
  end;
  fServerTimestampOffset := 0.0001; // avoid endless recursive call
  status := CallBackGet('Timestamp',[],aResp);
  result := (status=HTTP_SUCCESS) and (aResp<>'');
  if result then
    SetServerTimestamp(GetInt64(pointer(aResp))) else begin
    InternalLog('/Timestamp call failed -> Server not available',sllWarning);
    fLastErrorMessage := 'Server not available  - '+Trim(fLastErrorMessage);
  end;
end;

function TSQLRestClientURI.InternalRemoteLogSend(const aText: RawUTF8): boolean;
begin
  result := URI(Model.getURICallBack('RemoteLog',nil,0),
    'PUT',nil,nil,@aText).Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
end;


{$ifdef MSWINDOWS}
type
  TSQLRestClientURIServiceNotification = class(TServiceMethodExecute)
  protected
    fOwner: TSQLRestClientURI;
    fInstance: pointer; // weak IInvokable reference
    fPar: RawUTF8;
  end;

procedure TSQLRestClientURI.ServiceNotificationMethodViaMessages(hWnd: HWND; Msg: UINT);
begin
  if Msg=0 then
    hWnd := 0; // avoid half defined parameters
  fServiceNotificationMethodViaMessages.Wnd := hWnd;
  fServiceNotificationMethodViaMessages.Msg := Msg;
end;

class procedure TSQLRestClientURI.ServiceNotificationMethodExecute(var Msg : TMessage);
var exec: TSQLRestClientURIServiceNotification;
begin
  exec := pointer(Msg.LParam);
  if exec<>nil then
  try
    try
      if exec.InheritsFrom(TSQLRestClientURIServiceNotification) and
         (HWND(Msg.WParam)=exec.fOwner.fServiceNotificationMethodViaMessages.Wnd) then
        // run asynchronous notification callback in the main UI thread context
        exec.ExecuteJson([exec.fInstance],pointer(exec.fPar),nil);
    finally
      exec.Free; // always release notification resources
    end;
  except
    ; // ignore any exception for this asynchronous callback execution
  end;
end;
{$endif MSWINDOWS}

type
  TServiceInternalMethod = (imFree, imContract, imSignature, imInstance);

const
  SERVICE_PSEUDO_METHOD: array[TServiceInternalMethod] of RawUTF8 = (
    '_free_','_contract_','_signature_','_instance_');
  SERVICE_PSEUDO_METHOD_COUNT = Length(SERVICE_PSEUDO_METHOD);

procedure TSQLRestClientURI.InternalNotificationMethodExecute(
  var Ctxt: TSQLRestURIParams);
var url,root,interfmethod,interf,id,method,frames: RawUTF8;
    callback: TSQLRestClientCallbackItem;
    methodIndex: integer;
    WR: TTextWriter;
    temp: TTextWriterStackBuffer;
    ok: Boolean;
  procedure Call(methodIndex: Integer; const par: RawUTF8; res: TTextWriter);
  var method: PServiceMethod;
      exec: TServiceMethodExecute;
  begin
    method := @callback.Factory.Methods[methodIndex];
    {$ifdef MSWINDOWS}
    if (fServiceNotificationMethodViaMessages.Wnd<>0) and
       (method^.ArgsOutputValuesCount=0) then begin
      // expects no output -> asynchronous non blocking notification in UI thread
      Ctxt.OutStatus := 0;
      exec := TSQLRestClientURIServiceNotification.Create(method);
      TSQLRestClientURIServiceNotification(exec).fOwner := self;
      TSQLRestClientURIServiceNotification(exec).fInstance := callback.Instance;
      TSQLRestClientURIServiceNotification(exec).fPar := par;
      with fServiceNotificationMethodViaMessages do
        ok := PostMessage(Wnd,Msg,Wnd,LPARAM(exec));
      if ok then
        exit;
    end else // if PostMessage() failed (e.g. invalid Wnd/Msg) -> blocking exec
    {$endif}
      exec := TServiceMethodExecute.Create(method);
    try
      ok := exec.ExecuteJson([callback.Instance],pointer(par),res);
      Ctxt.OutHead := exec.ServiceCustomAnswerHead;
      Ctxt.OutStatus := exec.ServiceCustomAnswerStatus;
    finally
      exec.Free;
    end;
  end;
begin
  Ctxt.OutStatus := HTTP_BADREQUEST;
  url := Ctxt.Url;
  if (url='') or (isDestroying in fInternalState) then
    exit;
  if url[1]='/' then
    system.delete(url,1,1);
  Split(Split(url,'/',root),'/',interfmethod,id); // 'root/BidirCallback.AsynchEvent/1'
  if not IdemPropNameU(root,Model.Root) then
    exit;
  callback.ID := GetInteger(pointer(id));
  if callback.ID<=0 then
    exit;
  if interfmethod=SERVICE_PSEUDO_METHOD[imFree] then begin
    if fFakeCallbacks.FindAndRelease(callback.ID) then
      Ctxt.OutStatus := HTTP_SUCCESS;
    exit;
  end;
  if not fFakeCallbacks.FindEntry(callback) then
    exit;
  if (Ctxt.InHead<>'') and
     (callback.Factory.MethodIndexCurrentFrameCallback>=0) then begin
    FindNameValue(Ctxt.InHead,'SEC-WEBSOCKET-FRAME: ',frames);
  end;
  Split(interfmethod,'.',interf,method);
  methodIndex := callback.Factory.FindMethodIndex(method);
  if methodIndex<0 then
    exit;
  if IdemPropNameU(interfmethod,callback.Factory.Methods[methodIndex].InterfaceDotMethodName) then
  try
    WR := TJSONSerializer.CreateOwnedStream(temp);
    try
      WR.AddShort('{"result":[');
      if frames='[0]' then // call before the first method of the jumbo frame
        Call(callback.Factory.MethodIndexCurrentFrameCallback,frames,nil);
      Call(methodIndex,Ctxt.InBody,WR);
      if ok then begin
        if Ctxt.OutHead='' then begin // <>'' if set via TServiceCustomAnswer
          WR.Add(']','}');
          Ctxt.OutStatus := HTTP_SUCCESS;
        end;
        Ctxt.OutBody := WR.Text;
      end else
        Ctxt.OutStatus := HTTP_SERVERERROR;
      if frames='[1]' then // call after the last method of the jumbo frame
        Call(callback.Factory.MethodIndexCurrentFrameCallback,frames,nil);
    finally
      WR.Free;
    end;
  except
    on E: Exception do begin
      Ctxt.OutHead := '';
      Ctxt.OutBody := ObjectToJSONDebug(E);
      Ctxt.OutStatus := HTTP_SERVERERROR;
    end;
  end;
end;

{$ifdef LVCL} // SyncObjs.TEvent not available in LVCL yet

function TSQLRestClientURI.ServerRemoteLog(Sender: TTextWriter; Level: TSynLogInfo;
  const Text: RawUTF8): boolean;
begin
  result := InternalRemoteLogSend(Text);
end;

{$else}

type
  TRemoteLogThread = class(TSQLRestThread)
  protected
    fClient: TSQLRestClientURI;
    fPendingRows: RawUTF8;
    procedure InternalExecute; override;
  public
    constructor Create(aClient: TSQLRestClientURI); reintroduce;
    destructor Destroy; override;
    procedure AddRow(const aText: RawUTF8);
  end;

constructor TRemoteLogThread.Create(aClient: TSQLRestClientURI);
begin
  fClient := aClient;
  inherited Create(aClient,false,false);
end;

destructor TRemoteLogThread.Destroy;
var i: integer;
begin
  if fPendingRows<>'' then begin
    fEvent.SetEvent;
    for i := 1 to 200 do begin
      SleepHiRes(10);
      if fPendingRows='' then
        break;
    end;
  end;
  inherited Destroy;
end;

procedure TRemoteLogThread.AddRow(const aText: RawUTF8);
begin
  fSafe.Lock;
  try
    AddToCSV(aText,fPendingRows,#13#10);
  finally
    fSafe.UnLock;
  end;
  fEvent.SetEvent;
end;

procedure TRemoteLogThread.InternalExecute;
var aText: RawUTF8;
begin
  while not Terminated do
    if FixedWaitFor(fEvent,INFINITE)=wrSignaled then begin
      if Terminated then
        break;
      fSafe.Lock;
      try
        aText := fPendingRows;
        fPendingRows := '';
      finally
        fSafe.UnLock;
      end;
      if (aText<>'') and not Terminated then
      try
        while not fClient.InternalRemoteLogSend(aText) do
          if SleepOrTerminated(2000) then // retry after 2 seconds delay
            exit;
      except
        on E: Exception do
          if (fClient<>nil) and not Terminated then
            fClient.InternalLog('%.Execute fatal error: %'+
              'some events were not transmitted',[ClassType,E],sllWarning);
      end;
    end;
end;

function TSQLRestClientURI.ServerRemoteLog(Sender: TTextWriter; Level: TSynLogInfo;
  const Text: RawUTF8): boolean;
begin
  if fRemoteLogThread=nil then
    result := InternalRemoteLogSend(Text) else begin
    TRemoteLogThread(fRemoteLogThread).AddRow(Text);
    result := true;
  end;
end;

{$endif LVCL}

function TSQLRestClientURI.ServerRemoteLog(Level: TSynLogInfo;
  FormatMsg: PUTF8Char; const Args: array of const): boolean;
begin
  result := ServerRemoteLog(nil,Level,
    FormatUTF8('%00%    %',[NowToString(false),LOG_LEVEL_TEXT[Level],
      FormatUTF8(FormatMsg,Args)]));
end;

procedure TSQLRestClientURI.ServerRemoteLogStart(aLogClass: TSynLogClass;
  aClientOwnedByFamily: boolean);
begin
  if (fRemoteLogClass<>nil) or (aLogClass=nil) then
    exit;
  {$ifdef WITHLOG}
  SetLogClass(TSynLog.Void); // this client won't log anything
  {$endif}
  if not ServerRemoteLog(sllClient,'Remote Client % Connected',[self]) then
    // first test server without threading
    raise ECommunicationException.CreateUTF8(
      'Connection to RemoteLog server impossible'#13#10'%',[LastErrorMessage]);
  {$ifndef LVCL}
  if fRemoteLogThread<>nil then
    raise ECommunicationException.CreateUTF8('%.ServerRemoteLogStart twice',[self]);
  fRemoteLogThread := TRemoteLogThread.Create(self);
  {$endif}
  fRemoteLogClass := aLogClass.Add;
  aLogClass.Family.EchoRemoteStart(self,ServerRemoteLog,aClientOwnedByFamily);
  fRemoteLogOwnedByFamily := aClientOwnedByFamily;
end;

procedure TSQLRestClientURI.ServerRemoteLogStop;
begin
  if fRemoteLogClass=nil then
    exit;
  if not fRemoteLogOwnedByFamily then begin
    fRemoteLogClass.Log(sllTrace,'End Echoing to remote server');
    fRemoteLogClass.Family.EchoRemoteStop;
  end;
  fRemoteLogClass := nil;
end;

function TSQLRestClientURI.UpdateFromServer(const Data: array of TObject; out Refreshed: boolean;
  PCurrentRow: PInteger): boolean;
// notes about refresh mechanism:
// - if server doesn't implement InternalState, its value is 0 -> always refresh
// - if any TSQLTableJSON or TSQLRecord belongs to a TSQLRestStorage,
// the Server stated fInternalState=cardinal(-1) for them -> always refresh
var i: integer;
    State: cardinal;
    Resp: RawUTF8;
    T: TSQLTableJSON;
    TRefreshed: boolean; // to check for each Table refresh
const TState: array[boolean] of TOnTableUpdateState = (tusNoChange,tusChanged);
begin
  result := self<>nil;
  Refreshed := false;
  if not result then
    exit; // avoid GPF
  State := ServerInternalState; // get revision state from server
  for i := 0 to high(Data) do
    if Data[i]<>nil then
    if TObject(Data[i]).InheritsFrom(TSQLTableJSON) then begin
      T := TSQLTableJSON((Data[i]));
      if (T.QuerySQL<>'') and (T.InternalState<>State) then begin // refresh needed?
        with URI(Model.Root,'GET',@Resp,nil,@T.QuerySQL) do
          if Lo=HTTP_SUCCESS then begin // GET with SQL sent
            if Assigned(OnTableUpdate) then
              OnTableUpdate(T,tusPrepare);
            TRefreshed := false;
            if not T.UpdateFrom(Resp,TRefreshed,PCurrentRow) then
              result := false else // mark error retrieving new content
              T.fInternalState := Hi;
            if TRefreshed then
              Refreshed := true;
            if Assigned(OnTableUpdate) then
              OnTableUpdate(T,TState[TRefreshed]);
          end
          else result := false; // mark error retrieving new content
        end;
    end else
    if TObject(Data[i]).InheritsFrom(TSQLRecord) then
    with TSQLRecord(Data[i]) do
      if (fID<>0) and (InternalState<>State) then begin // refresh needed?
        if not Refresh(fID,TSQLRecord(Data[i]),Refreshed) then
          result := false; // mark error retrieving new content
      end;
end;

function TSQLRestClientURI.List(const Tables: array of TSQLRecordClass;
  const SQLSelect: RawUTF8; const SQLWhere: RawUTF8): TSQLTableJSON;
var Resp, SQL: RawUTF8;
    U: RawUTF8;
    InternalState: cardinal;
begin
  result := nil;
  if high(Tables)<0 then exit;
  // GET Collection
  SQL := Model.SQLFromSelectWhere(Tables,SQLSelect,SQLWhere);
  if high(Tables)=0 then begin
    // one Table -> use REST protocol (SQL as parameters)
    if not IsRowID(pointer(SQLSelect)) then
      // ID selected by default
      U := '?select='+UrlEncode(SQLSelect) else
      U := '';
    if SQLWhere<>'' then begin
      if U<>'' then
        U := U+'&where=' else
        U := U+'?where=';
      U := U+UrlEncode(SQLWhere);
    end;
    with URI(Model.URI[TSQLRecordClass(Tables[0])]+U,'GET',@Resp) do
      if Lo<>HTTP_SUCCESS then
        exit else
        InternalState := Hi;
    result := TSQLTableJSON.CreateFromTables([Tables[0]],SQL,Resp); // get data
  end else begin
    // multiple tables -> send SQL statement as HTTP body
    with URI(Model.Root,'GET',@Resp,nil,@SQL) do
      if Lo<>HTTP_SUCCESS then
        exit else
        InternalState := Hi;
    result := TSQLTableJSON.CreateFromTables(Tables,SQL,Resp); // get data
  end;
  result.fInternalState := InternalState;
end;

procedure TSQLRestClientURI.SessionRenewEvent(Sender: TSynBackgroundTimer;
  Event: TWaitResult; const Msg: RawUTF8);
var resp: RawUTF8;
     status: integer;
begin
  status := CallBack(mPOST,'CacheFlush/_ping_','',resp);
  InternalLog('SessionRenewEvent(%) received status=% count=% from % % (timeout=% min)',
    [Model.Root,status,JSONDecode(resp,'count'),
     SessionServer,SessionVersion,fSessionServerTimeout],sllUserAuth);
end;

procedure TSQLRestClientURI.SetSessionHeartbeatSeconds(timeout: integer);
begin
  if (timeout<0) or (timeout=fSessionHeartbeatSeconds) then
    exit;
  fSessionHeartbeatSeconds := timeout;
  TimerEnable(SessionRenewEvent,timeout);
end;

function TSQLRestClientURI.SessionCreate(aAuth: TSQLRestServerAuthenticationClass;
  var aUser: TSQLAuthUser; const aSessionKey: RawUTF8): boolean;
var period: integer;
begin
  result := false;
  fSessionID := GetCardinal(pointer(aSessionKey));
  if fSessionID=0 then
    exit;
  fSessionIDHexa8 := CardinalToHexLower(fSessionID);
  fSessionPrivateKey := crc32(crc32(0,Pointer(aSessionKey),length(aSessionKey)),
    pointer(aUser.PasswordHashHexa),length(aUser.PasswordHashHexa));
  fSessionUser := aUser;
  fSessionAuthentication := aAuth;
  aUser := nil; // now owned by this instance
  if fSessionServerTimeout>0 then begin // call _ping_ every half timeout period
    period := fSessionServerTimeout*(60 div 2);
    if period>25*60 then
      period := 25*60; // default REST heartbeat at least every 25 minutes
    SetSessionHeartbeatSeconds(period);
  end;
  result := true;
end;

procedure TSQLRestClientURI.SessionClose;
var tmp: RawUTF8;
begin
  if (self<>nil) and (fSessionUser<>nil) and
     (fSessionID<>CONST_AUTHENTICATION_SESSION_NOT_STARTED) then
  try
    TimerDisable(SessionRenewEvent);
    InternalLog('SessionClose: notify server', sllTrace);
    CallBackGet('Auth',['UserName',fSessionUser.LogonName,'Session',fSessionID],tmp);
  finally
    fSessionID := CONST_AUTHENTICATION_SESSION_NOT_STARTED;
    fSessionIDHexa8 := '';
    fSessionPrivateKey := 0;
    fSessionAuthentication := nil;
    fSessionServer := '';
    fSessionVersion := '';
    FillZero(fSessionData);
    fSessionData := '';
    fSessionServerTimeout := 0;
    FreeAndNil(fSessionUser);
    fComputeSignature := TSQLRestServerAuthenticationSignedURI.ComputeSignatureCrc32;
  end;
end;

function TSQLRestClientURI.GetCurrentSessionUserID: TID;
begin
  if fSessionUser=nil then
    result := 0 else
    result := fSessionUser.IDValue;
end;

function TSQLRestClientURI.GetSessionVersion: RawUTF8;
var resp: RawUTF8;
begin
  if self = nil then
    result := '' else begin
    if fSessionVersion = '' then // no session (e.g. API public URI) -> ask
      if CallBackGet('timestamp/info', [], resp) = HTTP_SUCCESS then
        fSessionVersion := JSONDecode(resp, 'version');
    result := fSessionVersion;
  end;
end;

constructor TSQLRestClientURI.Create(aModel: TSQLModel);
begin
  inherited Create(aModel);
  fMaximumAuthentificationRetry := 1;
  fComputeSignature := TSQLRestServerAuthenticationSignedURI.ComputeSignatureCrc32;
  fSessionID := CONST_AUTHENTICATION_NOT_USED;
  fFakeCallbacks := TSQLRestClientCallbacks.Create(self);
  {$ifdef USELOCKERDEBUG}
  fSafe := TAutoLockerDebug.Create(fLogClass,aModel.Root); // more verbose
  {$else}
  fSafe := TAutoLocker.Create;
  {$endif}
end;

destructor TSQLRestClientURI.Destroy;
var t,i: integer;
    aID: TID;
    Table: TSQLRecordClass;
begin
  include(fInternalState,isDestroying);
  {$ifdef MSWINDOWS}
  fServiceNotificationMethodViaMessages.Wnd := 0; // disable notification
  {$endif}
  {$ifdef WITHLOG}
  if GarbageCollectorFreeing then // may be owned by a TSynLogFamily
    SetLogClass(nil);
  {$endif}
  fBatchCurrent.Free;
  FreeAndNil(fFakeCallbacks);
  try
    // unlock all still locked records by this client
    if Model<>nil then
    for t := 0 to high(Model.Locks) do begin
      Table := Model.Tables[t];
      with Model.Locks[t] do
      for i := 0 to Count-1 do begin
        aID := IDs[i];
        if aID<>0 then // 0 is empty after unlock
          self.UnLock(Table,aID);
      end;
    end;
    SessionClose; // if not already notified
  finally
    // release memory and associated classes
    if fRemoteLogClass<>nil then begin
      {$ifndef LVCL}
      FreeAndNil(fRemoteLogThread);
      {$endif}
      ServerRemoteLogStop;
    end;
    fSessionUser.Free;
    try
      inherited Destroy; // fModel.Free if owned by this TSQLRest instance
      {$ifndef LVCL}
      FreeAndNil(fBackgroundThread); // should be done after fServices.Free
      fOnIdle := nil;
      {$endif}
    finally
      InternalClose;
    end;
  end;
end;

{$ifdef DOMAINAUTH}
const
  SSPI_DEFINITION_USERNAME = '***SSPI***';
{$endif DOMAINAUTH}

constructor TSQLRestClientURI.RegisteredClassCreateFrom(aModel: TSQLModel;
  aDefinition: TSynConnectionDefinition);
begin
  if fModel=nil then // if not already created with a reintroduced constructor
    Create(aModel);
  if fModel<>nil then
    fOnIdle := fModel.OnClientIdle; // allow UI interactivity during SetUser()
  if aDefinition.User<>'' then begin
    {$ifdef DOMAINAUTH}
    if aDefinition.User=SSPI_DEFINITION_USERNAME then
      SetUser('',aDefinition.PasswordPlain) else
    {$endif DOMAINAUTH}
      SetUser(aDefinition.User,aDefinition.PasswordPlain,true);
  end;
end;

procedure TSQLRestClientURI.DefinitionTo(Definition: TSynConnectionDefinition);
begin
  if Definition=nil then
    exit;
  inherited DefinitionTo(Definition); // save Kind
  if (fSessionAuthentication<>nil) and (fSessionUser<>nil) then begin
    {$ifdef DOMAINAUTH}
    if fSessionAuthentication.InheritsFrom(TSQLRestServerAuthenticationSSPI) then
      Definition.User := SSPI_DEFINITION_USERNAME else
    {$endif DOMAINAUTH}
       Definition.User := fSessionUser.LogonName;
     Definition.PasswordPlain := fSessionUser.fPasswordHashHexa;
  end;
end;

procedure TSQLRestClientURI.Commit(SessionID: cardinal; RaiseException: boolean);
begin
  inherited Commit(CONST_AUTHENTICATION_NOT_USED,RaiseException);
  // inherited Commit = reset fTransactionActiveSession flag
  URI(Model.Root,'END');
end;

procedure TSQLRestClientURI.RollBack(SessionID: cardinal);
begin
  inherited RollBack(CONST_AUTHENTICATION_NOT_USED); // reset fTransactionActiveSession flag
  URI(Model.Root,'ABORT');
end;

function TSQLRestClientURI.TransactionBegin(aTable: TSQLRecordClass;
  SessionID: cardinal): boolean;
begin
  result := inherited TransactionBegin(aTable,CONST_AUTHENTICATION_NOT_USED);
  if result then
    // fTransactionActiveSession flag was not already set
    if aTable=nil then
      result := URI(Model.Root,'BEGIN').Lo in [HTTP_SUCCESS,HTTP_NOCONTENT] else
      result := URI(Model.URI[aTable],'BEGIN').Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
end;

function TSQLRestClientURI.TransactionBeginRetry(aTable: TSQLRecordClass;
  Retries: integer): boolean;
begin
  if Retries>50 then
    Retries := 50; // avoid loop for more than 10 seconds
  repeat
    result := TransactionBegin(aTable);
    if result then
      exit;
    dec(Retries);
    if Retries<=0 then break;
    SleepHiRes(100);
  until false;
end;

const
  // log up to 2 KB of JSON response, to save space
  MAX_SIZE_RESPONSE_LOG = 2*1024;

function TSQLRestClientURI.CallBackGet(const aMethodName: RawUTF8;
  const aNameValueParameters: array of const; out aResponse: RawUTF8;
  aTable: TSQLRecordClass; aID: TID; aResponseHead: PRawUTF8): integer;
var url, header: RawUTF8;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  if self=nil then
    result := HTTP_UNAVAILABLE else begin
    url := Model.getURICallBack(aMethodName,aTable,aID);
    if high(aNameValueParameters)>0 then
      url := url+UrlEncode(aNameValueParameters);
    {$ifdef WITHLOG}
    log := fLogClass.Enter('CallBackGet %',[url],self);
    {$endif}
    result := URI(url,'GET',@aResponse,@header).Lo;
    if aResponseHead<>nil then
      aResponseHead^ := header;
    {$ifdef WITHLOG}
    if (log<>nil) and (aResponse<>'') and (sllServiceReturn in fLogFamily.Level) then
      if IsHTMLContentTypeTextual(pointer(header)) then
        log.Log(sllServiceReturn,aResponse,self,MAX_SIZE_RESPONSE_LOG) else
        log.Log(sllServiceReturn,'% bytes [%]',[length(aResponse),header],self);
    {$endif}
  end;
end;

function TSQLRestClientURI.SetUser(const aUserName, aPassword: RawUTF8;
  aHashedPassword: Boolean): boolean;
const HASH: array[boolean] of TSQLRestServerAuthenticationClientSetUserPassword =
  (passClear, passHashed);
begin
  if self=nil then begin
    result := false;
    exit;
  end;
  {$ifdef DOMAINAUTH} // try Windows/GSSAPI authentication with the current logged user
  result := true;
  if (IsVoid(aUserName) or (PosExChar({$ifdef GSSAPIAUTH}'@'{$else}'\'{$endif},aUserName)>0)) and
    TSQLRestServerAuthenticationSSPI.ClientSetUser(self,aUserName,aPassword,passKerberosSPN) then
      exit;
  {$endif DOMAINAUTH}
  result := TSQLRestServerAuthenticationDefault.
    ClientSetUser(self,aUserName,aPassword,HASH[aHashedPassword]);
end;

procedure TSQLRestClientURI.SetLastException(E: Exception; ErrorCode: integer;
  Call: PSQLRestURIParams);
begin
  fLastErrorCode := ErrorCode;
  if E=nil then begin
    fLastErrorException := nil;
    if StatusCodeIsSuccess(ErrorCode) then
      fLastErrorMessage := '' else
      StatusCodeToErrorMessage(ErrorCode,fLastErrorMessage);
  end else begin
    fLastErrorException := PPointer(E)^;
    fLastErrorMessage := ObjectToJSONDebug(E);
  end;
  if Assigned(fOnFailed) then
    fOnFailed(self,E,Call);
end;

{$ifndef LVCL} // SyncObjs.TEvent not available in LVCL yet

procedure TSQLRestClientURI.OnBackgroundProcess(Sender: TSynBackgroundThreadEvent;
  ProcessOpaqueParam: pointer);
var Call: ^TSQLRestURIParams absolute ProcessOpaqueParam;
begin
  if Call=nil then
    exit;
  InternalURI(Call^);
  if ((Sender=nil) or OnIdleBackgroundThreadActive) and
      not(isDestroying in fInternalState) then
    if (Call^.OutStatus=HTTP_NOTIMPLEMENTED) and (isOpened in fInternalState) then begin
      InternalClose; // force recreate connection
      Exclude(fInternalState,isOpened);
      if ((Sender=nil) or OnIdleBackgroundThreadActive) then begin
        InternalURI(Call^); // try request again
        if Call^.OutStatus<>HTTP_NOTIMPLEMENTED then
          Include(fInternalState,isOpened);
      end;
    end else
      Include(fInternalState,isOpened);
end;

function TSQLRestClientURI.GetOnIdleBackgroundThreadActive: boolean;
begin
  result := (self<>nil) and Assigned(fOnIdle) and
    fBackgroundThread.OnIdleBackgroundThreadActive;
end;

{$endif LVCL}

function TSQLRestClientURI.FakeCallbackRegister(Sender: TServiceFactoryClient;
  const Method: TServiceMethod; const ParamInfo: TServiceMethodArgument;
  ParamValue: Pointer): integer;
begin
  raise EServiceException.CreateUTF8('% does not support interface parameters '+
    'for %.%(%: %): consider using another kind of client',
    [self,Sender.fInterface.fInterfaceName,Method.URI,
     ParamInfo.ParamName^,ParamInfo.ArgTypeName^]);
end;

function TSQLRestClientURI.FakeCallbackUnregister(Factory: TInterfaceFactory;
  FakeCallbackID: integer; Instance: pointer): boolean;
begin
  raise EServiceException.CreateUTF8(
    '% does not support % callbacks: consider using another kind of client',
    [self,Factory.fInterfaceTypeInfo^.Name]);
end;

function TSQLRestClientURI.URI(const url, method: RawUTF8; Resp: PRawUTF8;
  Head: PRawUTF8; SendData: PRawUTF8): Int64Rec;
var retry: Integer;
    aUserName, aPassword: string;
    StatusMsg: RawUTF8;
    Call: TSQLRestURIParams;
    aPasswordHashed: Boolean;

  procedure CallInternalURI;
  begin
    Call.Url := url; // reset to allow proper re-sign
    if fSessionAuthentication<>nil then
      fSessionAuthentication.ClientSessionSign(Self,Call);
    Call.Method := method;
    if SendData<>nil then
      Call.InBody := SendData^;
    if Assigned(fOnEncryptBody) then
      fOnEncryptBody(self,Call.InBody,Call.InHead,Call.Url);
    {$ifndef LVCL}
    if Assigned(fOnIdle) then begin
      if fBackgroundThread=nil then
        fBackgroundThread := TSynBackgroundThreadEvent.Create(OnBackgroundProcess,
          OnIdle,FormatUTF8('% % background',[Self,Model.Root]));
      if not fBackgroundThread.RunAndWait(@Call) then
        Call.OutStatus := HTTP_UNAVAILABLE;
    end else
    {$endif}
      OnBackgroundProcess({SenderThread=}nil,@Call);
    if Assigned(fOnDecryptBody) then
      fOnDecryptBody(self,Call.OutBody,Call.OutHead,Call.Url);
    result.Lo := Call.OutStatus;
    result.Hi := Call.OutInternalState;
    if Head<>nil then
      Head^ := Call.OutHead;
    if Resp<>nil then
      Resp^ := Call.OutBody;
    fLastErrorCode := Call.OutStatus;
  end;

begin
  if Self=nil then begin
    Int64(result) := HTTP_UNAVAILABLE;
    SetLastException(nil,HTTP_UNAVAILABLE);
    exit;
  end;
  fLastErrorMessage := '';
  fLastErrorException := nil;
  if fServerTimestampOffset=0 then begin
    if not ServerTimestampSynchronize then begin
      Int64(result) := HTTP_UNAVAILABLE;
      exit; // if Timestamp is not available,server is down!
    end;
  end;
  Call.Init;
  if (Head<>nil) and (Head^<>'') then
    Call.InHead := Head^;
  if fSessionHttpHeader<>'' then
    Call.InHead := Trim(Call.InHead + #13#10 + fSessionHttpHeader);
  try
    CallInternalURI;
    if (Call.OutStatus=HTTP_TIMEOUT) and RetryOnceOnTimeout then begin
      InternalLog('% % returned "408 Request Timeout" -> RETRY',[method,url],sllError);
      CallInternalURI;
    end else
    if (Call.OutStatus=HTTP_FORBIDDEN) and (MaximumAuthentificationRetry>0) and
       Assigned(OnAuthentificationFailed) and not(isInAuth in fInternalState) then
      try
        Include(fInternalState,isInAuth);
        retry := 1;
        while retry<=MaximumAuthentificationRetry do begin
          // "403 Forbidden" in case of authentication failure -> try relog
          if OnAuthentificationFailed(retry,aUserName,aPassword,aPasswordHashed) and
             SetUser(StringToUTF8(aUserName),StringToUTF8(aPassword),aPasswordHashed) then begin
            CallInternalURI;
            break;
          end;
          Inc(retry);
        end;
      finally
        Exclude(fInternalState,isInAuth);
      end;
    if not StatusCodeIsSuccess(Call.OutStatus) then begin
      StatusCodeToErrorMessage(Call.OutStatus,StatusMsg);
      if Call.OutBody='' then
        fLastErrorMessage := StatusMsg else
        fLastErrorMessage := Call.OutBody;
      InternalLog('% % returned % (%) with message  %',
        [method,url,Call.OutStatus,StatusMsg,fLastErrorMessage],sllError);
      if Assigned(fOnFailed) then
        fOnFailed(Self,nil,@Call);
    end;
  except
    on E: Exception do begin
      Int64(result) := HTTP_NOTIMPLEMENTED; // 501
      SetLastException(E,HTTP_NOTIMPLEMENTED,@Call);
      exit;
    end;
  end;
end;

function TSQLRestClientURI.CallBackGetResult(const aMethodName: RawUTF8;
  const aNameValueParameters: array of const; aTable: TSQLRecordClass; aID: TID): RawUTF8;
var aResponse: RawUTF8;
begin
  if CallBackGet(aMethodName,aNameValueParameters,aResponse,aTable,aID)=HTTP_SUCCESS then
    result := JSONDecode(aResponse) else
    result := '';
end;

function TSQLRestClientURI.CallBackPut(const aMethodName,
  aSentData: RawUTF8; out aResponse: RawUTF8; aTable: TSQLRecordClass;
  aID: TID; aResponseHead: PRawUTF8): integer;
begin
  result := CallBack(mPUT,aMethodName,aSentData,aResponse,aTable,aID,aResponseHead);
end;

function TSQLRestClientURI.CallBack(method: TSQLURIMethod;
  const aMethodName,aSentData: RawUTF8; out aResponse: RawUTF8;
  aTable: TSQLRecordClass; aID: TID; aResponseHead: PRawUTF8): integer;
var u, m: RawUTF8;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  if (self=nil) or (method=mNone) then
    result := HTTP_UNAVAILABLE else begin
    u := Model.getURICallBack(aMethodName,aTable,aID);
    {$ifdef WITHLOG}
    log := fLogClass.Enter('Callback %',[u],self);
    {$endif}
    m := TrimLeftLowerCaseShort(GetEnumName(TypeInfo(TSQLURIMethod),ord(method)));
    result := URI(u,m,@aResponse,aResponseHead,@aSentData).Lo;
    InternalLog('% result=% resplen=%',[m,result,length(aResponse)],sllServiceReturn);
  end;
end;

procedure TSQLRestClientURI.CallbackNonBlockingSetHeader(out Header: RawUTF8);
begin // nothing to do by default (plain REST/HTTP works in blocking mode)
end;

function TSQLRestClientURI.ServiceRegister(const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): boolean;
begin
  result := False;
  if (self=nil) or (high(aInterfaces)<0) then
    exit;
  result := (ServiceContainer as TServiceContainerClient).AddInterface(
    aInterfaces,aInstanceCreation,aContractExpected);
end;

function TSQLRestClientURI.ServiceRegister(aInterface: PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8; aIgnoreAnyException: boolean): TServiceFactory;
begin
  result := nil;
  if (self=nil) or (aInterface=nil) then begin
    SetLastException;
    exit;
  end;
  with ServiceContainer as TServiceContainerClient do
  try
    result := AddInterface(aInterface,aInstanceCreation,aContractExpected);
  except
    on E: Exception do
      if aIgnoreAnyException then
        SetLastException(E) else
        raise;
  end;
end;

function TSQLRestClientURI.ServiceRegisterClientDriven(aInterface: PTypeInfo;
  out Obj; const aContractExpected: RawUTF8): boolean;
var Factory: TServiceFactory;
begin
  Factory := ServiceRegister(aInterface,sicClientDriven,aContractExpected);
  if Factory<>nil then begin
    result := true;
    Factory.Get(Obj);
  end else
    result := false;
end;

function TSQLRestClientURI.ServiceDefine(const aInterfaces: array of TGUID;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): boolean;
begin
  if self<>nil then
    result := ServiceRegister(TInterfaceFactory.GUID2TypeInfo(aInterfaces),
      aInstanceCreation,aContractExpected) else
    result := false;
end;

function TSQLRestClientURI.ServiceDefine(const aInterface: TGUID;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8; aIgnoreAnyException: boolean): TServiceFactoryClient;
begin
  result := TServiceFactoryClient(
    ServiceRegister(TInterfaceFactory.GUID2TypeInfo(aInterface),
     aInstanceCreation,aContractExpected,aIgnoreAnyException));
end;

function TSQLRestClientURI.ServiceDefineClientDriven(const aInterface: TGUID;
  out Obj; const aContractExpected: RawUTF8): boolean;
begin
  result := ServiceRegisterClientDriven(
    TInterfaceFactory.GUID2TypeInfo(aInterface),Obj,aContractExpected);
end;

function TSQLRestClientURI.ServiceDefineSharedAPI(const aInterface: TGUID;
  const aContractExpected: RawUTF8; aIgnoreAnyException: boolean): TServiceFactoryClient;
begin
  try
    result := ServiceDefine(aInterface,sicShared,aContractExpected,aIgnoreAnyException);
    if result<>nil then begin
      result.ParamsAsJSONObject := true; // no contract -> explicit parameters
      result.ResultAsJSONObjectWithoutResult := true;
    end;
  except
    if aIgnoreAnyException then
      result := nil else
      raise;
  end;
end;

procedure TSQLRestClientURI.ServicePublishOwnInterfaces(OwnServer: TSQLRestServer);
begin
  fServicePublishOwnInterfaces := OwnServer.ServicesPublishedInterfaces;
end;

function TSQLRestClientURI.ServiceRetrieveAssociated(const aServiceName: RawUTF8;
  out URI: TSQLRestServerURIDynArray): boolean;
var json: RawUTF8;
begin
  result := (CallBackGet('stat',['findservice',aServiceName],json)=HTTP_SUCCESS) and
    (DynArrayLoadJSON(URI,pointer(json),TypeInfo(TSQLRestServerURIDynArray))<>nil);
end;

function TSQLRestClientURI.ServiceRetrieveAssociated(const aInterface: TGUID;
  out URI: TSQLRestServerURIDynArray): boolean;
var fact: TInterfaceFactory;
begin
  fact := TInterfaceFactory.Get(aInterface);
  if fact=nil then
    result := false else
    result := ServiceRetrieveAssociated(copy(fact.InterfaceName,2,maxInt),URI);
end;

function TSQLRestClientURI.EngineAdd(TableModelIndex: integer;
  const SentData: RawUTF8): TID;
var P: PUTF8Char;
    url, Head: RawUTF8;
begin
  result := 0;
  url := Model.URI[Model.Tables[TableModelIndex]];
  if URI(url,'POST',nil,@Head,@SentData).Lo<>HTTP_CREATED then
    exit; // response must be '201 Created'
  P := pointer(Head); // we need to check the headers
  if P<>nil then
  repeat
    // find ID from 'Location: Member Entry URI' header entry
    if IdemPChar(P,'LOCATION:') then begin // 'Location: root/People/11012' e.g.
      inc(P,9);
      while P^>#13 do inc(P); // go to end of line
      P^ := #0; // make line asciiz, even if ended with #13
      while P[-1] in ['0'..'9'] do dec(P); // get all number chars
      if P[-1]='-' then dec(P);
      result := GetInt64(P); // get numerical value at the end of the URI
      exit;
    end;
    while not (P^ in [#0,#13]) do inc(P);
    if P^=#0 then break else inc(P);
    if P^=#10 then inc(P);
  until P^=#0;
end;

function TSQLRestClientURI.EngineDelete(TableModelIndex: integer; ID: TID): boolean;
var url: RawUTF8;
begin
  url := Model.getURIID(Model.Tables[TableModelIndex],ID);
  result := URI(url,'DELETE').Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
end;

function TSQLRestClientURI.EngineDeleteWhere(TableModelIndex: integer;
  const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean;
var url: RawUTF8;
begin  // ModelRoot/TableName?where=WhereClause to delete members
  url := Model.getURI(Model.Tables[TableModelIndex])+'?where='+UrlEncode(SQLWhere);
  result := URI(url,'DELETE').Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
end;

function TSQLRestClientURI.EngineList(const SQL: RawUTF8;
  ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8;
begin
  if (self=nil) or (SQL='') or (ReturnedRowCount<>nil) or
     (URI(Model.Root,'GET',@result,nil,@SQL).Lo<>HTTP_SUCCESS) then
    result := '';
end;

function TSQLRestClientURI.ClientRetrieve(TableModelIndex: integer; ID: TID;
  ForUpdate: boolean; var InternalState: cardinal; var Resp: RawUTF8): boolean;
begin
  if cardinal(TableModelIndex)<=cardinal(Model.fTablesMax) then
  with URIGet(Model.Tables[TableModelIndex],ID,Resp,ForUpdate) do
    if Lo=HTTP_SUCCESS then begin
      InternalState := Hi;
      result := true;
    end else
      result := false else
      result := false;
end;

function TSQLRestClientURI.EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean;
var url: RawUTF8;
begin
  if (self=nil) or (aID<=0) or (BlobField=nil) then
    result := false else begin
    // URI is 'ModelRoot/TableName/TableID/BlobFieldName' with GET method
    url := Model.getURICallBack(BlobField^.Name,Model.Tables[TableModelIndex],aID);
    result := URI(url,'GET',@BlobData).Lo=HTTP_SUCCESS;
  end;
end;

function TSQLRestClientURI.EngineUpdate(TableModelIndex: integer; ID: TID;
  const SentData: RawUTF8): boolean;
var url: RawUTF8;
begin
  url := Model.getURIID(Model.Tables[TableModelIndex],ID);
  result := URI(url,'PUT',nil,nil,@SentData).Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
end;

function TSQLRestClientURI.EngineUpdateBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean;
var url, Head: RawUTF8;
begin
  Head := 'Content-Type: application/octet-stream';
  if (self=nil) or (aID<=0) or (BlobField=nil) then
    result := false else begin
    // PUT ModelRoot/TableName/TableID/BlobFieldName
    FormatUTF8('%/%/%',[Model.URI[Model.Tables[TableModelIndex]],aID,BlobField^.Name],url);
    result := URI(url,'PUT',nil,@Head,@BlobData).Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
  end;
end;

function TSQLRestClientURI.EngineUpdateField(TableModelIndex: integer;
  const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean;
var url: RawUTF8;
begin
  if TableModelIndex<0 then
    result := false else begin
    // PUT ModelRoot/TableName?setname=..&set=..&wherename=..&where=..
    FormatUTF8('%?setname=%&set=%&wherename=%&where=%',
      [Model.URI[Model.Tables[TableModelIndex]],
       SetFieldName,UrlEncode(SetValue),WhereFieldName,UrlEncode(WhereValue)],url);
    result := URI(url,'PUT').Lo in [HTTP_SUCCESS,HTTP_NOCONTENT];
  end;
end;

function TSQLRestClientURI.EngineBatchSend(Table: TSQLRecordClass; var Data: RawUTF8;
  var Results: TIDDynArray; ExpectedResultsCount: integer): integer;
var Resp: RawUTF8;
    R: PUTF8Char;
    i: integer;
begin // TSQLRest.BatchSend() ensured that Batch contains some data
  try
    // URI is 'ModelRoot/Batch' or 'ModelRoot/Batch/TableName' with PUT method
    result := URI(Model.getURICallBack('Batch',Table,0),'PUT',@Resp,nil,@Data).Lo;
    if result<>HTTP_SUCCESS then
      exit;
    // returned Resp shall be an array of integers: '[200,200,...]'
    R := pointer(Resp);
    if R<>nil then
      while not (R^ in ['[',#0]) do inc(R);
    result := HTTP_BADREQUEST;
    if (R=nil) or (R^<>'[') then
      // invalid response
      exit;
    SetLength(Results,ExpectedResultsCount);
    if IdemPChar(R,'["OK"]') then begin // to save bandwith if no adding
      for i := 0 to ExpectedResultsCount-1 do
        Results[i] := HTTP_SUCCESS;
    end else begin
      inc(R); // jump first '['
      for i := 0 to ExpectedResultsCount-1 do begin
        Results[i] := GetJSONInt64Var(R);
        while R^ in [#1..' '] do inc(R);
        case R^ of
          ',': inc(R);
          ']': break;
          else exit;
        end;
      end;
      if R^<>']' then
        exit;
    end;
    result := HTTP_SUCCESS; // returns OK
  finally
    BatchAbort;
  end;
end;

procedure TSQLRestClientURI.BatchAbort;
begin
  if self<>nil then
    FreeAndNil(fBatchCurrent);
end;

function TSQLRestClientURI.BatchAdd(Value: TSQLRecord; SendData: boolean;
  ForceID: boolean=false; const CustomFields: TSQLFieldBits=[]): integer;
begin
  if self=nil then
    result := -1 else
    result := fBatchCurrent.Add(Value,SendData,ForceID,CustomFields);
end;

function TSQLRestClientURI.BatchCount: integer;
begin
  if self=nil then
    result := 0 else
    result := fBatchCurrent.Count;
end;

function TSQLRestClientURI.BatchDelete(ID: TID): integer;
begin
  if self=nil then
    result := -1 else
    result := fBatchCurrent.Delete(ID);
end;

function TSQLRestClientURI.BatchDelete(Table: TSQLRecordClass; ID: TID): integer;
begin
  if self=nil then
    result := -1 else
    result := fBatchCurrent.Delete(Table,ID);
end;

function TSQLRestClientURI.BatchStart(aTable: TSQLRecordClass;
  AutomaticTransactionPerRow: cardinal; Options: TSQLRestBatchOptions): boolean;
begin
  if (self=nil) or (fBatchCurrent<>nil) then
    result := false else begin
    fBatchCurrent := TSQLRestBatch.Create(self,aTable,AutomaticTransactionPerRow,Options);
    fBatchCurrent.fCalledWithinRest := true;
    result := true;
  end;
end;

function TSQLRestClientURI.BatchStartAny(AutomaticTransactionPerRow: cardinal;
  Options: TSQLRestBatchOptions): boolean;
begin
  result := BatchStart(nil,AutomaticTransactionPerRow,Options);
end;

function TSQLRestClientURI.BatchUpdate(Value: TSQLRecord;
  const CustomFields: TSQLFieldBits; DoNotAutoComputeFields: boolean): integer;
begin
  if (self=nil) or (Value=nil) or (fBatchCurrent=nil) or (Value.fID<=0) or
     not BeforeUpdateEvent(Value) then
    result := -1 else
    result := fBatchCurrent.Update(Value,CustomFields,DoNotAutoComputeFields);
end;

function TSQLRestClientURI.BatchSend(var Results: TIDDynArray): integer;
begin
  if self<>nil then
  try
    result := BatchSend(fBatchCurrent,Results);
  finally
    FreeAndNil(fBatchCurrent);
  end else
    result := HTTP_BADREQUEST;
end;


{ TSQLRestServer }

var
  GlobalURIRequestServer: TSQLRestServer = nil;

function URIRequest(url, method, SendData: PUTF8Char; Resp, Head: PPUTF8Char): Int64Rec; cdecl;
function StringToPCharCopy(const s: RawUTF8): PUTF8Char;
var L: integer;
begin
  L := length(s);
  if L=0 then
    result := nil else begin
    inc(L); // copy also last #0 from s
    {$ifdef MSWINDOWS}
    if not USEFASTMM4ALLOC then
      result := pointer(GlobalAlloc(GMEM_FIXED,L)) else
    {$endif}
      GetMem(result,L);
    MoveFast(pointer(s)^,result^,L);
  end;
end;
var call: TSQLRestURIParams;
begin
  if GlobalURIRequestServer=nil then begin
    Int64(result) := HTTP_NOTIMPLEMENTED; // 501
    exit;
  end;
  call.Init;
  call.Url := url;
  call.Method := method;
  call.LowLevelConnectionID := PtrInt(GlobalURIRequestServer);
  call.LowLevelFlags := [llfSecured]; // in-process communication is safe
  call.InHead := 'RemoteIP: 127.0.0.1';
  if (Head<>nil) and (Head^<>nil) then
    call.InHead := RawUTF8(Head^)+#13#10+call.InHead;
  SetString(call.InBody,SendData,StrLen(SendData));
  call.RestAccessRights := @SUPERVISOR_ACCESS_RIGHTS;
  GlobalURIRequestServer.URI(call);
  result.Lo := call.OutStatus;
  result.Hi := call.OutInternalState;
  if Head<>nil then
    Head^ := StringToPCharCopy(call.OutHead);
  if Resp<>nil then
    Resp^ := StringToPCharCopy(call.OutBody);
end;

procedure AdministrationExecuteGetFiles(const Folder, Mask: TFileName; const Param: RawUTF8;
  var Answer: TServiceCustomAnswer);
var files: TFindFilesDynArray;
    fn: TFileName;
    fs: Int64;
begin
  if (Param<>'*') and (PosExChar(':',Param)=0) and (PosExChar(PathDelim,Param)=0) then begin
    fn := IncludeTrailingPathDelimiter(Folder)+UTF8ToString(Param);
    fs := FileSize(fn);
    if (fs>0) and (fs<256 shl 20) then begin // download up to 256 MB
      Answer.Content := StringFromFile(fn);
      if Answer.Content<>'' then begin
        Answer.Header := BINARY_CONTENT_TYPE_HEADER+#13#10'FileName: '+Param;
        exit;
      end;
    end;
  end;
  files := FindFiles(Folder,Mask,'',true,false);
  Answer.Content := DynArraySaveJSON(files,TypeInfo(TFindFilesDynArray));
end;

function ReadString(Handle: cardinal): RawUTF8;
var L, Read: cardinal;
    P: PUTF8Char;
begin
  result := '';
  if (FileRead(Handle,L,4)=4) and (L<>0) then begin
    SetLength(result,L);
    P := pointer(result);
    repeat
      Read := FileRead(Handle,P^,L);
      if Read=0 then begin
        SleepHiRes(10); // nothing available -> wait a little and retry
        Read := FileRead(Handle,P^,L);
        if Read=0 then // server may be down -> abort
          raise ECommunicationException.Create('ReadString');
      end;
      inc(P,Read);
      dec(L,Read);
    until L=0; // loop until received all expected data
  end;
end;

procedure WriteString(Handle: cardinal; const Text: RawUTF8);
var L: cardinal;
begin
  L := length(Text);
  if L=0 then
    // write cardinal 0 if Text=''
    FileWrite(Handle,L,4) else
    // write length+content at once
    {$ifdef FPC}
    begin
      FileWrite(Handle,L,4);
      FileWrite(Handle,pointer(Text)^,L);
    end;
    {$else}
    FileWrite(Handle,pointer(PtrInt(Text)-4)^,L+4);
    {$endif}
end;

{$ifdef MSWINDOWS}

const
  ServerPipeNamePrefix: TFileName = '\\.\pipe\mORMot_';

function TSQLRestServer.ExportServerNamedPipe(const ServerApplicationName: TFileName): boolean;
var PipeName: TFileName;
    Pipe: THandle;
begin
  result := false;
  if fExportServerNamedPipeThread<>nil then
    exit; // only one ExportServer() by running process
  if {$ifdef UNICODE}IdemPCharW{$else}IdemPChar{$endif}(pointer(ServerApplicationName),'\\') then
    PipeName := ServerApplicationName else
    PipeName := ServerPipeNamePrefix+ServerApplicationName;
  Pipe := FileOpen(PipeName,fmOpenReadWrite); // is this pipe existing?
  if Pipe<>Invalid_Handle_Value then begin
    WriteString(Pipe,''); // send integer=0 -> force server disconnect
    FileClose(Pipe);
    exit; // only one pipe server with this name at once
  end;
  fExportServerNamedPipeThread := TSQLRestServerNamedPipe.Create(self,PipeName);
  NoAJAXJSON := true; // use smaller JSON size in this not HTTP use (never AJAX)
  sleep(10); // allow the background thread to start
  result := true; // success
end;

function TSQLRestServer.ExportServerMessage(const ServerWindowName: string): boolean;
begin
  result := false;
  if (self=nil) or (fServerWindow<>0) then
    exit;  // only one ExportServerMessage() by running process
  fServerWindow := CreateInternalWindow(ServerWindowName,self);
  if fServerWindow=0 then
    exit; // impossible to create window -> fail
  fServerWindowName := ServerWindowName;
  result := true;
end;

const
  MAGIC_SYN: cardinal = $A5ABA5AB;

procedure TSQLRestServer.AnswerToMessage(var Msg: TWMCopyData);
var call: TSQLRestURIParams;
    P: PUTF8Char;
    input: PCopyDataStruct;
    Res: packed record
      Magic: cardinal;
      Status: cardinal;
      InternalState: cardinal;
    end;
    Data: TCopyDataStruct;
    Header, ResStr: RawUTF8;
begin
  Msg.Result := HTTP_NOTFOUND;
  if (self=nil) or (Msg.From=0) then
    exit;
  input := PCopyDataStruct(Msg.CopyDataStruct);
  P := input^.lpData;
  if (P=nil) or (input^.cbData<=7) then
    exit;
  if PCardinal(P)^<>MAGIC_SYN then
    exit; // invalid layout: a broadcasted WM_COPYDATA message? :(
  inc(P,4);
  // #1 is a field delimiter below, since Get*Item() functions return nil for #0
  Msg.Result := HTTP_SUCCESS; // Send something back
  call.Init;
  GetNextItem(P,#1,call.Url);
  GetNextItem(P,#1,call.Method);
  GetNextItem(P,#1,call.InHead);
  call.LowLevelConnectionID := Msg.From;
  Header := 'RemoteIP: 127.0.0.1';
  AddToCSV(Header,call.InHead,#13#10);
  SetString(call.InBody,P,PtrInt(input^.cbData)-(P-input^.lpData));
  call.RestAccessRights := @SUPERVISOR_ACCESS_RIGHTS;
  // note: it's up to URI overridden method to implement access rights
  URI(call);
  Res.Magic := MAGIC_SYN;
  Res.Status := call.OutStatus;
  Res.InternalState := call.OutInternalState;
  {$ifdef FPC} // alf: to circumvent FPC issues
  ResStr := '';
  SetLength(ResStr,SizeOf(Res)+Length(call.OutHead)+1+Length(call.OutBody));
  P := pointer(ResStr);
  System.Move(Pointer(@Res)^,P^,SizeOf(Res));
  Inc(P,SizeOf(Res));
  System.Move(pointer(call.OutHead)^,P^,Length(call.OutHead));
  Inc(P,Length(call.OutHead));
  PByte(P)^ := 1;
  Inc(P);
  System.Move(pointer(call.OutBody)^,P^,Length(call.OutBody));
  {$else}
  FastSetString(ResStr,@Res,SizeOf(Res));
  ResStr := ResStr+call.OutHead+#1+call.OutBody;
  {$endif FPC}
  Data.dwData := fServerWindow;
  Data.cbData := length(ResStr);
  Data.lpData := pointer(ResStr);
  SendMessage(Msg.From,WM_COPYDATA,fServerWindow,PtrInt(@Data));
end;

function TSQLRestServer.CloseServerNamedPipe: boolean;
begin
  if fExportServerNamedPipeThread<>nil then begin
    fExportServerNamedPipeThread.Terminate;
    SleepHiRes(200); // we have sleep(128) in TSQLRestServerNamedPipe.EngineExecute
    FreeAndNil(fExportServerNamedPipeThread);
    result := true;
  end else
    result := false;
end;

function TSQLRestServer.CloseServerMessage: boolean;
begin
  result := ReleaseInternalWindow(fServerWindowName,fServerWindow);
end;

function TSQLRestServer.ExportedAsMessageOrNamedPipe: Boolean;
begin
  result := (self<>nil) and
    ((fExportServerNamedPipeThread<>nil) or (fServerWindow<>0));
end;

{$endif MSWINDOWS}

function TSQLRestServer.ExportServer: boolean;
begin
  {$ifdef MSWINDOWS}
  if (fServerWindow<>0) or (fExportServerNamedPipeThread<>nil) then
    result := false else // another server was running
  {$endif MSWINDOWS}
  if (GlobalURIRequestServer=nil) or (GlobalURIRequestServer=self) then begin
    GlobalURIRequestServer := self;
    result := true;
  end else
    result := false;
end;

procedure TSQLRestServer.ServiceMethodRegister(aMethodName: RawUTF8;
  const aEvent: TSQLRestServerCallBack; aByPassAuthentication: boolean);
begin
  aMethodName := trim(aMethodName);
  if aMethodName='' then
    raise EServiceException.CreateUTF8('%.ServiceMethodRegister('''')',[self]);
  if Model.GetTableIndex(aMethodName)>=0 then
    raise EServiceException.CreateUTF8('Published method name %.% '+
      'conflicts with a Table in the Model!',[self,aMethodName]);
  with PSQLRestServerMethod(fPublishedMethods.AddUniqueName(aMethodName,
      'Duplicated published method name %.%',[self,aMethodName]))^ do begin
    CallBack := aEvent;
    ByPassAuthentication := aByPassAuthentication;
  end;
end;

procedure TSQLRestServer.ServiceMethodRegisterPublishedMethods(const aPrefix: RawUTF8;
  aInstance: TObject);
var i: integer;
    methods: TPublishedMethodInfoDynArray;
begin
  if aInstance=nil then
    exit;
  if PosExChar('/',aPrefix)>0 then
    raise EServiceException.CreateUTF8('%.ServiceMethodRegisterPublishedMethods'+
      '("%"): prefix should not contain "/"',[self,aPrefix]);
  for i := 0 to GetPublishedMethods(aInstance,methods)-1 do
    with methods[i] do
      ServiceMethodRegister(aPrefix+Name,TSQLRestServerCallBack(Method));
end;

constructor TSQLRestServer.Create(aModel: TSQLModel; aHandleUserAuthentication: boolean);
var t: integer;
    tmp: RawUTF8;
begin
  if aModel=nil then
    raise EORMException.CreateUTF8('%.Create(Model=nil)',[self]);
  // specific server initialization
  fStatLevels := SERVERDEFAULTMONITORLEVELS;
  fVirtualTableDirect := true; // faster direct Static call by default
  fSessions := TSynObjectListLocked.Create; // needed by AuthenticationRegister() below
  fSQLAuthUserClass := TSQLAuthUser;
  fSQLAuthGroupClass := TSQLAuthGroup;
  fModel := aModel;
  fSQLRecordVersionDeleteTable := TSQLRecordTableDeleted;
  for t := 0 to high(Model.Tables) do
  if fModel.Tables[t].RecordProps.RecordVersionField<>nil then begin
    fSQLRecordVersionDeleteTable := fModel.AddTableInherited(TSQLRecordTableDeleted);
    break;
  end;
  fSessionClass := TAuthSession;
  if aHandleUserAuthentication then // default mORMot authentication schemes
    AuthenticationRegister([TSQLRestServerAuthenticationDefault
      {$ifdef DOMAINAUTH},TSQLRestServerAuthenticationSSPI{$endif}]);
  fTrackChangesHistoryTableIndexCount := length(Model.Tables);
  SetLength(fTrackChangesHistory,fTrackChangesHistoryTableIndexCount);
  if fTrackChangesHistoryTableIndexCount>64 then
    fTrackChangesHistoryTableIndexCount := 64; // rows are identified as RecordRef
  SetLength(fTrackChangesHistoryTableIndex,fTrackChangesHistoryTableIndexCount);
  for t := 0 to fTrackChangesHistoryTableIndexCount-1 do
    fTrackChangesHistoryTableIndex[t] := -1;
  fAssociatedServices := TServicesPublishedInterfacesList.Create(0);
  // abstract REST initalization
  inherited Create(aModel);
  fAfterCreation := true;
  fStats := TSQLRestServerMonitor.Create(self);
  URIPagingParameters := PAGINGPARAMETERS_YAHOO;
  TAESPRNG.Main.Fill(@fSessionCounter,SizeOf(fSessionCounter));
  if integer(fSessionCounter)<0 then // ensure positive 31-bit integer
    fSessionCounter := -fSessionCounter;
  // retrieve published methods
  fPublishedMethods.InitSpecific(TypeInfo(TSQLRestServerMethods),
    fPublishedMethod,djRawUTF8,nil,true);
  ServiceMethodRegisterPublishedMethods('',self);
  fPublishedMethodAuthIndex := ServiceMethodByPassAuthentication('Auth');
  fPublishedMethodTimestampIndex := ServiceMethodByPassAuthentication('Timestamp');
  tmp := 'Batch';
  fPublishedMethodBatchIndex := fPublishedMethods.FindHashed(tmp);
  if (fPublishedMethodBatchIndex<0) or (fPublishedMethodTimestampIndex<0) then
    raise EORMException.CreateUTF8('%.Create: missing method!',[self]);
  fSafeRootUpper := UpperCase(fModel.Root)+'/_SAFE_/';
end;

constructor TSQLRestServer.CreateWithOwnModel(const Tables: array of TSQLRecordClass;
  aHandleUserAuthentication: boolean; const aRoot: RawUTF8);
var Model: TSQLModel;
begin
  Model := TSQLModel.Create(Tables,aRoot);
  Create(Model,aHandleUserAuthentication);
  Model.Owner := self;
end;

class function TSQLRestServer.CreateInMemoryForAllVirtualTables(aModel: TSQLModel;
  aHandleUserAuthentication: boolean): TSQLRestServer;
var restClass: TSQLRestClass;
    fake: TSynConnectionDefinition;
begin
  fake := TSynConnectionDefinition.Create;
  try
    fake.Kind := 'TSQLRestServerDB';
    restClass := TSQLRest.ClassFrom(fake);
    if (restClass=nil) or
       not restClass.InheritsFrom(TSQLRestServer) then begin
      // fallback if mORMotSQlite3.pas not linked
      result := TSQLRestServerFullMemory.Create(aModel,aHandleUserAuthentication);
      exit;
    end;
    fake.ServerName := ':memory:'; // avoid dependency to SynSQLite3.pas
    result := TSQLRestServerClass(restClass).RegisteredClassCreateFrom(
      aModel,aHandleUserAuthentication,fake);
  finally
    fake.Free;
  end;
end;

procedure TSQLRestServer.CreateMissingTables(user_version: cardinal=0;
  Options: TSQLInitializeTableOptions=[]);
begin
  fCreateMissingTablesOptions := Options;
end;

procedure TSQLRestServer.InitializeTables(Options: TSQLInitializeTableOptions);
var t: integer;
begin
  if (Self<>nil) and (Model<>nil) then
    for t := 0 to Model.TablesMax do
      if not TableHasRows(Model.Tables[t]) then
        Model.Tables[t].InitializeTable(self,'',Options);
end;

constructor TSQLRestServer.RegisteredClassCreateFrom(aModel: TSQLModel;
  aServerHandleAuthentication: boolean; aDefinition: TSynConnectionDefinition);
begin
  Create(aModel,aServerHandleAuthentication);
end;

destructor TSQLRestServer.Destroy;
var i: integer;
begin
  Shutdown;
  if GlobalURIRequestServer=self then begin
    GlobalURIRequestServer := nil;
    SleepHiRes(200); // way some time any request is finished in another thread
  end;
  // close any running named-pipe or GDI-messages server instance
  {$ifdef MSWINDOWS}
  CloseServerNamedPipe;
  CloseServerMessage;
  {$endif}
  AsynchBatchStop(nil); // may use fStaticData[]
  FreeAndNil(fBackgroundTimer);
  fRecordVersionSlaveCallbacks := nil; // should be done before fServices.Free
  for i := 0 to high(fStaticVirtualTable) do
  if fStaticVirtualTable[i]<>nil then begin
    // free all virtual TSQLRestStorage objects
    fStaticVirtualTable[i].Free;
    if fStaticData<>nil then
      fStaticData[i] := nil; // free once
  end;
  for i := 0 to high(fStaticData) do
    // free all TSQLRestStorage objects and update file if necessary
    fStaticData[i].Free;
  for i := 0 to fPublishedMethods.Count-1 do
    fPublishedMethod[i].Stats.Free;
  FreeAndNil(fSessions);
  FreeAndNil(fAssociatedServices);
  ObjArrayClear(fSessionAuthentication);
  inherited Destroy; // calls fServices.Free which will update fStats
  FreeAndNil(fJWTForUnauthenticatedRequest);
  FreeAndNil(fStats);
end;

procedure TSQLRestServer.Shutdown(const aStateFileName: TFileName);
var timeout: Int64;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  if fSessions=nil then
    exit; // avoid GPF e.g. in case of missing sqlite3-64.dll
  {$ifdef WITHLOG}
  log := fLogClass.Enter('Shutdown(%) % CurrentRequestCount=%',
    [aStateFileName,fModel.Root,fStats.AddCurrentRequestCount(0)],self);
  {$endif}
  OnNotifyCallback := nil;
  fSessions.Safe.Lock;
  try
    if fShutdownRequested then
      exit; // Shutdown method already called
    fShutdownRequested := true; // will be identified by TSQLRestServer.URI()
  finally
    fSessions.Safe.UnLock;
  end;
  timeout := GetTickCount64+30000; // never wait forever
  repeat
    SleepHiRes(5);
  until (fStats.AddCurrentRequestCount(0)=0) or (GetTickCount64>timeout);
  if aStateFileName<>'' then
    SessionsSaveToFile(aStateFileName);
end;

function TSQLRestServer.SleepOrShutdown(MS: integer): boolean;
var timeout: Int64;
begin
  result := true;
  timeout := GetTickCount64+MS;
  repeat
    if fShutdownRequested then
      exit;
    if MS<=10 then
      SleepHiRes(MS) else
      SleepHiRes(1);
    if fShutdownRequested then
      exit;
  until (MS<=10) or (GetTickCount64>=timeout);
  result := false;
end;

function TSQLRestServer.GetStaticDataServer(aClass: TSQLRecordClass): TSQLRest;
var i: cardinal;
begin
  if (self<>nil) and (fStaticData<>nil) then begin
    i := Model.GetTableIndexExisting(aClass);
    if i<cardinal(length(fStaticData)) then
      result := fStaticData[i] else
      result := nil;
  end else
    result := nil;
end;

function TSQLRestServer.GetStaticTable(aClass: TSQLRecordClass): TSQLRest;
begin
  if (aClass=nil) or ((fStaticData=nil) and (fStaticVirtualTable=nil)) then
    result := nil else
    result := GetStaticTableIndex(Model.GetTableIndexExisting(aClass));
end;

function TSQLRestServer.GetStaticTableIndex(aTableIndex: integer): TSQLRest;
begin
  result := nil;
  if aTableIndex>=0 then begin
    if cardinal(aTableIndex)<cardinal(length(fStaticData)) then
      result := fStaticData[aTableIndex];
    if result=nil then
      if fVirtualTableDirect and (fStaticVirtualTable<>nil) then
        result := fStaticVirtualTable[aTableIndex];
  end;
end;

function TSQLRestServer.GetStaticTableIndex(aTableIndex: integer;
  out Kind: TSQLRestServerKind): TSQLRest;
begin
  result := nil;
  Kind := sMainEngine;
  if aTableIndex>=0 then begin
    if cardinal(aTableIndex)<cardinal(length(fStaticData)) then begin
      result := fStaticData[aTableIndex];
      if result<>nil then begin
        Kind := sStaticDataTable;
        exit;
      end;
    end;
    if fVirtualTableDirect and (fStaticVirtualTable<>nil) then begin
      result := fStaticVirtualTable[aTableIndex];
      if result<>nil then
        Kind := sVirtualTable;
    end;
  end;
end;

function TSQLRestServer.GetRemoteTable(TableIndex: Integer): TSQLRest;
begin
  if (cardinal(TableIndex)>=cardinal(length(fStaticData))) or
     (fStaticData[TableIndex]=nil) or
     not fStaticData[TableIndex].InheritsFrom(TSQLRestStorageRemote) then
    result := nil else
    result := TSQLRestStorageRemote(fStaticData[TableIndex]).RemoteRest;
end;

function TSQLRestServer.GetVirtualTable(aClass: TSQLRecordClass): TSQLRest;
var i: integer;
begin
  result := nil;
  if fStaticVirtualTable<>nil then begin
    i := Model.GetTableIndexExisting(aClass);
    if (i>=0) and (Model.TableProps[i].Kind in IS_CUSTOM_VIRTUAL) then
      result := fStaticVirtualTable[i];
  end;
end;

function TSQLRestServer.IsInternalSQLite3Table(aTableIndex: integer): boolean;
begin
  result := ((cardinal(aTableIndex)>=cardinal(length(fStaticData))) or
             (fStaticData[aTableIndex]=nil)) and
            ((cardinal(aTableIndex)>=cardinal(length(fStaticVirtualTable))) or
             (fStaticVirtualTable[aTableIndex]=nil));
end;

function TSQLRestServer.StaticDataAdd(aStaticData: TSQLRestStorage): boolean;
var i,n,t: cardinal;
begin
  result := false;
  if (self=nil) or (aStaticData=nil) then
    exit;
  i := Model.GetTableIndexExisting(aStaticData.StoredClass);
  n := length(fStaticData);
  if (i<n) and (fStaticData[i]<>nil) and (fStaticData[i]<>aStaticData) then
    exit; // TSQLRecord already registered
  t := length(Model.Tables);
  if n<t then
    SetLength(fStaticData,t);
  fStaticData[i] := aStaticData;
  result := true;
end;

function TSQLRestServer.StaticDataCreate(aClass: TSQLRecordClass;
  const aFileName: TFileName; aBinaryFile: boolean;
  aServerClass: TSQLRestStorageInMemoryClass): TSQLRestStorage;
begin
  result := TSQLRestStorage(GetStaticDataServer(aClass));
  if result<>nil then begin
    // class already registered -> update file name
    (result as aServerClass).fFileName := aFileName;
  end else begin
    // class not already registered -> register now
    if aServerClass=nil then
      aServerClass := TSQLRestStorageInMemory; // default in-memory engine
    result := aServerClass.Create(aClass,self,aFileName,aBinaryFile);
    if not StaticDataAdd(result) then
      raise EORMException.CreateUTF8('Error in %.StaticDataCreate(%)',[self,aClass]);
  end;
end;

function TSQLRestServer.RemoteDataCreate(aClass: TSQLRecordClass;
  aRemoteRest: TSQLRest): TSQLRestStorageRemote;
begin
  if GetStaticDataServer(aClass)<>nil then
    raise EORMException.CreateUTF8('Duplicate %.RemoteDataCreate(%)',[self,aClass]);
  result := TSQLRestStorageRemote.Create(aClass,self,aRemoteRest);
  if not StaticDataAdd(result) then
    raise EORMException.CreateUTF8('Error in %.RemoteDataCreate(%)',[self,aClass]);
end;

procedure TSQLRestServer.FlushInternalDBCache;
begin // do nothing by default
end;

function SQLGetOrder(const SQL: RawUTF8): RawUTF8;
var P: PUTF8Char;
    i: integer;
begin
  i := PosI('ORDER BY ',SQL);
  if i>0 then begin
    inc(i,9);
    while SQL[i] in [#1..' '] do inc(i); // trim left
    result := copy(SQL,i,maxInt);
    P := PosChar(Pointer(Result),' ');
    if P=nil then
      P := PosChar(Pointer(Result),';');
    if P<>nil then
      SetLength(result,P-pointer(Result)); // trim right
  end;
  if result='' then // by default, a SQLite3 query is ordered by ID
    result := 'RowID';
end;

function TSQLRestServer.GetNoAJAXJSON: boolean;
begin
  result := (self<>nil) and (rsoNoAJAXJSON in fOptions);
end;

procedure TSQLRestServer.SetNoAJAXJSON(const Value: boolean);
begin
  if Value then
    include(fOptions,rsoNoAJAXJSON) else
    exclude(fOptions,rsoNoAJAXJSON);
end;

function TSQLRestServer.InternalAdaptSQL(TableIndex: integer; var SQL: RawUTF8): TSQLRest;
begin
  result := nil;
  if (self<>nil) and (TableIndex>=0) then begin // SQL refers to this unique table
    if cardinal(TableIndex)<cardinal(length(fStaticData)) then
      // no SQLite3 module available for fStaticData[] -> we need to
      // retrieve manualy any static table from the SQL SELECT statement
      result := fStaticData[TableIndex];
    if (result=nil) and fVirtualTableDirect and (fStaticVirtualTable<>nil) then begin
      result := fStaticVirtualTable[TableIndex];
      // virtual table may need adaptation (e.g. RowID -> ID)
      if result<>nil then
        if result.InheritsFrom(TSQLRestStorage) and
           not TSQLRestStorage(result).AdaptSQLForEngineList(SQL) then
          // complex request will use SQlite3 virtual engine module
          result := nil;
    end;
  end;
end;

function TSQLRestServer.InternalListRawUTF8(TableIndex: integer; const SQL: RawUTF8): RawUTF8;
var aSQL: RawUTF8;
    Rest: TSQLRest;
begin
  aSQL := SQL;
  Rest := InternalAdaptSQL(TableIndex,aSQL);
  if Rest<>nil then
     // this SQL statement is handled by direct connection, faster adaptation
    result := Rest.EngineList(aSQL) else
    // complex TSQLVirtualTableJSON/External queries will rely on virtual table
    result := MainEngineList(SQL,false,nil);
  if result='[]'#$A then
    result := '';
end;

const
  SQLRECORDVERSION_DELETEID_SHIFT = 58;
  SQLRECORDVERSION_DELETEID_RANGE = Int64(1) shl SQLRECORDVERSION_DELETEID_SHIFT;

procedure TSQLRestServer.InternalRecordVersionMaxFromExisting(RetrieveNext: PID);
var m: integer;
    field: TSQLPropInfoRTTIRecordVersion;
    current,max,mDeleted: Int64;
begin
  fAcquireExecution[execORMWrite].Safe.Lock;
  try
    if fRecordVersionMax=0 then begin // check twice to avoid race condition
      current := 0;
      for m := 0 to Model.TablesMax do begin
        field := Model.Tables[m].RecordProps.RecordVersionField;
        if field<>nil then begin
          if OneFieldValue(Model.Tables[m],'max('+field.Name+')','',[],[],max) then
            if max>current then
              current := max;
          mDeleted := Int64(m) shl SQLRECORDVERSION_DELETEID_SHIFT;
          if OneFieldValue(fSQLRecordVersionDeleteTable,'max(ID)','ID>? and ID<?',
             [],[mDeleted,mDeleted+SQLRECORDVERSION_DELETEID_RANGE],max) then begin
            max := max and pred(SQLRECORDVERSION_DELETEID_RANGE);
            if max>current then
              current := max;
          end;
        end;
      end;
    end else
      current := fRecordVersionMax;
    if RetrieveNext<>nil then begin
      inc(current);
      RetrieveNext^ := current;
    end;
    fRecordVersionMax := current;
  finally
    fAcquireExecution[execORMWrite].Safe.UnLock;
  end;
end;

function TSQLRestServer.InternalRecordVersionComputeNext: TRecordVersion;
begin
  if fRecordVersionMax=0 then
    InternalRecordVersionMaxFromExisting(@result) else begin
    fAcquireExecution[execORMWrite].Safe.Lock;
    inc(fRecordVersionMax);
    result := fRecordVersionMax;
    fAcquireExecution[execORMWrite].Safe.UnLock;
  end;
end;

function TSQLRestServer.RecordVersionCompute: TRecordVersion;
begin
  result := InternalRecordVersionComputeNext;
  if result>=SQLRECORDVERSION_DELETEID_RANGE then
    raise EORMException.CreateUTF8('%.InternalRecordVersionCompute=% overflow: '+
      '%.ID should be < 2^%)',[self,result,fSQLRecordVersionDeleteTable,
      SQLRECORDVERSION_DELETEID_SHIFT]);
end;

function TSQLRestServer.RecordVersionCurrent: TRecordVersion;
begin
  if self=nil then
    result := 0 else begin
    if fRecordVersionMax=0 then
      InternalRecordVersionMaxFromExisting(nil);
    result := fRecordVersionMax;
  end;
end;

procedure TSQLRestServer.InternalRecordVersionHandle(Occasion: TSQLOccasion;
  TableIndex: integer; var Decoder: TJSONObjectDecoder;
  RecordVersionField: TSQLPropInfoRTTIRecordVersion);
begin
  if RecordVersionField=nil then
    exit; // no TRecordVersion field to track
  if Decoder.FindFieldName(RecordVersionField.Name)<0 then
    // only compute new monotonic TRecordVersion if not already supplied by sender
    Decoder.AddFieldValue(RecordVersionField.Name,Int64ToUtf8(RecordVersionCompute),ftaNumber);
  if (fServices<>nil) then
    (fServices as TServiceContainerServer).RecordVersionNotifyAddUpdate(
      Occasion,TableIndex,Decoder);
end;

procedure TSQLRestServer.InternalRecordVersionDelete(TableIndex: integer;
  ID: TID; Batch: TSQLRestBatch);
var deleted: TSQLRecordTableDeleted;
    revision: TRecordVersion;
begin
  if fRecordVersionDeleteIgnore then
    exit;
  deleted := fSQLRecordVersionDeleteTable.Create;
  try
    revision := RecordVersionCompute;
    deleted.IDValue := revision+Int64(TableIndex) shl SQLRECORDVERSION_DELETEID_SHIFT;
    deleted.Deleted := ID;
    if Batch<>nil then
      Batch.Add(deleted,True,True) else
      Add(deleted,True,True);
    if (fServices<>nil) then
      (fServices as TServiceContainerServer).RecordVersionNotifyDelete(
        TableIndex,ID,Revision);
  finally
    deleted.Free;
  end;
end;

function TSQLRestServer.RecordVersionSynchronizeSlave(Table: TSQLRecordClass;
  Master: TSQLRest; ChunkRowLimit: integer; OnWrite: TOnBatchWrite): TRecordVersion;
var Writer: TSQLRestBatch;
    IDs: TIDDynArray;
    status: integer;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter('RecordVersionSynchronizeSlave %',[Table],self);
  {$endif}
  result := -1; // error
  if fRecordVersionMax=0 then
    InternalRecordVersionMaxFromExisting(nil);
  repeat
    Writer := RecordVersionSynchronizeSlaveToBatch(
      Table,Master,fRecordVersionMax,ChunkRowLimit,OnWrite);
    if Writer=nil then
      exit; // error
    if Writer.Count=0 then begin // nothing new (e.g. reached last chunk)
      result := fRecordVersionMax;
      Writer.Free;
      break;
    end else
    try
      fAcquireExecution[execORMWrite].Safe.Lock;
      fRecordVersionDeleteIgnore := true;
      status := BatchSend(Writer,IDs);
      if status=HTTP_SUCCESS then begin
        InternalLog('RecordVersionSynchronize(%) Added=% Updated=% Deleted=% on %',
          [Table,Writer.AddCount,Writer.UpdateCount,Writer.DeleteCount,Master],sllDebug);
        if ChunkRowLimit=0 then begin
          result := fRecordVersionMax;
          break;
        end;
      end else begin
        InternalLog('RecordVersionSynchronize(%) BatchSend=%',[Table,status],sllError);
        fRecordVersionMax := 0; // force recompute the maximum from DB
        break;
      end;
    finally
      fRecordVersionDeleteIgnore := false;
      fAcquireExecution[execORMWrite].Safe.UnLock;
      Writer.Free;
    end;
  until false;
end;

function TSQLRestServer.RecordVersionSynchronizeSlaveToBatch(Table: TSQLRecordClass;
  Master: TSQLRest; var RecordVersion: TRecordVersion; MaxRowLimit: integer;
  OnWrite: TOnBatchWrite): TSQLRestBatch;
var TableIndex,SourceTableIndex,UpdatedRow,DeletedRow: integer;
    Props: TSQLRecordProperties;
    Where: RawUTF8;
    UpdatedVersion,DeletedVersion: TRecordVersion;
    ListUpdated,ListDeleted: TSQLTableJSON;
    Rec: TSQLRecord;
    DeletedMinID: TID;
    Deleted: TSQLRecordTableDeleted;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter('RecordVersionSynchronizeSlaveToBatch %',[Table],self);
  {$endif}
  result := nil;
  if Master=nil then
    raise EORMException.CreateUTF8('%.RecordVersionSynchronizeSlaveToBatch(Master=nil)',[self]);
  TableIndex := Model.GetTableIndexExisting(Table);
  SourceTableIndex := Master.Model.GetTableIndexExisting(Table); // <>TableIndex?
  Props := Model.TableProps[TableIndex].Props;
  if Props.RecordVersionField=nil then
    raise EORMException.CreateUTF8(
      '%.RecordVersionSynchronizeSlaveToBatch(%) with no TRecordVersion field',[self,Table]);
  fAcquireExecution[execORMWrite].Safe.Lock;
  try
    Where := '%>? order by %';
    if MaxRowLimit>0 then
      Where := FormatUTF8('% limit %',[Where,MaxRowLimit]);
    ListUpdated := Master.MultiFieldValues(Table,'*',Where,
      [Props.RecordVersionField.Name,Props.RecordVersionField.Name],[RecordVersion]);
    if ListUpdated=nil then
      exit; // DB error
    ListDeleted := nil;
    try
      DeletedMinID := Int64(SourceTableIndex) shl SQLRECORDVERSION_DELETEID_SHIFT;
      Where := 'ID>? and ID<? order by ID';
      if MaxRowLimit>0 then
        Where := FormatUTF8('% limit %',[Where,MaxRowLimit]);
      ListDeleted := Master.MultiFieldValues(fSQLRecordVersionDeleteTable,
        'ID,Deleted',Where,[DeletedMinID+RecordVersion,
        DeletedMinID+SQLRECORDVERSION_DELETEID_RANGE]);
      if ListDeleted=nil then
        exit; // DB error
      result := TSQLRestBatch.Create(self,nil,10000);
      result.OnWrite := OnWrite;
      if (ListUpdated.fRowCount=0) and (ListDeleted.fRowCount=0) then
        exit; // nothing new -> returns void TSQLRestBach with Count=0
      Rec := Table.Create;
      Deleted := fSQLRecordVersionDeleteTable.Create;
      try
        Rec.FillPrepare(ListUpdated);
        Deleted.FillPrepare(ListDeleted);
        UpdatedRow := 1;
        DeletedRow := 1;
        UpdatedVersion := 0;
        DeletedVersion := 0;
        repeat // compute all changes in increasing version order
          if UpdatedVersion=0 then
            if UpdatedRow<=ListUpdated.fRowCount then begin
              Rec.FillRow(UpdatedRow);
              UpdatedVersion := Props.RecordVersionField.PropInfo.GetInt64Prop(Rec);
              inc(UpdatedRow);
            end;
          if DeletedVersion=0 then
            if DeletedRow<=ListDeleted.fRowCount then begin
              Deleted.FillRow(DeletedRow);
              DeletedVersion := Deleted.IDValue and pred(SQLRECORDVERSION_DELETEID_RANGE);
              inc(DeletedRow);
            end;
          if (UpdatedVersion=0) and (DeletedVersion=0) then
            break; // no more update available
          if (UpdatedVersion>0) and
             ((DeletedVersion=0) or (UpdatedVersion<DeletedVersion)) then begin
            if (RecordVersion=0) or
               (OneFieldValue(Table,'ID',Rec.IDValue)='') then
              result.Add(Rec,true,true,Rec.fFill.TableMapFields,true) else
              result.Update(Rec,[],true);
            RecordVersion := UpdatedVersion;
            UpdatedVersion := 0;
          end else
          if DeletedVersion>0 then begin
            result.Delete(Table,Deleted.Deleted);
            Deleted.IDValue := DeletedVersion+ // local ID follows current Model
              Int64(TableIndex) shl SQLRECORDVERSION_DELETEID_SHIFT;
            result.Add(Deleted,true,true,[],true);
            RecordVersion := DeletedVersion;
            DeletedVersion := 0;
          end;
        until false;
      finally
        Deleted.Free;
        Rec.Free;
      end;
    finally
      ListUpdated.Free;
      ListDeleted.Free;
    end;
  finally
    fAcquireExecution[execORMWrite].Safe.UnLock;
  end;
end;

function TSQLRestServer.ServiceContainer: TServiceContainer;
begin
  if fServices=nil then
    fServices := TServiceContainerServer.Create(self);
  result := fServices;
end;

function TSQLRestServer.RecordVersionSynchronizeSubscribeMaster(Table: TSQLRecordClass;
  RecordVersion: TRecordVersion; const SlaveCallback: IServiceRecordVersionCallback): boolean;
begin
  if self=nil then
    result := false else
    result := (ServiceContainer as TServiceContainerServer).
      RecordVersionSynchronizeSubscribeMaster(Model.GetTableIndexExisting(Table),
        RecordVersion,SlaveCallback);
end;

function TSQLRestServer.RecordVersionSynchronizeMasterStart(
  ByPassAuthentication: boolean): boolean;
var factory: TServiceFactoryServer;
begin
  if Services<>nil then begin
    factory := Services.Info(TypeInfo(IServiceRecordVersion)) as TServiceFactoryServer;
    if factory<>nil then begin
      result := factory.ByPassAuthentication=ByPassAuthentication;
      exit; // already registered with the same authentication parameter
    end;
  end;
  factory := ServiceRegister(TServiceRecordVersion,[TypeInfo(IServiceRecordVersion)],sicShared);
  if factory<>nil then begin
    if ByPassAuthentication then
      factory.ByPassAuthentication := ByPassAuthentication;
    result := true;
  end else
    result := false;
end;

function TSQLRestServer.RecordVersionSynchronizeSlaveStart(Table: TSQLRecordClass;
  MasterRemoteAccess: TSQLRestClientURI; OnNotify: TOnBatchWrite): boolean;
var current,previous: TRecordVersion;
    tableIndex: integer;
    tableName: RawUTF8;
    service: IServiceRecordVersion;
    callback: IServiceRecordVersionCallback;
    retry: integer;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter('RecordVersionSynchronizeSlaveStart % over %',
    [Table, MasterRemoteAccess],self);
  {$endif}
  callback := nil; // weird fix for FPC/ARM
  result := false;
  if (self=nil) or (MasterRemoteAccess=nil) then
    exit;
  tableIndex := Model.GetTableIndexExisting(Table);
  if (fRecordVersionSlaveCallbacks<>nil) and
     (fRecordVersionSlaveCallbacks[tableIndex]<>nil) then begin
    InternalLog('RecordVersionSynchronizeSlaveStart(%): already running',
      [Table],sllWarning);
    exit;
  end;
  tableName := Model.TableProps[tableIndex].Props.SQLTableName;
  if MasterRemoteAccess.Services.Info(IServiceRecordVersion)=nil then
    if not MasterRemoteAccess.ServiceRegister([TypeInfo(IServiceRecordVersion)],sicShared) then
      exit;
  if not MasterRemoteAccess.Services.Resolve(IServiceRecordVersion,service) then
    exit;
  current := 0;
  retry := 0;
  repeat
    repeat // retrieve all pending versions (may retry up to 5 times)
      previous := current;
      current := RecordVersionSynchronizeSlave(Table,MasterRemoteAccess,10000,OnNotify);
      if current<0 then begin
        InternalLog('RecordVersionSynchronizeSlaveStart(%): REST failure',
          [Table],sllError);
        exit;
      end;
    until current=previous;
    // subscribe for any further modification
    if callback=nil then
      callback := TServiceRecordVersionCallback.Create(self,MasterRemoteAccess,Table,OnNotify);
    InternalLog('RecordVersionSynchronizeSlaveStart(%) current=% Subscribe(%)',
      [Table,current,pointer(callback)],sllDebug);
    if service.Subscribe(tableName,current,callback) then begin // push notifications
      if fRecordVersionSlaveCallbacks=nil then
        SetLength(fRecordVersionSlaveCallbacks,Model.TablesMax+1);
      fRecordVersionSlaveCallbacks[tableIndex] := callback;
      InternalLog('RecordVersionSynchronizeSlaveStart(%): started from revision %',
        [Table,current],sllDebug);
      result := true;
      exit;
    end;
    // some modifications since version (i.e. last RecordVersionSynchronizeSlave)
    inc(retry);
  until retry=5; // avoid endless loop (most of the time, not needed)
  InternalLog('RecordVersionSynchronizeSlaveStart(%): retry failure',[Table],sllError);
end;

function TSQLRestServer.RecordVersionSynchronizeSlaveStop(Table: TSQLRecordClass): boolean;
var tableIndex: integer;
begin
  result := false;
  if self=nil then
    exit;
  tableIndex := Model.GetTableIndexExisting(Table);
  if (fRecordVersionSlaveCallbacks=nil) or
     (fRecordVersionSlaveCallbacks[tableIndex]=nil) then begin
    InternalLog('RecordVersionSynchronizeSlaveStop(%): not running',[Table],sllWarning);
    exit;
  end;
  fRecordVersionSlaveCallbacks[tableIndex] := nil; // will notify the server
  result := true;
end;

function TSQLRestServer.UnLock(Table: TSQLRecordClass; aID: TID): boolean;
begin
  result := Model.UnLock(Table,aID);
end;

procedure TSQLRestServer.Commit(SessionID: cardinal; RaiseException: boolean);
var i: integer;
begin
  inherited Commit(SessionID,RaiseException);
  if self<>nil then
    for i := 0 to high(fStaticVirtualTable) do
    if fStaticVirtualTable[i]<>nil then
    with TSQLRestStorageInMemory(fStaticVirtualTable[i]) do
      if InheritsFrom(TSQLRestStorageInMemory) and not CommitShouldNotUpdateFile then
        UpdateFile; // will do nothing if not Modified
end;

function TSQLRestServer.Delete(Table: TSQLRecordClass; ID: TID): boolean;
begin
  result := inherited Delete(Table,ID); // call EngineDelete
  if result then
    // force relational database coherency (i.e. our FOREIGN KEY implementation)
    AfterDeleteForceCoherency(Model.GetTableIndex(Table),ID);
end;

function TSQLRestServer.Delete(Table: TSQLRecordClass; const SQLWhere: RawUTF8): boolean;
var IDs: TIDDynArray;
    TableIndex,i: integer;
begin
  result := InternalDeleteNotifyAndGetIDs(Table,SQLWhere,IDs);
  if (IDs=nil) or not result then
    exit; // nothing to delete
  TableIndex := Model.GetTableIndexExisting(Table);
  fAcquireExecution[execORMWrite].fSafe.Lock;
  try // may be within a batch in another thread
    result := EngineDeleteWhere(TableIndex,SQLWhere,IDs);
  finally
    fAcquireExecution[execORMWrite].fSafe.Unlock;
  end;
  if result then
    // force relational database coherency (i.e. our FOREIGN KEY implementation)
    for i := 0 to high(IDs) do
      AfterDeleteForceCoherency(TableIndex,IDs[i]);
end;

function TSQLRestServer.TableRowCount(Table: TSQLRecordClass): Int64;
var Rest: TSQLRest;
begin
  Rest := GetStaticTable(Table);
  if Rest<>nil then // faster direct call
    result := Rest.TableRowCount(Table) else
    result := inherited TableRowCount(Table);
end;

function TSQLRestServer.TableHasRows(Table: TSQLRecordClass): boolean;
var Rest: TSQLRest;
begin
  Rest := GetStaticTable(Table);
  if Rest<>nil then // faster direct call
    result := Rest.TableHasRows(Table) else
    result := inherited TableHasRows(Table);
end;

function TSQLRestServer.MemberExists(Table: TSQLRecordClass; ID: TID): boolean;
var Rest: TSQLRest;
begin
  Rest := GetStaticTable(Table);
  if Rest<>nil then // faster direct call
    result := Rest.MemberExists(Table,ID) else
    result := inherited MemberExists(Table,ID);
end;

function TSQLRestServer.UpdateBlobFields(Value: TSQLRecord): boolean;
var Rest: TSQLRest;
begin // overridden method to update all BLOB fields at once
  if (Value=nil) or (Value.fID<=0) then
    result := false else begin
    Rest := GetStaticTable(PSQLRecordClass(Value)^);
    if Rest<>nil then // faster direct call
      result := Rest.UpdateBlobFields(Value) else
      result := inherited UpdateBlobFields(Value);
  end;
end;

function TSQLRestServer.RetrieveBlobFields(Value: TSQLRecord): boolean;
var Rest: TSQLRest;
begin // overridden method to update all BLOB fields at once
  if Value=nil then
    result := false else begin
    Rest := GetStaticTable(PSQLRecordClass(Value)^);
    if Rest<>nil then // faster direct call
      result := Rest.RetrieveBlobFields(Value) else
      result := inherited RetrieveBlobFields(Value);
  end;
end;

function TSQLRestServer.AfterDeleteForceCoherency(aTableIndex: integer;
  aID: TID): boolean;

  procedure PerformCascade(const Where: Int64; Ref: PSQLModelRecordReference);
  var W: RawUTF8;
      cascadeOK: boolean;
      Rest: TSQLRest;
  begin // set Field=0 or delete row where Field references aID
    if Where=0 then
      exit;
    Int64ToUTF8(Where,W);
    if Ref^.CascadeDelete then
      cascadeOK := Delete(Model.Tables[Ref^.TableIndex],
        Ref^.FieldType.Name+'=:('+W+'):') else begin
      Rest := GetStaticTableIndex(Ref^.TableIndex);
      if Rest<>nil then // fast direct call
        cascadeOK := Rest.EngineUpdateField(Ref^.TableIndex,
          Ref^.FieldType.Name,'0',Ref^.FieldType.Name,W) else
        cascadeOK := MainEngineUpdateField(Ref^.TableIndex,
          Ref^.FieldType.Name,'0',Ref^.FieldType.Name,W);
    end;
    if not cascadeOK then
      InternalLog('AfterDeleteForceCoherency() failed to handle field %.%',
        [Model.Tables[Ref^.TableIndex],Ref^.FieldType.Name],sllWarning);
  end;

var i: integer;
    Ref: PSQLModelRecordReference;
begin
  Ref := @Model.fRecordReferences[0];
  if Ref<>nil then begin
    for i := 1 to length(Model.fRecordReferences) do begin
      if Ref^.FieldTableIndex=-2 then // lazy initialization
        Ref^.FieldTableIndex := Model.GetTableIndexSafe(Ref^.FieldTable,false);
      case Ref^.FieldType.SQLFieldType of
      sftRecord: // TRecordReference published field
        PerformCascade(RecordReference(aTableIndex,aID),Ref);
      sftID:     // TSQLRecord published field
        if Ref^.FieldTableIndex=aTableIndex then
          PerformCascade(aID,Ref);
      sftTID:    // TTableID = type TID published field
        if Ref^.FieldTableIndex=aTableIndex then
          PerformCascade(aID,Ref);
      end;
      inc(Ref);
    end;
  end;
  result := true; // success even if no match found, or some cascade warnings
end;

function TSQLRestServer.CreateSQLMultiIndex(Table: TSQLRecordClass;
  const FieldNames: array of RawUTF8; Unique: boolean; IndexName: RawUTF8=''): boolean;
var SQL: RawUTF8;
    i, TableIndex: integer;
    Props: TSQLRecordProperties;
    Rest: TSQLRest;
begin
  result := false;
  if high(FieldNames)<0 then
    exit; // avoid endless loop for TSQLRestStorage with no overridden method
  TableIndex := Model.GetTableIndexExisting(Table);
  Rest := nil;
  if TableIndex>=0 then begin // bypass fVirtualTableDirect
    if cardinal(TableIndex)<cardinal(length(fStaticData)) then
      Rest := fStaticData[TableIndex];
    if (Rest=nil) and (fStaticVirtualTable<>nil) then
      Rest := fStaticVirtualTable[TableIndex];
  end;
  if Rest<>nil then begin
    if Rest.InheritsFrom(TSQLRestStorage) then
       // will try to create an index on the static table (e.g. for external DB)
       result := TSQLRestStorage(Rest).
         CreateSQLMultiIndex(Table,FieldNames,Unique,IndexName);
    exit;
  end;
  if (high(FieldNames)=0) and IsRowID(pointer(FieldNames[0])) then begin
    result := true; // SQLite3 has always its ID/RowID primary key indexed
    exit;
  end;
  Props := Model.TableProps[TableIndex].Props;
  for i := 0 to high(FieldNames) do
    if not IsRowID(pointer(FieldNames[i])) then
      if (Props.Fields.IndexByName(FieldNames[i])<0) then
        exit; // wrong field name
  if Unique then
    SQL := 'UNIQUE ' else
    SQL := '';
  if IndexName='' then begin
    IndexName := RawUTF8ArrayToCSV(FieldNames,'');
    if length(IndexName)+length(Props.SQLTableName)>64 then
      // avoid reaching potential identifier name size limit
      IndexName := crc32cUTF8ToHex(Props.SQLTableName)+
                   crc32cUTF8ToHex(IndexName);
  end;
  SQL := FormatUTF8('CREATE %INDEX IF NOT EXISTS Index%% ON %(%);',
    [SQL,Props.SQLTableName,IndexName,Props.SQLTableName,RawUTF8ArrayToCSV(FieldNames,',')]);
  result := EngineExecute(SQL);
end;

function TSQLRestServer.CreateSQLIndex(Table: TSQLRecordClass; const FieldName: RawUTF8;
  Unique: boolean; const IndexName: RawUTF8=''): boolean;
begin
  result := CreateSQLMultiIndex(Table,[FieldName],Unique,IndexName);
end;

function TSQLRestServer.CreateSQLIndex(Table: TSQLRecordClass;
  const FieldNames: array of RawUTF8; Unique: boolean): boolean;
var i: integer;
begin
  result := true;
  for i := 0 to high(FieldNames) do
    if not CreateSQLMultiIndex(Table,[FieldNames[i]],Unique) then
     result := false;
end;

function TSQLRestServer.GetAuthenticationSchemesCount: integer;
begin
  result := length(fSessionAuthentication);
end;

function TSQLRestServer.GetCurrentSessionUserID: TID;
begin
  with PServiceRunningContext(@ServiceContext)^ do
    if (Request<>nil) and (Request.Session>CONST_AUTHENTICATION_NOT_USED) then
      result := Request.SessionUser else
      result := 0;
end;

function TSQLRestServer.AuthenticationRegister(
  aMethod: TSQLRestServerAuthenticationClass): TSQLRestServerAuthentication;
var i: integer;
begin
  result := nil;
  if self=nil then
    exit;
  fSessions.Safe.Lock;
  try
    for i := 0 to high(fSessionAuthentication) do
      if fSessionAuthentication[i].ClassType=aMethod then begin
        result := fSessionAuthentication[i];
        exit; // method already there -> return existing instance
      end;
    // create and initialize new authentication instance
    result := aMethod.Create(self);
    ObjArrayAdd(fSessionAuthentication,result); // will be owned by this array
    fHandleAuthentication := true;
    // we need both AuthUser+AuthGroup tables for authentication -> create now
    fSQLAuthGroupClass := Model.AddTableInherited(TSQLAuthGroup);
    fSQLAuthUserClass := Model.AddTableInherited(TSQLAuthUser);
    if fAfterCreation and
      (not TableHasRows(fSQLAuthUserClass) or
       not TableHasRows(fSQLAuthGroupClass)) then
      CreateMissingTables(0,fCreateMissingTablesOptions);
  finally
    fSessions.Safe.UnLock;
  end;
end;

procedure TSQLRestServer.AuthenticationRegister(
  const aMethods: array of TSQLRestServerAuthenticationClass);
var i: integer;
begin
  for i := 0 to high(aMethods) do
    AuthenticationRegister(aMethods[i]);
end;

procedure TSQLRestServer.AuthenticationUnregister(aMethod: TSQLRestServerAuthenticationClass);
var i: integer;
begin
  if (self=nil) or (fSessionAuthentication=nil) then
    exit;
  fSessions.Safe.Lock;
  try
    for i := 0 to high(fSessionAuthentication) do
      if fSessionAuthentication[i].ClassType=aMethod then begin
        ObjArrayDelete(fSessionAuthentication,i);
        fHandleAuthentication := (fSessionAuthentication<>nil);
        break;
      end;
  finally
    fSessions.Safe.UnLock;
  end;
end;

procedure TSQLRestServer.AuthenticationUnregister(
  const aMethods: array of TSQLRestServerAuthenticationClass);
var i: integer;
begin
  for i := 0 to high(aMethods) do
    AuthenticationUnregister(aMethods[i]);
end;

procedure TSQLRestServer.AuthenticationUnregisterAll;
begin
  if (self=nil) or (fSessionAuthentication=nil) then
    exit;
  fSessions.Safe.Lock;
  try
    ObjArrayClear(fSessionAuthentication);
    fHandleAuthentication := false;
  finally
    fSessions.Safe.UnLock;
  end;
end;

function TSQLRestServer.ServiceMethodByPassAuthentication(const aMethodName: RawUTF8): integer;
var i: integer;
begin
  result := -1;
  if self=nil then
    exit;
  if aMethodName='' then
    for i := 0 to fPublishedMethods.Count-1 do
      fPublishedMethod[i].ByPassAuthentication := true else begin
    result := fPublishedMethods.FindHashed(aMethodName);
    if result>=0 then
      fPublishedMethod[result].ByPassAuthentication := true;
  end;
end;

function TSQLRestServer.BanIP(const aIP: RawUTF8; aRemoveBan: boolean): boolean;
begin
  result := false;
  if fIPBan=nil then begin
    if aRemoveBan then
      exit;
    fIPBan := TIPBan.Create;
    fPrivateGarbageCollector.Add(fIPBan);
  end;
  if aRemoveBan then
    result := fIPBan.Delete(aIP) else
    result := fIPBan.Add(aIP);
  InternalLog('BanIP(%,%)=%',[aIP,BOOL_STR[aRemoveBan],BOOL_STR[result]]);
end;

function TSQLRestServer.JWTForUnauthenticatedRequestWhiteIP(const aIP: RawUTF8;
  aRemoveWhite: boolean): boolean;
begin
  result := false;
  if fJWTForUnauthenticatedRequest=nil then
    exit;
  if fIPWhiteJWT=nil then begin
    if aRemoveWhite then
      exit;
    fIPWhiteJWT := TIPBan.Create;
    fPrivateGarbageCollector.Add(fIPWhiteJWT);
  end;
  if aRemoveWhite then
    result := fIPWhiteJWT.Delete(aIP) else
    result := fIPWhiteJWT.Add(aIP);
  InternalLog('WhiteIP(%,%)=%',[aIP,BOOL_STR[aRemoveWhite],BOOL_STR[result]]);
end;

function TSQLRestServer.GetServiceMethodStat(const aMethod: RawUTF8): TSynMonitorInputOutput;
var i: Integer;
begin
  if self=nil then
    i := -1 else
    i := fPublishedMethods.FindHashed(aMethod);
  if i>=0 then
    result := fPublishedMethod[i].Stats else
    result := nil;
end;

procedure TSQLRestServer.SetPublicURI(const Address,Port: RawUTF8);
begin
  fPublicURI.Address := Address;
  fPublicURI.Port := Port;
  fPublicURI.Root := Model.Root;
end;

const // text definition registered in unit's initialization block below
  _TSQLRestServerURI = 'Address,Port,Root RawUTF8';
  _TServicesPublishedInterfaces =
    'PublicURI{Address,Port,Root RawUTF8} Names array of RawUTF8';

function TSQLRestServer.ServicesPublishedInterfaces: RawUTF8;
var nfo: TServicesPublishedInterfaces;
begin
  if (self=nil) or (Services=nil) then
    result := '' else begin
    nfo.PublicURI := fPublicURI;
    Services.SetInterfaceNames(nfo.Names);
    result := RecordSaveJSON(nfo,TypeInfo(TServicesPublishedInterfaces));
  end;
end;


{ Low-level background execution functions }

type
  TInterfacedObjectHooked = class(TInterfacedObject)
  public
    procedure InternalRelease;
  end;

  TBackgroundLauncherAction = (
    doCallMethod, doInstanceRelease, doThreadMethod);

  PBackgroundLauncher = ^TBackgroundLauncher;
  TBackgroundLauncher = record
    Context: PServiceRunningContext;
    case Action: TBackgroundLauncherAction of
    doCallMethod:
      (CallMethodArgs: pointer); // PCallMethodArgs
    doInstanceRelease:
      (Instance: TInterfacedObjectHooked);
    doThreadMethod:
      (ThreadMethod: TThreadMethod)
  end;

procedure TInterfacedObjectHooked.InternalRelease;
begin
  if self<>nil then
    IInterface(self)._Release; // call the release interface
end;

procedure BackgroundExecuteProc(Call: pointer); forward;

{$ifdef DELPHI6OROLDER} {$ifndef LVCL}
type TThreadHook = class(TThread); // Delphi 5-6 tweak to access private fields
{$endif} {$endif}

procedure BackGroundExecute(var synch: TBackgroundLauncher;
  backgroundThread: TSynBackgroundThreadMethod);
var event: TThreadMethod;
{$ifdef DELPHI6OROLDER} {$ifndef LVCL}
    tempThread: TThread;
{$endif} {$endif}
begin
  synch.Context := @ServiceContext;
  TMethod(event).Code := @BackgroundExecuteProc;
  TMethod(event).Data := @synch;
  if backgroundThread=nil then
    if GetCurrentThreadID=MainThreadID then
      event else
      {$ifdef LVCL}
      raise EServiceException.Create('BackGroundExecute(thread=nil)')
      {$else}
      {$ifdef DELPHI6OROLDER}
      if synch.Context^.RunningThread=nil then begin
        // circumvent Delphi 6 limitation by using a temporary TThread
        tempThread := TThread.Create(true);
        try
          TThreadHook(tempThread).Synchronize(event)
        finally
          tempThread.Free; // slightly slower, but working
        end;
      end else
        TThreadHook(synch.Context^.RunningThread).Synchronize(event)
      {$else}
      TThread.Synchronize(synch.Context^.RunningThread,event)
      {$endif DELPHI6OROLDER}
      {$endif LVCL} else
    backgroundThread.RunAndWait(event);
end;

procedure BackgroundExecuteCallMethod(args: pointer;
  backgroundThread: TSynBackgroundThreadMethod);
var synch: TBackgroundLauncher;
begin
  synch.Action := doCallMethod;
  synch.CallMethodArgs := args;
  BackGroundExecute(synch,backgroundThread);
end;

procedure BackgroundExecuteInstanceRelease(instance: TObject;
  backgroundThread: TSynBackgroundThreadMethod);
var synch: TBackgroundLauncher;
begin
  synch.Action := doInstanceRelease;
  if not instance.InheritsFrom(TInterfacedObject) then
    raise EServiceException.CreateUTF8('BackgroundExecuteInstanceRelease(%)',[instance]);
  synch.Instance := TInterfacedObjectHooked(instance);
  BackGroundExecute(synch,backgroundThread);
end;

procedure BackgroundExecuteThreadMethod(const method: TThreadMethod;
  backgroundThread: TSynBackgroundThreadMethod);
var synch: TBackgroundLauncher;
begin
  synch.Action := doThreadMethod;
  synch.ThreadMethod := method;
  BackGroundExecute(synch,backgroundThread);
end;


{ TSQLRestServerURIContext }

constructor TSQLRestServerURIContext.Create(aServer: TSQLRestServer;
  const aCall: TSQLRestURIParams);
begin
  inherited Create;
  Server := aServer;
  Call := @aCall;
  Method := ToMethod(aCall.Method);;
  fThreadServer := @ServiceContext;
  fThreadServer^.Request := self;
end;

destructor TSQLRestServerURIContext.Destroy;
begin
  if fThreadServer<>nil then
    fThreadServer^.Request := nil;
  inherited Destroy;
end;

procedure TSQLRestServerURIContext.InternalSetTableFromTableName(TableName: PUTF8Char);
begin
  TableEngine := Server;
  InternalSetTableFromTableIndex(Server.Model.GetTableIndexPtr(TableName));
  if TableIndex<0 then
    exit;
  Static := Server.GetStaticTableIndex(TableIndex,StaticKind);
  if Static<>nil then
    TableEngine := Static;
end;

procedure TSQLRestServerURIContext.InternalSetTableFromTableIndex(Index: integer);
begin
  TableIndex := Index;
  if TableIndex>=0 then
    with Server.Model do begin
      self.Table := Tables[TableIndex];
      self.TableRecordProps := TableProps[TableIndex];
    end;
end;

function TSQLRestServerURIContext.URIDecodeREST: boolean;
var i,j,slash: integer;
    Par: PUTF8Char;
begin // expects 'ModelRoot[/TableName[/TableID][/URIBlobFieldName]][?param=...]' format
  // check root URI and Parameters
  i := 0;
  if (Call^.url<>'') and (Call^.url[1]='/') then
    inc(i); // URL may be '/path'
  j := length(Server.Model.Root);
  if (i+j>length(Call^.Url)) or (not(Call^.Url[i+j+1] in [#0,'/','?'])) or
     (StrCompIL(pointer(PtrInt(Call^.url)+i),pointer(Server.Model.Root),j,0)<>0) then begin
    result := False;
    exit; // bad ModelRoot -> caller can try another TSQLRestServer
  end;
  ParametersPos := PosExChar('?',Call^.url);
  if ParametersPos>0 then // '?select=...&where=...' or '?where=...'
    Parameters := @Call^.url[ParametersPos+1];
  if Method=mPost then begin
    fInputPostContentType := Call^.InBodyType(false);
    if (Parameters=nil) and
       IdemPChar(pointer(fInputPostContentType),'APPLICATION/X-WWW-FORM-URLENCODED') then
      Parameters := pointer(Call^.InBody);
  end;
  // compute URI without any root nor parameter
  inc(i,j+2);
  if ParametersPos=0 then
    URI := copy(Call^.url,i,maxInt) else
    URI := copy(Call^.url,i,ParametersPos-i);
  URIAfterRoot := PUTF8Char(pointer(Call^.url))+i-1;
  // compute Table, TableID and URIBlobFieldName
  slash := PosExChar('/',URI);
  if slash>0 then begin
    URI[slash] := #0;
    Par := pointer(URI);
    InternalSetTableFromTableName(Par);
    inc(Par,slash);
    if (Table<>nil) and (Par^ in ['0'..'9']) then
      // "ModelRoot/TableName/TableID/URIBlobFieldName"
      TableID := GetNextItemInt64(Par,'/') else
      TableID := -1; // URI like "ModelRoot/TableName/MethodName"
    URIBlobFieldName := Par;
    if Table<>nil then begin
      j := PosExChar('/',URIBlobFieldName);
      if j>0 then begin // handle "ModelRoot/TableName/URIBlobFieldName/ID"
        TableID := GetCardinalDef(pointer(PtrInt(URIBlobFieldName)+j),cardinal(-1));
        SetLength(URIBlobFieldName,j-1);
      end;
    end;
    SetLength(URI,slash-1);
  end else
    InternalSetTableFromTableName(pointer(URI)); // "ModelRoot/TableName"
  // compute URISessionSignaturePos and URIWithoutSignature
  if ParametersPos>0 then
    if IdemPChar(Parameters,'SESSION_SIGNATURE=') then
      URISessionSignaturePos := ParametersPos else
      URISessionSignaturePos := PosEx('&session_signature=',Call^.url,ParametersPos+1);
  if URISessionSignaturePos=0 then
    URIWithoutSignature := Call^.Url else
    URIWithoutSignature := Copy(Call^.Url,1,URISessionSignaturePos-1);
  result := True;
end;

procedure TSQLRestServerURIContext.URIDecodeSOAByMethod;
begin
  if Table=nil then
    // check URI as 'ModelRoot/MethodName'
    MethodIndex := Server.fPublishedMethods.FindHashed(URI) else
  if URIBlobFieldName<>'' then
    // check URI as 'ModelRoot/TableName[/TableID]/MethodName'
    MethodIndex := Server.fPublishedMethods.FindHashed(URIBlobFieldName) else
    MethodIndex := -1;
end;

var // as set by TSQLRestServer.AdministrationExecute()
  BYPASS_ACCESS_RIGHTS: TSQLAccessRights;

function TSQLRestServerURIContext.Authenticate: boolean;
var aSession: TAuthSession;
    i: integer;
begin
  if Server.HandleAuthentication and not IsRemoteAdministrationExecute then begin
    Session := CONST_AUTHENTICATION_SESSION_NOT_STARTED;
    result := false;
    Server.fSessions.Safe.Lock;
    try
      if Server.fSessionAuthentication<>nil then
        for i := 0 to length(Server.fSessionAuthentication)-1 do begin
          aSession := Server.fSessionAuthentication[i].RetrieveSession(self);
          if aSession<>nil then begin
            {$ifdef WITHLOG}
            if (aSession.RemoteIP<>'') and (aSession.RemoteIP<>'127.0.0.1') then
              Log.Log(sllUserAuth,'%/% %',[aSession.User.LogonName,aSession.ID,
                aSession.RemoteIP],self);
            {$endif}
            result := true;
            exit;
          end;
        end;
    finally
      Server.fSessions.Safe.UnLock;
    end;
    // if we reached here, no session was found
    if Service<>nil then
      // you can allow a service to be called directly
      result := Service.ByPassAuthentication else
    if MethodIndex>=0 then
      // /auth + /timestamp are e.g. allowed methods without signature
      result := Server.fPublishedMethod[MethodIndex].ByPassAuthentication else
    if (Table<>nil) and (Method in Server.fBypassORMAuthentication)  then
      // allow by-pass for a set of HTTP verbs (e.g. mGET)
      result := true;
  end else begin // default unique session if authentication is not enabled
    Session := CONST_AUTHENTICATION_NOT_USED;
    result := true;
  end;
end;

procedure TSQLRestServerURIContext.AuthenticationFailed(
  Reason: TNotifyAuthenticationFailedReason);
var txt: PShortString;
begin
  txt := ToText(Reason);
  {$ifdef WITHLOG}
  Log.Log(sllUserAuth,'AuthenticationFailed(%) for % (session=%)',
    [txt^,Call^.Url,Session],self);
  {$endif}
  // 401 Unauthorized response MUST include a WWW-Authenticate header,
  // which is not what we used, so here we won't send 401 error code but 403
  Call.OutStatus := HTTP_FORBIDDEN;
  FormatUTF8('Authentication Failed: % (%)',
    [UnCamelCase(TrimLeftLowerCaseShort(txt)),ord(Reason)],CustomErrorMsg);
  // call the notification event
  if Assigned(Server.OnAuthenticationFailed) then
    Server.OnAuthenticationFailed(Server,Reason,nil,self);
end;

destructor TSQLRestAcquireExecution.Destroy;
begin
  inherited Destroy;
  Thread.Free;
end;

procedure TSQLRestServerURIContext.ExecuteCommand;
procedure TimeOut;
begin
  {$ifdef WITHLOG}
  Log.Log(sllServer,'TimeOut %.Execute(%) after % ms',[self,ToText(Command)^,
    Server.fAcquireExecution[Command].LockedTimeOut],self);
  {$endif}
  if Call<>nil then
    Call^.OutStatus := HTTP_TIMEOUT; // 408 Request Time-out
end;
var Method: TThreadMethod;
    Start64: Int64;
begin
  with Server.fAcquireExecution[Command] do begin
    case Command of
      execSOAByMethod:
        Method := ExecuteSOAByMethod;
      execSOAByInterface:
        Method := ExecuteSOAByInterface;
      execORMGet:
        Method := ExecuteORMGet;
      execORMWrite: begin // special behavior to handle transactions at writing
        Method := ExecuteORMWrite;
        Start64 := GetTickCount64;
        repeat
          if Safe.TryLock then
          try
            if (Server.fTransactionActiveSession=0) or // avoid transaction mixups
               (Server.fTransactionActiveSession=Session) then begin
              if Mode=amLocked then begin
                ExecuteORMWrite; // process within the obtained write mutex
                exit;
              end;
              break;   // will handle Mode<>amLocked below
            end;
          finally
            Safe.UnLock;
          end;
          if (LockedTimeOut<>0) and (GetTickCount64>Start64+LockedTimeOut) then begin
            TimeOut; // wait up to 5 second by default
            exit;
          end;
          SleepHiRes(1); // retry every 1 ms
        until Server.fShutdownRequested;
      end;
      else raise EORMException.CreateUTF8('Unexpected Command=% in %.Execute',
        [ord(Command),self]);
    end;
    if Mode=amBackgroundORMSharedThread then
      if (Command=execORMWrite) and
         (Server.fAcquireExecution[execORMGet].Mode=amBackgroundORMSharedThread) then
        Command := execORMGet; // for share same thread for ORM read/write
  end;
  with Server.fAcquireExecution[Command] do
    case Mode of
    amUnlocked:
      Method;
    amLocked:
      if LockedTimeOut=0 then begin
        Safe.Lock;
        try
          Method;
        finally
          Safe.UnLock;
        end;
      end else begin
      Start64 := GetTickCount64;
      repeat
        if Safe.TryLock then
        try
          Method;
        finally
          Safe.UnLock;
        end;
        if GetTickCount64>Start64+LockedTimeOut then
          break; // wait up to 2 second by default
        SleepHiRes(1); // retry every 1 ms
      until Server.fShutdownRequested;
      TimeOut;
    end;
    {$ifndef LVCL}
    amMainThread:
      BackgroundExecuteThreadMethod(Method,nil);
    {$endif}
    amBackgroundThread,amBackgroundORMSharedThread: begin
      if Thread=nil then
        Thread := Server.NewBackgroundThreadMethod('% % %',
          [self,Server.Model.Root,ToText(Command)^]);
      BackgroundExecuteThreadMethod(Method,Thread);
    end;
    end;
end;

procedure TSQLRestServerURIContext.ConfigurationRestMethod(SettingsStorage: TObject);
var value: TDocVariantData;
    valid: boolean;
    config: variant;
begin
  URIBlobFieldName := StringReplaceChars(URIBlobFieldName,'/','.');
  if InputExists['value'] then begin
    if URIBlobFieldName='' then
      exit;
    value.InitObjectFromPath(URIBlobFieldName,Input['value']);
    JsonToObject(SettingsStorage,pointer(value.ToJSON),valid,nil,JSONTOOBJECT_TOLERANTOPTIONS);
    if not valid then begin
      Error('Invalid input [%] - expected %',[variant(value),
        ClassFieldNamesAllPropsAsText(SettingsStorage.ClassType,true)]);
      exit;
    end;
  end;
  ObjectToVariant(SettingsStorage,config,[woDontStoreDefault]);
  if URIBlobFieldName<>'' then
    config := TDocVariantData(config).GetValueByPath(URIBlobFieldName);
  ReturnsJson(config,HTTP_SUCCESS,true,twJsonEscape,true);
end;

procedure StatsAddSizeForCall(Stats: TSynMonitorInputOutput; const Call: TSQLRestURIParams);
begin
  Stats.AddSize( // rough estimation
    length(Call.Url)+length(Call.Method)+length(Call.InHead)+length(Call.InBody)+12,
    length(Call.OutHead)+length(Call.OutBody)+16);
end;

procedure TSQLRestServerURIContext.StatsFromContext(Stats: TSynMonitorInputOutput;
  var Diff: Int64; DiffIsMicroSecs: boolean);
begin
  StatsAddSizeForCall(Stats,Call^);
  if not StatusCodeIsSuccess(Call.OutStatus) then
    Stats.ProcessErrorNumber(Call.OutStatus);
  if DiffIsMicroSecs then // avoid a division
    Stats.FromExternalMicroSeconds(Diff) else
    Diff := Stats.FromExternalQueryPerformanceCounters(Diff); // converted to us
end;

procedure TSQLRestServerURIContext.ExecuteSOAByMethod;
var timeStart,timeEnd: Int64;
    sessionstat: TSynMonitorInputOutput;
begin
  with Server.fPublishedMethod[MethodIndex] do begin
    if mlMethods in Server.StatLevels then begin
      {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(timeStart);
      if Stats=nil then begin
        Server.fStats.Lock; // use this global lock
        try
          if Stats=nil then
            Stats := TSynMonitorInputOutput.Create(Name);
        finally
          Server.fStats.UnLock;
        end;
      end;
      Stats.Processing := true;
    end;
    if Parameters<>'' then
      Server.InternalLog('% %',[Name,Parameters],sllServiceCall);
    CallBack(self);
    if Stats<>nil then begin
      {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(timeEnd);
      dec(timeEnd,timeStart);
      StatsFromContext(Stats,timeEnd,false);
      if Server.StatUsage<>nil then
        Server.StatUsage.Modified(Stats,[]);
      if (mlSessions in Server.StatLevels) and (fSession<>nil) then begin
        if fSession.fMethods=nil then begin
          Server.fStats.Lock;
          try
            if fSession.fMethods=nil then
              SetLength(fSession.fMethods,length(Server.fPublishedMethod));
          finally
            Server.fStats.UnLock;
          end;
        end;
        sessionstat := fSession.fMethods[MethodIndex];
        if sessionstat=nil then begin
          Server.fStats.Lock;
          try
            sessionstat := fSession.fMethods[MethodIndex];
            if sessionstat=nil then begin
              sessionstat := TSynMonitorInputOutput.Create(Name);
              fSession.fMethods[MethodIndex] := sessionstat;
            end;
          finally
            Server.fStats.UnLock;
          end;
        end;
        StatsFromContext(sessionstat,timeEnd,true);
        // mlSessions stats are not yet tracked per Client
      end;
    end;
  end;
  with Server.fStats do begin
    fSafe^.Lock; // try...finally not mandatory (slow
    inc(fServiceMethod); // TSQLRestServerMonitor.Changed method is void
    fSafe^.UnLock;
  end;
end;

procedure TSQLRestServerURIContext.ServiceResultStart(WR: TTextWriter);
const JSONSTART: array[boolean] of RawUTF8 =
    ('{"result":[','{"result":{');
begin // InternalExecuteSOAByInterface has set ForceServiceResultAsJSONObject
  if ForceServiceResultAsJSONObjectWithoutResult then
    WR.Add('{') else
    WR.AddString(JSONSTART[ForceServiceResultAsJSONObject]);
end;

procedure TSQLRestServerURIContext.ServiceResultEnd(WR: TTextWriter; ID: TID);
const JSONSEND_WITHID: array[boolean] of RawUTF8 = ('],"id":','},"id":');
      JSONSEND_NOID: array[boolean] of AnsiChar = (']','}');
begin // InternalExecuteSOAByInterface has set ForceServiceResultAsJSONObject
  if ID=0 then
    WR.Add(JSONSEND_NOID[ForceServiceResultAsJSONObject]) else begin
    if ForceServiceResultAsJSONObjectWithoutResult then
      raise EServiceException.CreateUTF8(
        '%.ServiceResultEnd(ID=%) with ForceServiceResultAsJSONObjectWithoutResult',
        [self,ID]);
    WR.AddString(JSONSEND_WITHID[ForceServiceResultAsJSONObject]);
    WR.Add(ID); // only used in sicClientDriven mode
  end;
  if not ForceServiceResultAsJSONObjectWithoutResult then
    WR.Add('}');
end;

procedure TSQLRestServerURIContext.InternalExecuteSOAByInterface;
  procedure ComputeResult;
    procedure ServiceResult(const Name,JSONValue: RawUTF8);
    var WR: TTextWriter;
        temp: TTextWriterStackBuffer;
    begin
      WR := TJSONSerializer.CreateOwnedStream(temp);
      try
        ServiceResultStart(WR);
        if ForceServiceResultAsJSONObject then
          WR.AddFieldName(Name);
        WR.AddString(JSONValue);
        ServiceResultEnd(WR,0);
        Returns(WR.Text);
      finally
        WR.Free;
      end;
    end;
  begin
    ForceServiceResultAsXMLObject := ForceServiceResultAsXMLObject or
      Service.ResultAsXMLObject;
    ForceServiceResultAsJSONObject := ForceServiceResultAsJSONObject or
      Service.ResultAsJSONObject or
      Service.ResultAsJSONObjectWithoutResult or
      ForceServiceResultAsXMLObject; // XML needs a full JSON object as input
    ForceServiceResultAsJSONObjectWithoutResult := ForceServiceResultAsJSONObject and
      (Service.InstanceCreation in SERVICE_IMPLEMENTATION_NOID) and
      Service.ResultAsJSONObjectWithoutResult;
    if ForceServiceResultAsXMLObjectNameSpace='' then
      ForceServiceResultAsXMLObjectNameSpace := Service.ResultAsXMLObjectNameSpace;
    with Server.fStats do begin
      fSafe^.Lock;
      inc(fServiceInterface);
      Changed;
      fSafe^.UnLock;
    end;
    case ServiceMethodIndex of
    ord(imFree):
      if not (Service.InstanceCreation in [sicClientDriven..sicPerThread]) then begin
        Error('_free_ is not compatible with %',[ToText(Service.InstanceCreation)^]);
        exit;
      end; // {"method":"_free_", "params":[], "id":1234}
    ord(imContract): begin
      // "method":"_contract_" to retrieve the implementation contract
      if (Call^.InBody<>'') and (Call^.InBody<>'[]') then
        Server.AssociatedServices.RegisterFromClientJSON(Call^.InBody);
      ServiceResult('contract',Service.ContractExpected);
      exit; // "id":0 for this method -> no instance was created
    end;
    ord(imSignature): begin
      // "method":"_signature_" to retrieve the implementation signature
      if TServiceContainerServer(Server.Services).PublishSignature then
        ServiceResult('signature',Service.Contract) else
        // "id":0 for this method -> no instance was created
        Error('Not allowed to publish signature');
      exit;
    end;
    ord(imInstance):
      // "method":"_instance_" from TServiceFactoryClient.CreateFakeInstance
      if not (Service.InstanceCreation in [sicClientDriven]) then begin
        Error('_instance_ is not compatible with %',[ToText(Service.InstanceCreation)^]);
        exit;
      end else
      if ServiceInstanceID<>0 then begin
        Error('_instance_ with ServiceInstanceID=%',[ServiceInstanceID]);
        exit;
      end;
    else // TServiceFactoryServer.ExecuteMethod() will use ServiceMethod(Index)
      if ServiceMethod=nil then
        raise EServiceException.CreateUTF8('%.InternalExecuteSOAByInterface: '+
          'ServiceMethodIndex=% and ServiceMethod=nil',[self,ServiceMethodIndex]);
    end;
    if (Session>CONST_AUTHENTICATION_NOT_USED) and (ServiceExecution<>nil) and
       (SessionGroup-1 in ServiceExecution.Denied) then begin
      Error('Unauthorized method',HTTP_NOTALLOWED);
      exit;
    end;
    // if we reached here, we have to run the service method
    Service.ExecuteMethod(self);
  end;
var xml: RawUTF8;
    m: integer;
begin // expects Service, ServiceParameters, ServiceMethod(Index) to be set
  m := ServiceMethodIndex-SERVICE_PSEUDO_METHOD_COUNT;
  if m>=0 then begin
    if ServiceMethod=nil then
      ServiceMethod := @Service.fInterface.fMethods[m];
    ServiceExecution := @Service.fExecution[m];
    ServiceExecutionOptions := ServiceExecution.Options;
    with PServiceMethod(ServiceMethod)^ do begin // log from Ctxt.ServiceExecutionOptions
      if [smdConst,smdVar]*HasSPIParams<>[] then
        include(ServiceExecutionOptions,optNoLogInput);
      if [smdVar,smdOut,smdResult]*HasSPIParams<>[] then
        include(ServiceExecutionOptions,optNoLogOutput);
    end;
    {$ifdef WITHLOG} // load method call and parameter values (if worth it)
    if (sllServiceCall in Log.GenericFamily.Level) and (ServiceParameters<>nil) and
       (PWord(ServiceParameters)^<>ord('[')+ord(']') shl 8) then
      if optNoLogInput in ServiceExecutionOptions then
        Log.Log(sllServiceCall,'%{}',
          [PServiceMethod(ServiceMethod)^.InterfaceDotMethodName],Server) else
        Log.Log(sllServiceCall,'%%',[Service.InterfaceFactory.GetFullMethodName(
          ServiceMethodIndex),ServiceParameters],Server);
    {$endif}
    if Assigned(Service.OnMethodExecute) then
      if not Service.OnMethodExecute(self,PServiceMethod(ServiceMethod)^) then
        exit; // execution aborted by OnMethodExecute() callback event
  end;
  if Service.ResultAsXMLObjectIfAcceptOnlyXML then begin
    FindNameValue(Call^.InHead,'ACCEPT:',xml);
    if (xml='application/xml') or (xml='text/xml') then
      ForceServiceResultAsXMLObject := true;
  end;
  try
    ComputeResult;
  finally
    ServiceParameters := nil; // ensure no GPF later if points to some local data
  end;
  if ForceServiceResultAsXMLObject and (Call.OutBody<>'') and (Call.OutHead<>'') and
     CompareMemFixed(pointer(Call.OutHead),pointer(JSON_CONTENT_TYPE_HEADER_VAR),45) then begin
    delete(Call.OutHead,15,31);
    insert(XML_CONTENT_TYPE,Call.OutHead,15);
    JSONBufferToXML(pointer(Call.OutBody),XMLUTF8_HEADER,
      ForceServiceResultAsXMLObjectNameSpace,xml);
    Call.OutBody := xml;
  end;
end;

procedure TSQLRestServerURIContext.ExecuteORMGet;
  procedure ConvertOutBodyAsPlainJSON(const FieldsCSV: RawUTF8;
    Options: TJSONSerializerSQLRecordOptions);
  var rec: TSQLRecord;
      W: TJSONSerializer;
      bits: TSQLFieldBits;
      withid: boolean;
  begin // force plain standard JSON output for AJAX clients
    if (FieldsCSV='') or
      // handle ID single field only if ID_str is needed
      (IsRowID(pointer(FieldsCSV)) and not (jwoID_str in Options)) or
      // we won't handle min()/max() functions
      not TableRecordProps.Props.FieldBitsFromCSV(FieldsCSV,bits,withid) then
      exit;
    rec := Table.CreateAndFillPrepare(Call.OutBody);
    try
      W := TableRecordProps.Props.CreateJSONWriter(
        TRawByteStringStream.Create,true,FieldsCSV,{knownrows=}0);
      try
        include(W.fCustomOptions,twoForceJSONStandard); // force regular JSON
        W.SQLRecordOptions := Options; // will do the magic
        rec.AppendFillAsJsonValues(W);
        W.SetText(Call.OutBody);
      finally
        W.Stream.Free; // associated TRawByteStringStream instance
        W.Free;
      end;
    finally
      rec.Free;
    end;
  end;
var SQLSelect, SQLWhere, SQLWhereCount, SQLSort, SQLDir, SQL: RawUTF8;
    SQLStartIndex, SQLResults, SQLTotalRowsCount: integer;
    NonStandardSQLSelectParameter, NonStandardSQLWhereParameter: boolean;
    SQLisSelect: boolean;
    ResultList: TSQLTableJSON;
    TableIndexes: TIntegerDynArray;
    rec: TSQLRecord;
    opt: TJSONSerializerSQLRecordOptions;
    P: PUTF8Char;
    i,j,L: integer;
    Blob: PPropInfo;
begin
  {$ifdef KYLIX3}
  TableIndexes := nil; // make Kylix happy
  {$endif}
  case Method of
  mLOCK,mGET: begin
    if Table=nil then begin
      if (Method<>mLOCK) then begin
        if (Call.InBody='') and (Parameters<>nil) and
           (reUrlEncodedSQL in Call.RestAccessRights^.AllowRemoteExecute) then begin
          // GET with a SQL statement sent in URI, as sql=....
          while not UrlDecodeValue(Parameters,'SQL=',SQL,@Parameters) do
            if Parameters=nil then break;
        end else
          // GET with a SQL statement sent as UTF-8 body (not 100% HTTP compatible)
          SQL := Call.InBody;
        if SQL<>'' then begin
          SQLisSelect := isSelect(pointer(SQL),@SQLSelect);
          if SQLisSelect or
             (reSQL in Call.RestAccessRights^.AllowRemoteExecute) then begin
            Static := nil;
            if SQLisSelect then begin
              TableIndexes := Server.Model.GetTableIndexesFromSQLSelect(SQL);
              if TableIndexes=nil then begin
                // check for SELECT without any known table
                if not (reSQLSelectWithoutTable in
                   Call.RestAccessRights^.AllowRemoteExecute) then begin
                  Call.OutStatus := HTTP_NOTALLOWED;
                  exit;
                end;
              end else begin
                // check for SELECT with one (or several JOINed) tables
                for i := 0 to high(TableIndexes) do
                  if not (TableIndexes[i] in Call.RestAccessRights^.GET) then begin
                    Call.OutStatus := HTTP_NOTALLOWED;
                    exit;
                  end;
                // use the first static table (poorman's JOIN)
                Static := Server.InternalAdaptSQL(TableIndexes[0],SQL);
              end;
            end;
            if Static<>nil then  begin
              TableEngine := Static;
              Call.OutBody := TableEngine.EngineList(SQL);
            end else
              Call.OutBody := Server.MainEngineList(SQL,false,nil);
            // security note: only first statement is run by EngineList()
            if Call.OutBody<>'' then begin // got JSON list '[{...}]' ?
              if (SQLSelect<>'') and (length(TableIndexes)=1) then begin
                InternalSetTableFromTableIndex(TableIndexes[0]);
                opt := ClientSQLRecordOptions;
                if opt<>[] then
                  ConvertOutBodyAsPlainJSON(SQLSelect,opt);
              end;
              Call.OutStatus := HTTP_SUCCESS;  // 200 OK
              if not SQLisSelect then // accurate fStats.NotifyORM(Method) below
                Method := TSQLURIMethod(IdemPCharArray(SQLBegin(pointer(SQL)),
                  ['INSERT','UPDATE','DELETE'])+2); // -1+2 -> mGET=1
            end;
          end;
        end;
      end;
    end else
    // here, Table<>nil and TableIndex in [0..MAX_SQLTABLES-1]
    if not (TableIndex in Call.RestAccessRights^.GET) then // check User Access
      Call.OutStatus := HTTP_NOTALLOWED else begin
      if TableID>0 then begin
        // GET ModelRoot/TableName/TableID[/BlobFieldName] to retrieve one member,
        // with or w/out locking, or a specified BLOB field content
        if Method=mLOCK then // Safe.Lock is to be followed by PUT -> check user
          if not (TableIndex in Call.RestAccessRights^.PUT) then
            Call.OutStatus := HTTP_NOTALLOWED else
            if Server.Model.Lock(TableIndex,TableID) then
              Method := mGET; // mark successfully locked
        if Method<>mLOCK then
          if URIBlobFieldName<>'' then begin
            // GET ModelRoot/TableName/TableID/BlobFieldName: retrieve BLOB field content
            Blob := Table.RecordProps.BlobFieldPropFromRawUTF8(URIBlobFieldName);
            if Blob<>nil then begin
              if TableEngine.EngineRetrieveBlob(TableIndex,
                   TableID,Blob,TSQLRawBlob(Call.OutBody)) then begin
                Call.OutHead := GetMimeContentTypeHeader(Call.OutBody);
                Call.OutStatus := HTTP_SUCCESS; // 200 OK
              end else
                Call.OutStatus := HTTP_NOTFOUND;
            end;
          end else begin
            // GET ModelRoot/TableName/TableID: retrieve a member content, JSON encoded
            Call.OutBody := Server.fCache.Retrieve(TableIndex,TableID);
            if Call.OutBody='' then begin
              // get JSON object '{...}'
              if Static<>nil then
                Call.OutBody := Static.EngineRetrieve(TableIndex,TableID) else
                Call.OutBody := Server.MainEngineRetrieve(TableIndex,TableID);
              // cache if expected
              if Call.OutBody='' then
                Server.fCache.NotifyDeletion(TableIndex,TableID) else
                Server.fCache.Notify(TableIndex,TableID,Call.OutBody,soSelect);
            end;
            if Call.OutBody<>'' then begin // if something was found
              opt := ClientSQLRecordOptions;
              if opt<>[] then begin
                rec := Table.CreateFrom(Call.OutBody); // cached? -> make private
                try
                  Call.OutBody := rec.GetJSONValues(true,true,soSelect,nil,opt);
                finally
                  rec.Free;
                end;
              end;
              Call.OutStatus := HTTP_SUCCESS;
            end else // 200 OK
              Call.OutStatus := HTTP_NOTFOUND;
          end;
      end else
      // ModelRoot/TableName with 'select=..&where=' or YUI paging
      if Method<>mLOCK then begin // Safe.Lock not available here
        SQLSelect := 'RowID'; // if no select is specified (i.e. ModelRoot/TableName)
        // all IDs of this table are returned to the client
        SQLTotalRowsCount := 0;
        if Parameters<>nil then begin // '?select=...&where=...' or '?where=...'
          SQLStartIndex := 0;
          SQLResults := 0;
          if Parameters^<>#0 then
          with Server.URIPagingParameters do begin
            NonStandardSQLSelectParameter := Select<>PAGINGPARAMETERS_YAHOO.Select;
            NonStandardSQLWhereParameter := Where<>PAGINGPARAMETERS_YAHOO.Where;
            repeat
              UrlDecodeValue(Parameters,Sort,SQLSort);
              UrlDecodeValue(Parameters,Dir,SQLDir);
              UrlDecodeInteger(Parameters,StartIndex,SQLStartIndex);
              UrlDecodeInteger(Parameters,Results,SQLResults);
              UrlDecodeValue(Parameters,Select,SQLSelect);
              if NonStandardSQLSelectParameter and (SQLSelect='') then
                UrlDecodeValue(Parameters,PAGINGPARAMETERS_YAHOO.Select,SQLSelect);
              if NonStandardSQLWhereParameter and (SQLWhere='') then
                UrlDecodeValue(Parameters,PAGINGPARAMETERS_YAHOO.Where,SQLWhere);
              UrlDecodeValue(Parameters,Server.URIPagingParameters.Where,SQLWhere,@Parameters);
            until Parameters=nil;
          end;
          // let SQLite3 do the sort and the paging (will be ignored by Static)
          SQLWhereCount := SQLWhere; // "select count(*)" won't expect any ORDER
          if (SQLSort<>'') and
             (StrPosI('ORDER BY ',pointer(SQLWhere))=nil) then begin
            if SameTextU(SQLDir,'DESC') then
              SQLSort := SQLSort+' DESC'; // allow DESC, default is ASC
            SQLWhere := SQLWhere+' ORDER BY '+SQLSort;
          end;
          SQLWhere := trim(SQLWhere);
          if (SQLResults<>0) and (StrPosI('LIMIT ',pointer(SQLWhere))=nil) then begin
            if (Server.URIPagingParameters.SendTotalRowsCountFmt<>'') then begin
              if SQLWhere=SQLWhereCount then begin
                i := PosEx('ORDER BY ',UpperCase(SQLWhereCount));
                if i>0 then // if ORDER BY already in the SQLWhere clause
                  SetLength(SQLWhereCount,i-1);
              end;
              ResultList := Server.ExecuteList([Table],
                Server.Model.TableProps[TableIndex].SQLFromSelectWhere('Count(*)',SQLWhereCount));
              if ResultList<>nil then
              try
                SQLTotalRowsCount := ResultList.GetAsInteger(1,0);
              finally
                ResultList.Free;
              end;
            end;
            SQLWhere := FormatUTF8('% LIMIT % OFFSET %',[SQLWhere,SQLResults,SQLStartIndex]);
          end;
        end;
        SQL := Server.Model.TableProps[TableIndex].
          SQLFromSelectWhere(SQLSelect,trim(SQLWhere));
        Call.OutBody := Server.InternalListRawUTF8(TableIndex,SQL);
        if Call.OutBody<>'' then begin // got JSON list '[{...}]' ?
          opt := ClientSQLRecordOptions;
          if opt<>[] then
            ConvertOutBodyAsPlainJSON(SQLSelect,opt);
          Call.OutStatus := HTTP_SUCCESS;  // 200 OK
          if Server.URIPagingParameters.SendTotalRowsCountFmt<>'' then
            // insert "totalRows":% optional value to the JSON output
            if Server.NoAJAXJSON or (ClientKind=ckFramework) then begin
              P := pointer(Call.OutBody);
              L := length(Call.OutBody);
              P := NotExpandedBufferRowCountPos(P,P+L);
              j := 0;
              if P<>nil then
                j := P-pointer(Call.OutBody)-11 else
                 for i := 1 to 10 do
                   if Call.OutBody[L]='}' then begin
                     j := L;
                     break;
                   end else
                   dec(L);
              if j>0 then
                Insert(FormatUTF8(Server.URIPagingParameters.SendTotalRowsCountFmt,
                  [SQLTotalRowsCount]),Call.OutBody,j);
            end else begin // expanded format -> as {"values":[...],"total":n}
              if SQLTotalRowsCount=0 then // avoid sending fields array
                Call.OutBody := '[]' else
                Call.OutBody := trim(Call.OutBody);
              Call.OutBody := '{"values":'+Call.OutBody+FormatUTF8(Server.
                URIPagingParameters.SendTotalRowsCountFmt,[SQLTotalRowsCount])+'}';
            end;
        end else
          Call.OutStatus := HTTP_NOTFOUND;
      end;
    end;
    if Call.OutStatus=HTTP_SUCCESS then
      Server.fStats.NotifyORM(Method);
  end;
  mUNLOCK: begin
    // ModelRoot/TableName/TableID to unlock a member
    if not (TableIndex in Call.RestAccessRights^.PUT) then
      Call.OutStatus := HTTP_NOTALLOWED else
    if (Table<>nil) and (TableID>0) and
       Server.Model.UnLock(Table,TableID) then
      Call.OutStatus := HTTP_SUCCESS; // 200 OK
  end;
  mSTATE: begin
    // STATE method for TSQLRestClientServerInternalState
    // this method is called with Root (-> Table=nil -> Static=nil)
    // we need a specialized method in order to avoid fStats.Invalid increase
    Call.OutStatus := HTTP_SUCCESS;
    for i := 0 to high(Server.fStaticData) do
      if (Server.fStaticData[i]<>nil) and
         Server.fStaticData[i].InheritsFrom(TSQLRestStorage) then
        if TSQLRestStorage(Server.fStaticData[i]).RefreshedAndModified then begin
          inc(Server.InternalState); // force refresh
          break;
        end;
  end else
    raise EORMException.CreateUTF8('%.ExecuteORMGet(method=%)',[self,ord(Method)]);
  end;
end;

procedure TSQLRestServerURIContext.ExecuteORMWrite;
  procedure ComputeInBodyFields(Occasion: TSQLEvent);
  var Rec: TSQLRecord;
      bits: TSQLFieldBits;
  begin
    Rec := Table.Create;
    try
      Rec.FillFrom(pointer(Call.InBody),@bits);
      Rec.ComputeFieldsBeforeWrite(Server,Occasion);
      with TableRecordProps.Props do
        if Occasion=seAdd then
          bits := bits+ComputeBeforeAddFieldsBits else
          bits := bits+ComputeBeforeUpdateFieldsBits;
      Call.Inbody := Rec.GetJSONValues(true,Rec.IDValue<>0,bits);
    finally
      Rec.Free;
    end;
  end;
var OK: boolean;
    Blob: PPropInfo;
    SQLSelect, SQLWhere, SQLSort, SQLDir: RawUTF8;
begin
  if MethodIndex=Server.fPublishedMethodBatchIndex then begin
    ExecuteSOAByMethod; // run the BATCH process in execORMWrite context
    exit;
  end;
  if not Call.RestAccessRights^.CanExecuteORMWrite(
     Method,Table,TableIndex,TableID,self) then begin
    Call.OutStatus := HTTP_FORBIDDEN;
    exit;
  end;
  case Method of
  mPOST: // POST=ADD=INSERT
    if Table=nil then begin
      // ModelRoot with free SQL statement sent as UTF-8 (only for Admin group)
      // see e.g. TSQLRestClientURI.EngineExecute
      if reSQL in Call.RestAccessRights^.AllowRemoteExecute then
        if (Call.InBody<>'') and
           not (GotoNextNotSpace(Pointer(Call.InBody))^ in [#0,'[','{']) and
           Server.EngineExecute(Call.InBody) then begin
          Call.OutStatus := HTTP_SUCCESS; // 200 OK
        end else
        Call.OutStatus := HTTP_FORBIDDEN;
    end else begin
      // ModelRoot/TableName with possible JSON SentData: create a new member
      // here, Table<>nil, TableID<0 and TableIndex in [0..MAX_SQLTABLES-1]
      if rsoComputeFieldsBeforeWriteOnServerSide in Server.Options then
        ComputeInBodyFields(seAdd);
      TableID := TableEngine.EngineAdd(TableIndex,Call.InBody);
      if TableID<>0 then begin
        Call.OutStatus := HTTP_CREATED; // 201 Created
        FormatUTF8('Location: %/%',[URI,TableID],Call.OutHead);
        if rsoAddUpdateReturnsContent in Server.Options then begin
          Server.fCache.NotifyDeletion(TableIndex,TableID);
          Call.OutBody := TableEngine.EngineRetrieve(TableIndex,TableID);
          Server.fCache.Notify(TableIndex,TableID,Call.OutBody,soInsert);
        end else
          Server.fCache.Notify(TableIndex,TableID,Call.InBody,soInsert);
      end;
    end;
  mPUT: // PUT=UPDATE
    if TableID>0 then begin
      // PUT ModelRoot/TableName/TableID[/BlobFieldName] to update member/BLOB content
      if Server.RecordCanBeUpdated(Table,TableID,seUpdate,@CustomErrorMsg) then begin
        OK := false;
        if URIBlobFieldName<>'' then begin
          // PUT ModelRoot/TableName/TableID/BlobFieldName: update BLOB field content
          Blob := Table.RecordProps.BlobFieldPropFromRawUTF8(URIBlobFieldName);
          if Blob<>nil then
            OK := TableEngine.EngineUpdateBlob(TableIndex,TableID,Blob,Call.InBody);
        end else begin
          // ModelRoot/TableName/TableID with JSON SentData: update a member
          if rsoComputeFieldsBeforeWriteOnServerSide in Server.Options then
            ComputeInBodyFields(seUpdate);
          OK := TableEngine.EngineUpdate(TableIndex,TableID,Call.InBody);
          if OK then begin // flush (no CreateTime in JSON)
            Server.fCache.NotifyDeletion(TableIndex,TableID);
            if rsoAddUpdateReturnsContent in Server.Options then
              Call.OutBody := TableEngine.EngineRetrieve(TableIndex,TableID);
          end;
        end;
        if OK then
          Call.OutStatus := HTTP_SUCCESS; // 200 OK
      end else
      Call.OutStatus := HTTP_FORBIDDEN;
    end else
    if Parameters<>nil then begin // e.g. from TSQLRestClient.EngineUpdateField
      // PUT ModelRoot/TableName?setname=..&set=..&wherename=..&where=..
      repeat
        UrlDecodeValue(Parameters,'SETNAME=',SQLSelect);
        UrlDecodeValue(Parameters,'SET=',SQLDir);
        UrlDecodeValue(Parameters,'WHERENAME=',SQLSort);
        UrlDecodeValue(Parameters,'WHERE=',SQLWhere,@Parameters);
      until Parameters=nil;
      if (SQLSelect<>'') and (SQLDir<>'') and (SQLSort<>'') and (SQLWhere<>'') then
        if TableEngine.EngineUpdateField(TableIndex,SQLSelect,SQLDir,SQLSort,SQLWhere) then begin
          if rsoAddUpdateReturnsContent in Server.Options then
            Call.OutBody := TableEngine.EngineRetrieve(TableIndex,TableID);
          Call.OutStatus := HTTP_SUCCESS; // 200 OK
        end;
    end;
  mDELETE:
    if TableID>0 then
      // ModelRoot/TableName/TableID to delete a member
      if not Server.RecordCanBeUpdated(Table,TableID,seDelete,@CustomErrorMsg) then
        Call.OutStatus := HTTP_FORBIDDEN else begin
        if TableEngine.EngineDelete(TableIndex,TableID) and
           Server.AfterDeleteForceCoherency(TableIndex,TableID) then begin
          Call.OutStatus := HTTP_SUCCESS; // 200 OK
          Server.fCache.NotifyDeletion(TableIndex,TableID);
        end;
      end else
    if Parameters<>nil then begin
      // ModelRoot/TableName?where=WhereClause to delete members
      repeat
        if UrlDecodeValue(Parameters,'WHERE=',SQLWhere,@Parameters) then begin
          SQLWhere := trim(SQLWhere);
          if SQLWhere<>'' then begin
            if Server.Delete(Table,SQLWhere) then
              Call.OutStatus := HTTP_SUCCESS; // 200 OK
          end;
          break;
        end;
      until Parameters=nil;
    end;
  mBEGIN: begin      // BEGIN TRANSACTION
    // TSQLVirtualTableJSON/External will rely on SQLite3 module
    // and also TSQLRestStorageInMemory, since COMMIT/ROLLBACK have Static=nil
    // mBEGIN logic is just the opposite of mEND/mABORT: Safe.Lock main, then static
    if Server.TransactionBegin(Table,Session) then begin
      if (Static<>nil) and (StaticKind=sVirtualTable) then
        Static.TransactionBegin(Table,Session) else
      if (Static=nil) and (Server.fTransactionTable<>nil) then begin
        Static := Server.StaticVirtualTable[Server.fTransactionTable];
        if Static<>nil then
          Static.TransactionBegin(Table,Session);
      end;
      Call.OutStatus := HTTP_SUCCESS; // 200 OK
    end;
  end;
  mEND: begin        // END=COMMIT
    // this method is called with Root (-> Table=nil -> Static=nil)
    // mEND logic is just the opposite of mBEGIN: release static, then main
    if (Static<>nil) and (StaticKind=sVirtualTable) then
      Static.Commit(Session,false) else
    if (Static=nil) and (Server.fTransactionTable<>nil) then begin
      Static := Server.StaticVirtualTable[Server.fTransactionTable];
      if Static<>nil then
        Static.Commit(Session,false);
    end;
    Server.Commit(Session,false);
    Call.OutStatus := HTTP_SUCCESS; // 200 OK
  end;
  mABORT: begin      // ABORT=ROLLBACK
    // this method is called with Root (-> Table=nil -> Static=nil)
    // mABORT logic is just the opposite of mBEGIN: release static, then main
    if (Static<>nil) and (StaticKind=sVirtualTable) then
      Static.RollBack(Session) else
    if (Static=nil) and (Server.fTransactionTable<>nil) then begin
      Static := Server.StaticVirtualTable[Server.fTransactionTable];
      if Static<>nil then
        Static.RollBack(Session);
    end;
    Server.RollBack(Session);
    Call.OutStatus := HTTP_SUCCESS; // 200 OK
  end;
  end;
  if StatusCodeIsSuccess(Call.OutStatus) then
    Server.fStats.NotifyORM(Method);
end;

procedure TSQLRestServerURIContext.FillInput(const LogInputIdent: RawUTF8);
var n,max: integer;
    P: PUTF8Char;
begin
  if (fInput<>nil) or (Parameters=nil) then
    exit; // only do it once
  P := Parameters;
  n := 0;
  max := 0;
  repeat
    if n>=max then begin
      if n>=256 then // avoid DOS - see MAX_METHOD_ARGS for TInterfacedObjectFake
        raise EParsingException.CreateUTF8(
          'Security Policy: Accept up to 128 parameters for %.FillInput',[self]);
      inc(max,16);
      SetLength(fInput,max);
    end;
    P := UrlDecodeNextNameValue(P,fInput[n],fInput[n+1]);
    if P=nil then
      break;
    inc(n,2);
  until P^=#0;
  SetLength(fInput,n);
  {$ifdef WITHLOG}
  if LogInputIdent<>'' then
    Log.Add.Log(sllDebug,LogInputIdent,TypeInfo(TRawUTF8DynArray),fInput,self);
  {$endif}
end;

function TSQLRestServerURIContext.GetInputInt(const ParamName: RawUTF8): Int64;
var err: integer;
    v: RawUTF8;
begin
  GetInputByName(ParamName,'Int',v);
  result := GetInt64(pointer(v),err);
  if err<>0 then
    raise EParsingException.CreateUTF8('%.InputInt[%]: ''%'' is not an integer',
      [self,ParamName,v]);
end;

function TSQLRestServerURIContext.GetInputDouble(const ParamName: RawUTF8): double;
var err: integer;
    v: RawUTF8;
begin
  GetInputByName(ParamName,'Double',v);
  result := GetExtended(pointer(v),err);
  if err<>0 then
    raise EParsingException.CreateUTF8('%.InputDouble[%]: ''%'' is not a float',
      [self,ParamName,v]);
end;

function TSQLRestServerURIContext.GetInputIntOrVoid(const ParamName: RawUTF8): Int64;
begin
  result := GetInt64(pointer(GetInputUTF8OrVoid(ParamName)));
end;

function TSQLRestServerURIContext.GetInputHexaOrVoid(const ParamName: RawUTF8): cardinal;
var value: RawUTF8;
begin
  value := GetInputUTF8OrVoid(ParamName);
  if (length(value)<>8) or not HexDisplayToCardinal(Pointer(value),result) then
    result := 0;
end;

function TSQLRestServerURIContext.GetInputDoubleOrVoid(const ParamName: RawUTF8): double;
begin
  result := GetExtended(pointer(GetInputUTF8OrVoid(ParamName)));
end;

function TSQLRestServerURIContext.GetInputNameIndex(const ParamName: RawUTF8): PtrInt;
begin // fInput[0]='Param1',fInput[1]='Value1',fInput[2]='Param2'...
  if (fInput=nil) and (Parameters<>nil) then
    FillInput;
  for result := 0 to (length(fInput)shr 1)-1 do
    if IdemPropNameU(ParamName,fInput[result*2]) then
      exit;
  result := -1;
end;

procedure TSQLRestServerURIContext.GetInputByName(const ParamName,InputName: RawUTF8;
  var result: RawUTF8);
var i: PtrInt;
begin
  i := GetInputNameIndex(ParamName);
  if i<0 then
    raise EParsingException.CreateUTF8('%: missing Input%[%]',[self,InputName,ParamName]);
  result := fInput[i*2+1];
end;

function TSQLRestServerURIContext.GetInputUTF8(const ParamName: RawUTF8): RawUTF8;
begin
  GetInputByName(ParamName,'UTF8',result);
end;

function TSQLRestServerURIContext.GetInputUTF8OrVoid(const ParamName: RawUTF8): RawUTF8;
var i: PtrInt;
begin
  i := GetInputNameIndex(ParamName);
  if i<0 then
    result := '' else
    result := fInput[i*2+1];
end;

function TSQLRestServerURIContext.InputUTF8OrDefault(
  const ParamName, DefaultValue: RawUTF8): RawUTF8;
var i: PtrInt;
begin
  i := GetInputNameIndex(ParamName);
  if i<0 then
    result := DefaultValue else
    result := fInput[i*2+1];
end;

function TSQLRestServerURIContext.InputUTF8OrError(const ParamName: RawUTF8;
  out Value: RawUTF8; const ErrorMessageForMissingParameter: string): boolean;
var i: PtrInt;
begin
  i := GetInputNameIndex(ParamName);
  if i<0 then begin
    if ErrorMessageForMissingParameter='' then
      Error('%: missing ''%'' parameter',[self,ParamName]) else
      Error('%',[ErrorMessageForMissingParameter]);
    result := false;
  end else begin
    Value := fInput[i*2+1];
    result := true;
  end;
end;

function TSQLRestServerURIContext.InputEnum(const ParamName: RawUTF8;
  EnumType: PTypeInfo; out ValueEnum; DefaultEnumOrd: integer): boolean;
var value: RawUTF8;
    int,err: Integer;
begin
  result := false;
  if (EnumType=nil) or (EnumType^.Kind<>tkEnumeration) then
    exit;
  value := GetInputUTF8OrVoid(ParamName);
  if value<>'' then begin
    int := GetInteger(Pointer(value),err);
    if err=0 then
      result := true else begin
      int := EnumType^.EnumBaseType^.GetEnumNameValue(pointer(value),length(value));
      if int>=0 then
        result := true else
        int := DefaultEnumOrd;
    end;
  end else
    int := DefaultEnumOrd;
  EnumType^.EnumBaseType^.SetEnumFromOrdinal(ValueEnum,int);
end;

function TSQLRestServerURIContext.GetInputString(const ParamName: RawUTF8): string;
var i: PtrInt;
begin
  i := GetInputNameIndex(ParamName);
  if i<0 then
    raise EParsingException.CreateUTF8('%: missing InputString[%]',[self,ParamName]);
  result := UTF8ToString(fInput[i*2+1]);
end;

function TSQLRestServerURIContext.GetInputStringOrVoid(const ParamName: RawUTF8): string;
var i: PtrInt;
begin
  i := GetInputNameIndex(ParamName);
  if i<0 then
    result := '' else
    result := UTF8ToString(fInput[i*2+1]);
end;

function TSQLRestServerURIContext.GetInputExists(const ParamName: RawUTF8): Boolean;
begin
  result := GetInputNameIndex(ParamName)>=0;
end;

{$ifndef NOVARIANTS}

function TSQLRestServerURIContext.GetInput(const ParamName: RawUTF8): variant;
var v: RawUTF8;
begin
  GetInputByName(ParamName,'',v);
  GetVariantFromJSON(pointer(v),false,Result);
end;

function TSQLRestServerURIContext.GetInputOrVoid(const ParamName: RawUTF8): variant;
begin
  GetVariantFromJSON(pointer(GetInputUTF8OrVoid(ParamName)),false,Result);
end;

function TSQLRestServerURIContext.InputOrError(const ParamName: RawUTF8;
  out Value: variant; const ErrorMessageForMissingParameter: string): boolean;
var v: RawUTF8;
begin
  result := InputUTF8OrError(ParamName,v,ErrorMessageForMissingParameter);
  if result then
    GetVariantFromJSON(pointer(v),false,Value);
end;

function TSQLRestServerURIContext.GetInputAsTDocVariant(const Options: TDocVariantOptions; 
  ServiceMethod: pointer): variant;
var ndx, a: PtrInt;
    forcestring: boolean;
    v: variant;
    MultiPart: TMultiPartDynArray;
    name: RawUTF8;
    met: PServiceMethod absolute ServiceMethod;
    res: TDocVariantData absolute result;
begin
  VarClear(result);
  FillInput;
  if fInput<>nil then begin
    res.Init(Options,dvObject);
    for ndx := 0 to (length(fInput) shr 1)-1 do begin
      name := fInput[ndx*2];
      if met<>nil then begin
        a := met.ArgIndex(pointer(name),length(name),{input=}true);
        forcestring := (a>=0) and (vIsString in met.Args[a].ValueKindAsm);
      end else
        forcestring := false;
      GetVariantFromJSON(pointer(fInput[ndx*2+1]),forcestring,v,@Options);
      res.AddValue(name,v);
    end;
  end else
  if InputAsMultiPart(MultiPart) then begin
    res.Init(Options,dvObject);
    for ndx := 0 to high(MultiPart) do
      with MultiPart[ndx] do
        if ContentType=TEXT_CONTENT_TYPE then begin
          // append as regular "Name":"TextValue" field
          RawUTF8ToVariant(Content,v);
          res.AddValue(Name,v);
        end else
          // append binary file as an object, with Base64-encoded data
          res.AddValue(Name,_ObjFast(['data',BinToBase64(Content),
            'filename',FileName,'contenttype',ContentType]));
  end;
end;

{$endif NOVARIANTS}

function TSQLRestServerURIContext.InputAsMultiPart(var MultiPart: TMultiPartDynArray): Boolean;
begin
  result := (Method=mPOST) and
     IdemPChar(pointer(fInputPostContentType),'MULTIPART/FORM-DATA') and
     MultiPartFormDataDecode(fInputPostContentType,Call^.InBody,MultiPart);
end;

function TSQLRestServerURIContext.GetInHeader(const HeaderName: RawUTF8): RawUTF8;
var up: array[byte] of AnsiChar;
begin
  if self=nil then
    result := '' else
  if fInHeaderLastName=HeaderName then
    result := fInHeaderLastValue else begin
    PWord(UpperCopy255(up,HeaderName))^ := ord(':');
    FindNameValue(Call.InHead,up,result);
    if result<>'' then begin
      fInHeaderLastName := HeaderName;
      fInHeaderLastValue := result;
    end;
  end;
end;

const
  COOKIE_MAXCOUNT_DOSATTACK = 512;

procedure TSQLRestServerURIContext.RetrieveCookies;
var n: integer;
    P: PUTF8Char;
    cookie,cn,cv: RawUTF8;
begin
  fInputCookiesRetrieved := true;
  FindNameValue(Call.InHead,'COOKIE:',cookie);
  P := pointer(cookie);
  n := 0;
  while P<>nil do begin
    GetNextItemTrimed(P,'=',cn);
    GetNextItemTrimed(P,';',cv);
    if (cn='') and (cv='') then
      break;
    SetLength(fInputCookies,n+1);
    fInputCookies[n].Name := cn;
    fInputCookies[n].Value := cv;
    inc(n);
    if n>COOKIE_MAXCOUNT_DOSATTACK then
      raise EParsingException.CreateUTF8('%.RetrieveCookies overflow: DOS?',[self]);
  end;
end;

procedure TSQLRestServerURIContext.SetInCookie(CookieName, CookieValue: RawUTF8);
var i,n: integer;
begin
  CookieName := trim(CookieName);
  if (self=nil) or (CookieName='') then
    exit;
  if not fInputCookiesRetrieved then
    RetrieveCookies;
  n := length(fInputCookies);
  for i := 0 to n-1 do
    if fInputCookies[i].Name=CookieName then begin // cookies are case-sensitive
      fInputCookies[i].Value := CookieValue; // in-place update
      exit;
    end;
  SetLength(fInputCookies,n+1);
  fInputCookies[n].Name := CookieName;
  fInputCookies[n].Value := CookieValue;
end;

function TSQLRestServerURIContext.GetInCookie(CookieName: RawUTF8): RawUTF8;
var i: integer;
begin
  result := '';
  CookieName := trim(CookieName);
  if (self=nil) or (CookieName='') then
    exit;
  if not fInputCookiesRetrieved then
    RetrieveCookies;
  for i := 0 to length(fInputCookies)-1 do
    if fInputCookies[i].Name=CookieName then begin // cookies are case-sensitive
      result := fInputCookies[i].Value;
      exit;
    end;
end;

procedure TSQLRestServerURIContext.SetOutSetCookie(aOutSetCookie: RawUTF8);
const
  HTTPONLY: array[boolean] of RawUTF8 = ('; HttpOnly','');
begin
  if self=nil then
    exit;
  aOutSetCookie := Trim(aOutSetCookie);
  if not IsValidUTF8WithoutControlChars(aOutSetCookie) then
    raise EBusinessLayerException.CreateUTF8('Unsafe %.SetOutSetCookie',[self]);
  if PosExChar('=',aOutSetCookie)<2 then
    raise EBusinessLayerException.CreateUTF8(
      '"name=value" expected for %.SetOutSetCookie("%")',[self,aOutSetCookie]);
  if StrPosI('; PATH=',pointer(aOutSetCookie))=nil then
    FormatUTF8('%; Path=/%%',[aOutSetCookie,Server.Model.Root,
      HTTPONLY[rsoCookieHttpOnlyFlagDisable in Server.fOptions]],fOutSetCookie) else
    fOutSetCookie := aOutSetCookie;
end;

function TSQLRestServerURIContext.GetUserAgent: RawUTF8;
begin
  result := Call^.HeaderOnce(fUserAgent,'USER-AGENT: ');
end;

function TSQLRestServerURIContext.GetRemoteIP: RawUTF8;
begin
  result := Call^.HeaderOnce(fRemoteIP,HEADER_REMOTEIP_UPPER);
end;

function TSQLRestServerURIContext.GetRemoteIPNotLocal: RawUTF8;
begin
  result := Call^.HeaderOnce(fRemoteIP,HEADER_REMOTEIP_UPPER);
  if result='127.0.0.1' then
    result := '';
end;

function TSQLRestServerURIContext.GetRemoteIPIsLocalHost: boolean;
begin
  result := (GetRemoteIP='') or (fRemoteIP='127.0.0.1');
end;

function TSQLRestServerURIContext.AuthenticationBearerToken: RawUTF8;
begin
  result := Call^.HeaderOnce(fAuthenticationBearerToken,HEADER_BEARER_UPPER);
  if (result='') and not(rsoAuthenticationURIDisable in Server.Options) then begin
    result := GetInputUTF8OrVoid('authenticationbearer');
    if result<>'' then
      fAuthenticationBearerToken := result;
  end;
end;

function TSQLRestServerURIContext.AuthenticationCheck(jwt: TJWTAbstract): boolean;
begin
  if jwt=nil then
    JWTContent.result := jwtNoToken else
    jwt.Verify(AuthenticationBearerToken,JWTContent);
  result := JWTContent.result=jwtValid;
  if not result then
    Error('Invalid Bearer [%]',[ToText(JWTContent.result)^],HTTP_FORBIDDEN) else
    if (Server.fIPWhiteJWT<>nil) and not Server.fIPWhiteJWT.Exists(RemoteIP) and
       (fRemoteIP<>'') and (fRemoteIP<>'127.0.0.1') then begin
      Error('Invalid IP [%]',[fRemoteIP],HTTP_FORBIDDEN);
      result := false;
    end;
end;

function TSQLRestServerURIContext.ClientKind: TSQLRestServerURIContextClientKind;
var agent: RawUTF8;
begin
  if fClientKind=ckUnknown then
    if Call.InHead='' then // e.g. for WebSockets remote access
      fClientKind := ckAjax else begin
      agent := GetUserAgent;
      if (agent='') or (PosEx('mORMot',agent)>0) then
        // 'mORMot' set e.g. from XPOWEREDPROGRAM value in SynCrtSock
        fClientKind := ckFramework else
        fClientKind := ckAjax;
    end;
  result := fClientKind;
end;

function TSQLRestServerURIContext.IsRemoteAdministrationExecute: boolean;
begin
  result := (self<>nil) and (call.RestAccessRights=@BYPASS_ACCESS_RIGHTS);
end;

function TSQLRestServerURIContext.ClientSQLRecordOptions: TJSONSerializerSQLRecordOptions;
begin
  result := [];
  if (TableRecordProps=nil) or (ClientKind<>ckAjax) then
    exit;
  if rsoGetID_str in Server.Options then
    include(result,jwoID_str);
  if ([sftObject,sftBlobDynArray{$ifndef NOVARIANTS},sftVariant{$endif}]*
     TableRecordProps.Props.HasTypeFields<>[]) and
     (rsoGetAsJsonNotAsString in Server.Options) then
    include(result,jwoAsJsonNotAsString);
end;

function TSQLRestServerURIContext.GetResourceFileName: TFileName;
begin
  if (URIBlobFieldName='') or (PosEx('..',URIBlobFieldName)>0) then
    result := '' else // for security, disallow .. in the supplied file path
    result := UTF8ToString(StringReplaceAll(URIBlobFieldName,'/',PathDelim));
end;

procedure TSQLRestServerURIContext.Returns(const Result: RawUTF8; Status: integer;
  const CustomHeader: RawUTF8; Handle304NotModified,HandleErrorAsRegularResult: boolean;
  CacheControlMaxAge: integer; ServerHash: RawUTF8);
var clientHash: RawUTF8;
begin
  if HandleErrorAsRegularResult or StatusCodeIsSuccess(Status) then begin
    Call.OutStatus := Status;
    Call.OutBody := Result;
    if CustomHeader<>'' then
      Call.OutHead := CustomHeader else
      if Call.OutHead='' then
        Call.OutHead := JSON_CONTENT_TYPE_HEADER_VAR;
    if CacheControlMaxAge>0 then
      Call.OutHead := Call.OutHead+#13#10'Cache-Control: max-age='+UInt32ToUtf8(CacheControlMaxAge);
    if Handle304NotModified and (Status=HTTP_SUCCESS) and
       (Length(Result)>64) then begin
      FindNameValue(Call.InHead,'IF-NONE-MATCH: ',clientHash);
      if ServerHash='' then
        ServerHash := '"'+crc32cUTF8ToHex(Result)+'"';
      ServerHash := '"'+ServerHash+'"';
      if clientHash<>ServerHash then
        Call.OutHead := Call.OutHead+#13#10'ETag: '+ServerHash else begin
        Call.OutBody := ''; // save bandwidth for "304 Not Modified"
        Call.OutStatus := HTTP_NOTMODIFIED;
      end;
    end;
  end else
    Error(Result,Status);
end;

procedure TSQLRestServerURIContext.Returns(Value: TObject; Status: integer;
  Handle304NotModified: boolean; SQLRecordOptions: TJSONSerializerSQLRecordOptions;
  const CustomHeader: RawUTF8);
var json: RawUTF8;
begin
  if Value.InheritsFrom(TSQLRecord) then
    json := TSQLRecord(Value).GetJSONValues(true,true,soSelect,nil,SQLRecordOptions) else
    json := ObjectToJSON(Value);
  Returns(json,Status,CustomHeader,Handle304NotModified);
end;

procedure TSQLRestServerURIContext.ReturnsJson(const Value: Variant; Status: integer;
  Handle304NotModified: boolean; Escape: TTextWriterKind; MakeHumanReadable: boolean;
  const CustomHeader: RawUTF8);
var json: RawUTF8;
    tmp: TSynTempBuffer;
begin
  VariantSaveJSON(Value,Escape,json);
  if MakeHumanReadable and (json<>'') and (json[1] in ['{','[']) then begin
    tmp.Init(json);
    try
      JSONBufferReformat(tmp.buf,json);
    finally
      tmp.Done;
    end;
  end;
  Returns(json,Status,CustomHeader,Handle304NotModified);
end;

procedure TSQLRestServerURIContext.ReturnBlob(const Blob: RawByteString;
  Status: integer; Handle304NotModified: boolean; const FileName: TFileName;
  CacheControlMaxAge: integer);
begin
  if not ExistsIniName(pointer(Call.OutHead),HEADER_CONTENT_TYPE_UPPER) then
    AddToCSV(GetMimeContentTypeHeader(Blob,FileName),Call.OutHead,#13#10);
  Returns(Blob,Status,Call.OutHead,Handle304NotModified,false,CacheControlMaxAge);
end;

procedure TSQLRestServerURIContext.ReturnFile(const FileName: TFileName;
  Handle304NotModified: boolean; const ContentType,AttachmentFileName,
  Error404Redirect: RawUTF8; CacheControlMaxAge: integer);
var FileTime: TDateTime;
    clientHash, serverHash: RawUTF8;
begin
  if FileName='' then
    FileTime := 0 else
    FileTime := FileAgeToDateTime(FileName);
  if FileTime=0 then
    if Error404Redirect<>'' then
      Redirect(Error404Redirect) else
      Error('',HTTP_NOTFOUND,CacheControlMaxAge) else begin
    if not ExistsIniName(pointer(Call.OutHead),HEADER_CONTENT_TYPE_UPPER) then begin
      if Call.OutHead<>'' then
        Call.OutHead := Call.OutHead+#13#10;
      if ContentType<>'' then
        Call.OutHead := Call.OutHead+HEADER_CONTENT_TYPE+ContentType else
        Call.OutHead := Call.OutHead+GetMimeContentTypeHeader('',FileName);
    end;
    if CacheControlMaxAge>0 then
      Call.OutHead := Call.OutHead+#13#10'Cache-Control: max-age='+UInt32ToUtf8(CacheControlMaxAge);
    Call.OutStatus := HTTP_SUCCESS;
    if Handle304NotModified then begin
      FindNameValue(Call.InHead,'IF-NONE-MATCH:',clientHash);
      serverHash := '"'+DateTimeToIso8601(FileTime,false,'T',true)+'"';
      Call.OutHead := Call.OutHead+#13#10'ETag: '+serverHash;
      if clientHash=serverHash then begin
        Call.OutStatus := HTTP_NOTMODIFIED;
        exit;
      end;
    end;
    // Content-Type: appears twice: 1st to notify static file, 2nd for mime type
    Call.OutHead := STATICFILE_CONTENT_TYPE_HEADER+#13#10+Call.OutHead;
    StringToUTF8(FileName,Call.OutBody); // body=filename for STATICFILE_CONTENT
    if AttachmentFileName<>'' then
      Call.OutHead := Call.OutHead+
        #13#10'Content-Disposition: attachment; filename="'+AttachmentFileName+'"';
  end;
end;

procedure TSQLRestServerURIContext.ReturnFileFromFolder(const FolderName: TFileName;
  Handle304NotModified: boolean; const DefaultFileName: TFileName;
  const Error404Redirect: RawUTF8; CacheControlMaxAge: integer);
var fileName: TFileName;
begin
  if URIBlobFieldName='' then
    fileName := DefaultFileName else
    if PosEx('..',URIBlobFieldName)>0 then
      fileName := '' else
      fileName := UTF8ToString(StringReplaceChars(URIBlobFieldName,'/',PathDelim));
  if fileName<>'' then
    fileName := IncludeTrailingPathDelimiter(FolderName)+fileName;
  ReturnFile(fileName,Handle304NotModified,'','',Error404Redirect,CacheControlMaxAge);
end;

procedure TSQLRestServerURIContext.Redirect(const NewLocation: RawUTF8;
  PermanentChange: boolean);
begin
  if PermanentChange then
    Call.OutStatus := HTTP_MOVEDPERMANENTLY else
    Call.OutStatus := HTTP_TEMPORARYREDIRECT;
  Call.OutHead := 'Location: '+NewLocation;
end;

procedure TSQLRestServerURIContext.Returns(const NameValuePairs: array of const;
  Status: integer; Handle304NotModified,HandleErrorAsRegularResult: boolean;
  const CustomHeader: RawUTF8);
begin
  Returns(JSONEncode(NameValuePairs),Status,CustomHeader,Handle304NotModified,
    HandleErrorAsRegularResult);
end;

procedure TSQLRestServerURIContext.Results(const Values: array of const;
  Status: integer; Handle304NotModified: boolean; CacheControlMaxAge: integer);
var i,h: integer;
    result: RawUTF8;
    temp: TTextWriterStackBuffer;
begin
  h := high(Values);
  if h<0 then
    result := '{"result":null}' else
    with TJSONSerializer.CreateOwnedStream(temp) do
    try
      AddShort('{"result":');
      if h=0 then
        // result is one value
        AddJSONEscape(Values[0]) else begin
        // result is one array of values
        Add('[');
        i := 0;
        repeat
          AddJSONEscape(Values[i]);
          if i=h then break;
          Add(',');
          inc(i);
        until false;
        Add(']');
      end;
      Add('}');
      SetText(result);
    finally
      Free;
    end;
  Returns(result,Status,'',Handle304NotModified,false,CacheControlMaxAge);
end;


procedure TSQLRestServerURIContext.Success(Status: integer);
begin
  if StatusCodeIsSuccess(Status) then
    Call.OutStatus := Status else
    Error('',Status);
end;

procedure TSQLRestServerURIContext.Error(const Format: RawUTF8;
  const Args: array of const; Status, CacheControlMaxAge: integer);
var msg: RawUTF8;
begin
  FormatUTF8(Format,Args,msg);
  Error(msg,Status,CacheControlMaxAge);
end;

procedure TSQLRestServerURIContext.Error(E: Exception;
  const Format: RawUTF8; const Args: array of const; Status: integer);
var msg,exc: RawUTF8;
begin
  FormatUTF8(Format,Args,msg);
  if E=nil then
    Error(msg,Status) else begin
    exc := ObjectToJSONDebug(E);
    if msg='' then
      Error('{"%":%}',[E,exc],Status) else
      Error(FormatUTF8('{"msg":?,"%":%}',[E,exc],[msg],true),Status);
  end;
end;

procedure TSQLRestServerURIContext.Error(const ErrorMessage: RawUTF8;
  Status, CacheControlMaxAge: integer);
var ErrorMsg: RawUTF8;
    temp: TTextWriterStackBuffer;
begin
  Call.OutStatus := Status;
  if StatusCodeIsSuccess(Status) then begin // not an error
    Call.OutBody := ErrorMessage;
    if CacheControlMaxAge<>0 then // Cache-Control is ignored for errors
      Call.OutHead := 'Cache-Control: max-age='+UInt32ToUtf8(CacheControlMaxAge);
    exit;
  end;
  if ErrorMessage='' then
    StatusCodeToErrorMessage(Status,ErrorMsg) else
    ErrorMsg := ErrorMessage;
  with TTextWriter.CreateOwnedStream(temp) do
  try
    AddShort('{'#13#10'"errorCode":');
    Add(call.OutStatus);
    if (ErrorMsg<>'') and (ErrorMsg[1]='{') and (ErrorMsg[length(ErrorMsg)]='}') then begin
      AddShort(','#13#10'"error":'#13#10);
      AddNoJSONEscape(pointer(ErrorMsg),length(ErrorMsg));
      AddShort(#13#10'}');
    end else begin
      AddShort(','#13#10'"errorText":"');
      AddJSONEscape(pointer(ErrorMsg));
      AddShort('"'#13#10'}');
    end;
    SetText(Call.OutBody);
  finally
    Free;
  end;
  Server.InternalLog('%.Error: %',[ClassType,Call.OutBody],sllDebug);
end;


{ TSQLRestRoutingREST }

procedure TSQLRestRoutingREST.URIDecodeSOAByInterface;
var i: integer;
    method,clientdrivenid: RawUTF8;
begin
  if (Table=nil) and (MethodIndex<0) and (URI<>'') and (Server.Services<>nil) then begin
    // check URI as '/Model/Interface.Method[/ClientDrivenID]'
    i := Server.Services.fInterfaceMethods.FindHashed(URI);
    if i>=0 then // no specific message: it may be a valid request
      with Server.Services.fInterfaceMethod[i] do begin
        Service := TServiceFactoryServer(InterfaceService);
        ServiceMethodIndex := InterfaceMethodIndex;
        fServiceListInterfaceMethodIndex := i;
        i := ServiceMethodIndex-SERVICE_PSEUDO_METHOD_COUNT;
        if i>=0 then
          ServiceMethod := @Service.fInterface.fMethods[i];
        ServiceInstanceID := GetInteger(pointer(URIBlobFieldName));
      end else
      if URIBlobFieldName<>'' then begin
        // check URI as '/Model/Interface/Method[/ClientDrivenID]''
        i := Server.Services.fInterfaces.FindHashed(URI);
        if i>=0 then begin // identified as a valid JSON-RPC service
          Service := TServiceFactoryServer(Server.Services.fInterface[i].Service);
          Split(URIBlobFieldName,'/',method,clientdrivenid);
          ServiceMethodIndex := Service.InterfaceFactory.FindMethodIndex(method);
          if ServiceMethodIndex<0 then
            Service := nil else begin
            ServiceMethod := @Service.fInterface.fMethods[ServiceMethodIndex];
            inc(ServiceMethodIndex,SERVICE_PSEUDO_METHOD_COUNT);
            fServiceListInterfaceMethodIndex := -1;
            ServiceInstanceID := GetInteger(pointer(clientdrivenid));
          end;
        end;
      end;
  end;
end;

procedure TSQLRestRoutingREST.ExecuteSOAByInterface;
var JSON: RawUTF8;
  procedure DecodeUriParametersIntoJSON(const input: TRawUTF8DynArray);
  var a,i,iLow: Integer;
      WR: TTextWriter;
      argDone: boolean;
      temp: TTextWriterStackBuffer;
  begin
    WR := TJSONSerializer.CreateOwnedStream(temp);
    try // convert URI parameters into the expected ordered JSON array
      WR.Add('[');
      with PServiceMethod(ServiceMethod)^ do begin
        iLow := 0;
        for a := ArgsInFirst to ArgsInLast do
        with Args[a] do
        if ValueDirection<>smdOut then begin
          argDone := false;
          for i := iLow to high(input) shr 1 do // search argument in URI
            if IdemPropNameU(input[i*2],@ParamName^[1],ord(ParamName^[0])) then begin
              AddValueJSON(WR,input[i*2+1]); // will add "" if needed
              if i=iLow then
                inc(iLow); // optimistic in-order search, but allow any order
              argDone := true;
              break;
            end;
          if not argDone then
            AddDefaultJSON(WR); // allow missing argument (and add ',')
        end;
      end;
      WR.CancelLastComma;
      WR.Add(']');
      WR.SetText(JSON);
    finally
      WR.Free;
    end;
  end;
var Par: PUTF8Char;
begin // here Ctxt.Service and ServiceMethod(Index) are set
  if (Server.Services=nil) or (Service=nil) then
    raise EServiceException.CreateUTF8('%.ExecuteSOAByInterface invalid call',[self]);
  //  URI as '/Model/Interface.Method[/ClientDrivenID]'
  if Call.InBody<>'' then
    // parameters sent as JSON array/object (the Delphi/AJAX way) or single blob
    if (ServiceMethod<>nil) and PServiceMethod(ServiceMethod)^.ArgsInputIsOctetStream and
       not Call.InBodyTypeIsJson then begin
      JSON := BinToBase64(Call.InBody,'["','"]',false);
      ServiceParameters := pointer(JSON); // as expected by InternalExecuteSOAByInterface
    end else
      ServiceParameters := pointer(Call.InBody) else begin
    // no body -> try URI-encoded parameters (the HTML way)
    Par := Parameters;
    if Par<>nil then begin
      while Par^='+' do inc(Par); // ignore trailing spaces
      if (Par^='[') or IdemPChar(Par,'%5B') then
        // as JSON array (input is e.g. '+%5B...' for ' [...')
        JSON := UrlDecode(Parameters) else begin
        // or as a list of parameters (input is 'Param1=Value1&Param2=Value2...')
        FillInput; // fInput[0]='Param1',fInput[1]='Value1',fInput[2]='Param2'...
        if (fInput<>nil) and (ServiceMethod<>nil) then
          DecodeUriParametersIntoJSON(fInput);
      end;
    end;
    ServiceParameters := pointer(JSON);
  end;
  // now Service, ServiceParameters, ServiceMethod(Index) are set
  InternalExecuteSOAByInterface;
end;

class procedure TSQLRestRoutingREST.ClientSideInvoke(var uri: RawUTF8;
  ctxt: TSQLRestServerURIContextClientInvoke;
  const method, params, clientDrivenID: RawUTF8; out sent,head: RawUTF8);
begin
  if clientDrivenID<>'' then
    uri := uri+'.'+method+'/'+clientDrivenID else
    uri := uri+'.'+method;
  if (csiAsOctetStream in ctxt) and (length(params)>2) and (params[1]='"') then begin
    sent := Base64ToBin(@params[2],length(params)-2);
    if sent<>'' then begin
      head := BINARY_CONTENT_TYPE_HEADER;
      exit;
    end;
  end;
  sent := '['+params+']'; // we may also encode them within the URI
end;


{ TSQLRestRoutingJSON_RPC }

procedure TSQLRestRoutingJSON_RPC.URIDecodeSOAByInterface;
var i: integer;
begin
  if (Table=nil) and (MethodIndex<0) and (URI<>'') and (Server.Services<>nil) then begin
    //  URI as '/Model/Interface'
    i := Server.Services.fInterfaces.FindHashed(URI);
    if i>=0 then // identified as a valid JSON-RPC service
      Service := TServiceFactoryServer(Server.Services.fInterface[i].Service);
  end; // ServiceMethodIndex will be retrieved from "method": in body
end;

procedure TSQLRestRoutingJSON_RPC.ExecuteSOAByInterface;
var method: RawUTF8;
    Values: array[0..2] of TValuePUTF8Char;
    internal: TServiceInternalMethod;
    tmp: TSynTempBuffer;
begin // here Ctxt.Service is set (not ServiceMethodIndex yet)
  if (Server.Services=nil) or (Service=nil) then
    raise EServiceException.CreateUTF8('%.ExecuteSOAByInterface invalid call',[self]);
  tmp.Init(call.Inbody);
  try
    JSONDecode(tmp.buf,['method','params','id'],@Values,true);
    if Values[0].Value=nil then // Method name required
      exit;
    Values[0].ToUTF8(method);
    ServiceParameters := Values[1].Value;
    ServiceInstanceID := Values[2].ToCardinal; // retrieve "id":ClientDrivenID
    ServiceMethodIndex := Service.fInterface.FindMethodIndex(method);
    if ServiceMethodIndex>=0 then
      inc(ServiceMethodIndex,SERVICE_PSEUDO_METHOD_COUNT) else begin
      for internal := low(TServiceInternalMethod) to high(TServiceInternalMethod) do
        if IdemPropNameU(method,SERVICE_PSEUDO_METHOD[internal]) then begin
          ServiceMethodIndex := ord(internal);
          break;
        end;
      if ServiceMethodIndex<0 then begin
        Error('Unknown method');
        exit;
      end;
    end;
    // now Service, ServiceParameters, ServiceMethod(Index) are set
    InternalExecuteSOAByInterface;
    ServiceParameters := nil;
  finally
    tmp.Done; // release temp storage for Values[] = Service* fields
  end;
end;

class procedure TSQLRestRoutingJSON_RPC.ClientSideInvoke(var uri: RawUTF8;
  ctxt: TSQLRestServerURIContextClientInvoke;
  const method, params, clientDrivenID: RawUTF8; out sent,head: RawUTF8);
begin
  sent := '{"method":"'+method+'","params":['+params;
  if clientDrivenID='' then
    sent := sent+']}' else
    sent := sent+'],"id":'+clientDrivenID+'}';
end;

function TSQLRestServer.ServiceRegister(
  aImplementationClass: TInterfacedClass; const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactoryServer;
begin
  if (aImplementationClass=nil) or (high(aInterfaces)<0) then
    result := nil else
    result := (ServiceContainer as TServiceContainerServer).
      AddImplementation(aImplementationClass,aInterfaces,aInstanceCreation,nil,aContractExpected);
end;

function TSQLRestServer.ServiceRegister(aSharedImplementation: TInterfacedObject;
  const aInterfaces: array of PTypeInfo; const aContractExpected: RawUTF8): TServiceFactoryServer;
begin
  if (self=nil) or (aSharedImplementation=nil) or (high(aInterfaces)<0) then
    result := nil else
    result := (ServiceContainer as TServiceContainerServer).
      AddImplementation(TInterfacedClass(aSharedImplementation.ClassType),
        aInterfaces,sicShared,aSharedImplementation,aContractExpected);
end;

function TSQLRestServer.ServiceRegister(aClient: TSQLRest;
  const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): boolean;
begin
  result := False;
  if (self=nil) or (high(aInterfaces)<0) or (aClient=nil) then
    exit;
  result := (ServiceContainer as TServiceContainerServer).AddInterface(
    aInterfaces,aInstanceCreation,aContractExpected);
end;

function TSQLRestServer.ServiceDefine(aImplementationClass: TInterfacedClass;
  const aInterfaces: array of TGUID; aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactoryServer;
var ti: PTypeInfoDynArray;
begin
  ti := TInterfaceFactory.GUID2TypeInfo(aInterfaces);
  result := ServiceRegister(aImplementationClass,ti,aInstanceCreation,aContractExpected);
end;

function TSQLRestServer.ServiceDefine(aSharedImplementation: TInterfacedObject;
  const aInterfaces: array of TGUID; const aContractExpected: RawUTF8): TServiceFactoryServer;
var ti: PTypeInfoDynArray;
begin
  ti := TInterfaceFactory.GUID2TypeInfo(aInterfaces);
  result := ServiceRegister(aSharedImplementation,ti,aContractExpected);
end;

function TSQLRestServer.ServiceDefine(aClient: TSQLRest;
  const aInterfaces: array of TGUID;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): boolean;
var ti: PTypeInfoDynArray;
begin
  ti := TInterfaceFactory.GUID2TypeInfo(aInterfaces);
  result := ServiceRegister(aClient,ti,aInstanceCreation,aContractExpected);
end;

procedure TSQLRestServer.URI(var Call: TSQLRestURIParams);
const COMMANDTEXT: array[TSQLRestServerURIContextCommand] of string[9] =
  ('?','Method','Interface','Read','Write');
var Ctxt: TSQLRestServerURIContext;
    timeStart,timeEnd: Int64;
    elapsed, len: cardinal;
    outcomingfile: boolean;
    safeid: integer;
    P: PUTF8Char;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter('URI % % in=%',[Call.Method,Call.Url,KB(Call.InBody)],self);
  {$endif}
  {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(timeStart);
  fStats.AddCurrentRequestCount(1);
  if Assigned(fOnDecryptBody) then
    fOnDecryptBody(self,Call.InBody,Call.InHead,Call.Url);
  Call.OutStatus := HTTP_BADREQUEST; // default error code is 400 BAD REQUEST
  safeid := 0;
  if (fSafeProtocol<>nil) and IdemPropNameU(Call.Method,'POST') then begin
    P := pointer(Call.Url);
    if P^='/' then
      inc(P); // may be /modelroot/_safe_
    if IdemPChar(P,pointer(fSafeRootUpper)) then begin // 'ROOT/_SAFE_/'
      InternalSafeProtocol(Call,safeid);
      if safeid=0 then
        exit; // low-level error
    end;
  end;
  Ctxt := ServicesRouting.Create(self,Call);
  try
    {$ifdef WITHLOG}
    if log<>nil then
      Ctxt.Log := log.Instance;
    {$endif}
    Ctxt.SafeProtocolID := safeID;
    if fShutdownRequested then
      Ctxt.Error('Server is shutting down',HTTP_UNAVAILABLE) else
    if Ctxt.Method=mNone then
      Ctxt.Error('Unknown Verb %',[Call.Method]) else
    if (fIPBan<>nil) and fIPBan.Exists(Ctxt.RemoteIP) then
      Ctxt.Error('Banned IP %',[Ctxt.fRemoteIP]) else
    // 1. decode URI
    if not Ctxt.URIDecodeREST then
      Ctxt.Error('Invalid Root',HTTP_NOTFOUND) else
    if (RootRedirectGet<>'') and (Ctxt.Method=mGet) and
       (Call.Url=Model.Root) and (Call.InBody='') then
      Ctxt.Redirect(RootRedirectGet) else begin
      Ctxt.URIDecodeSOAByMethod;
      if (Ctxt.MethodIndex<0) and (Ctxt.URI<>'') then
        Ctxt.URIDecodeSOAByInterface;
      // 2. handle security
      if (rsoSecureConnectionRequired in fOptions) and
         (Ctxt.MethodIndex<>fPublishedMethodTimestampIndex) and
         not (llfSecured in Call.LowLevelFlags) then
        Ctxt.AuthenticationFailed(afSecureConnectionRequired) else
      if not Ctxt.Authenticate then
        Ctxt.AuthenticationFailed(afInvalidSignature) else
      if (Ctxt.Service<>nil) and
          not (reService in Call.RestAccessRights^.AllowRemoteExecute) then
        if (rsoRedirectForbiddenToAuth in Options) and (Ctxt.ClientKind=ckAjax) then
          Ctxt.Redirect(Model.Root+'/auth') else
          Ctxt.AuthenticationFailed(afRemoteServiceExecutionNotAllowed) else
      if (Ctxt.Session<>CONST_AUTHENTICATION_NOT_USED) or
         (fJWTForUnauthenticatedRequest=nil) or
         (Ctxt.MethodIndex=fPublishedMethodTimestampIndex) or
         ((llfSecured in Call.LowLevelFlags) and
          not (llfHttps in Call.LowLevelFlags)) or // HTTPS does not authenticate
         Ctxt.AuthenticationCheck(fJWTForUnauthenticatedRequest) then
      // 3. call appropriate ORM / SOA commands in fAcquireExecution[] context
      try
        if Ctxt.MethodIndex>=0 then
          if Ctxt.MethodIndex=fPublishedMethodBatchIndex then
            Ctxt.Command := execORMWrite else
            Ctxt.Command := execSOAByMethod else
        if Ctxt.Service<>nil then
          Ctxt.Command := execSOAByInterface else
        if Ctxt.Method in [mLOCK,mGET,mUNLOCK,mSTATE] then
          // handle read methods
          Ctxt.Command := execORMGet else
          // write methods (mPOST, mPUT, mDELETE...)
          Ctxt.Command := execORMWrite;
        if not Assigned(OnBeforeURI) or OnBeforeURI(Ctxt) then
          Ctxt.ExecuteCommand;
      except
        on E: Exception do
          if not Assigned(OnErrorURI) or OnErrorURI(Ctxt,E) then
            if E.ClassType=EInterfaceFactoryException then
              Ctxt.Error(E,'',[],HTTP_NOTACCEPTABLE) else
              Ctxt.Error(E,'',[],HTTP_SERVERERROR);
      end;
    end;
    // 4. return expected result to the client and update Server statistics
    if StatusCodeIsSuccess(Call.OutStatus) then begin
      outcomingfile := false;
      if Call.OutBody<>'' then begin
        len := length(Call.OutHead);
        outcomingfile := (len>=25) and (Call.OutHead[15]='!') and
          IdemPChar(pointer(Call.OutHead),STATICFILE_CONTENT_TYPE_HEADER_UPPPER);
      end else // Call.OutBody=''
        if (Call.OutStatus=HTTP_SUCCESS) and
           (rsoHttp200WithNoBodyReturns204 in fOptions) then
          Call.OutStatus := HTTP_NOCONTENT;
      fStats.ProcessSuccess(outcomingfile);
    end else begin
      fStats.ProcessErrorNumber(Call.OutStatus);
      if Call.OutBody='' then // if no custom error message, compute it now as JSON
        Ctxt.Error(Ctxt.CustomErrorMsg,Call.OutStatus);
    end;
    StatsAddSizeForCall(fStats,Call);
    if (rsoNoInternalState in fOptions) and (Ctxt.Method<>mSTATE) then
      Call.OutInternalState := 0 // reduce headers verbosity
    else if (Ctxt.Static<>nil) and Ctxt.Static.InheritsFrom(TSQLRestStorage) and
       TSQLRestStorage(Ctxt.Static).fOutInternalStateForcedRefresh then
      // force always refresh for Static table which demands it
      Call.OutInternalState := cardinal(-1) else
      // database state may have changed above
      Call.OutInternalState := InternalState;
    if Ctxt.OutSetCookie<>'' then begin
      Call.OutHead := Trim(Call.OutHead+#13#10'Set-Cookie: '+Ctxt.OutSetCookie);
      if rsoCookieIncludeRootPath in fOptions then
        Call.OutHead := Call.OutHead+'; Path=/'; // case-sensitive Path=/ModelRoot
    end;
    if not (rsoHttpHeaderCheckDisable in fOptions) and
       IsInvalidHttpHeader(pointer(Call.OutHead), length(Call.OutHead)) then
      Ctxt.Error('Unsafe HTTP header rejected [%]', [EscapeToShort(Call.OutHead)], HTTP_SERVERERROR);
  finally
    {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(timeEnd);
    Ctxt.MicroSecondsElapsed := fStats.FromExternalQueryPerformanceCounters(timeEnd-timeStart);
    {$ifdef WITHLOG}
    InternalLog('% % % %/% %=% out=% in %',
      [Ctxt.SessionUserName,Ctxt.RemoteIPNotLocal,Call.Method,Model.Root,Ctxt.URI,
       COMMANDTEXT[Ctxt.Command],Call.OutStatus,KB(Call.OutBody),
       MicroSecToString(Ctxt.MicroSecondsElapsed)],sllServer);
    if (Call.OutBody<>'') and (sllServiceReturn in fLogFamily.Level) then
      if not(optNoLogOutput in Ctxt.ServiceExecutionOptions) then
        if IsHTMLContentTypeTextual(pointer(Call.OutHead)) then
          fLogFamily.SynLog.Log(sllServiceReturn,Call.OutBody,self,MAX_SIZE_RESPONSE_LOG);
    {$endif}
    if mlTables in StatLevels then
      case Ctxt.Command of
      execORMGet:
        fStats.NotifyORMTable(Ctxt.TableIndex,length(Call.OutBody),false,Ctxt.MicroSecondsElapsed);
      execORMWrite:
        fStats.NotifyORMTable(Ctxt.TableIndex,length(Call.InBody),true,Ctxt.MicroSecondsElapsed);
      end;
    fStats.AddCurrentRequestCount(-1);
    if fStatUsage<>nil then
      fStatUsage.Modified(fStats,[]);
    if Assigned(OnAfterURI) then
      try
        OnAfterURI(Ctxt);
      except
      end;
    if Assigned(fOnEncryptBody) then
      fOnEncryptBody(self,Call.OutBody,Call.OutHead,Call.Url);
    Ctxt.Free;
  end;
  if safeid<>0 then
    InternalSafeProtocol(Call,safeid); // encrypt Call.OutBody+OutHead
  if Assigned(OnIdle) then begin
    elapsed := GetTickCount64 shr 7; // trigger every 128 ms
    if elapsed<>fOnIdleLastTix then begin
      OnIdle(self);
      fOnIdleLastTix := elapsed;
    end;
  end;
end;

function TSQLRestServer.StatsAsJson(Flags: TSQLRestServerAddStats): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin // emulates root/stat?withall=1 method call
  W := TJSONSerializer.CreateOwnedStream(temp);
  try
    AddStat(Flags,W);
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TSQLRestServer.StatsAsDocVariant(Flags: TSQLRestServerAddStats): variant;
begin
  _Json(StatsAsJson(Flags),result,JSON_OPTIONS_FAST);
end;

{$ifndef NOVARIANTS}
procedure TSQLRestServer.InternalInfo(var info: TDocVariantData);
var cpu,mem,free: RawUTF8;
    now: TTimeLogBits;
    m: TSynMonitorMemory;
begin // called by root/Timestamp/info REST method
  now.Value := ServerTimestamp;
  cpu := TSystemUse.Current(false).HistoryText(0,15,@mem);
  m := TSynMonitorMemory.Create({nospace=}true);
  try
    FormatUTF8('%/%',[m.PhysicalMemoryFree.Text,m.PhysicalMemoryTotal.Text],free);
    info.AddNameValuesToObject(['nowutc',now.Text(true,' ') , 'timestamp',now.Value,
      'exe',ExeVersion.ProgramName, 'version',ExeVersion.Version.DetailedOrVoid,
      'host',ExeVersion.Host, 'cpu',cpu, {$ifdef MSWINDOWS}'mem',mem,{$endif}
      'memused',KB(m.AllocatedUsed.Bytes), 'memfree',free,
      'diskfree',GetDiskPartitionsText({nocache=}false,{withfree=}true,{nospace=}true),
      'exception',GetLastExceptions(10)]);
  finally
    m.Free;
  end;
  Stats.Lock;
  try
    info.AddNameValuesToObject([
      'started',Stats.StartDate, 'clients',Stats.ClientsCurrent,
      'methods',Stats.ServiceMethod, 'interfaces',Stats.ServiceInterface,
      'total',Stats.TaskCount, 'time',Stats.TotalTime.Text]);
  finally
    Stats.Unlock;
  end;
  if Assigned(OnInternalInfo) then
    OnInternalInfo(self,info);
end;
{$endif}

procedure TSQLRestServer.InternalStat(Ctxt: TSQLRestServerURIContext; W: TTextWriter);
var flags: TSQLRestServerAddStats;
begin
  if Ctxt.InputExists['withall'] then
    flags := [low(TSQLRestServerAddStat)..high(TSQLRestServerAddStat)] else begin
    flags := [];
    if Ctxt.InputExists['withtables'] then
      include(flags, withtables);
    if Ctxt.InputExists['withmethods'] then
      include(flags, withmethods);
    if Ctxt.InputExists['withinterfaces'] then
      include(flags, withinterfaces);
    if Ctxt.InputExists['withsessions'] then
      include(flags, withsessions);
  end;
  AddStat(flags,W);
end;

procedure TSQLRestServer.AddStat(Flags: TSQLRestServerAddStats; W: TTextWriter);
const READWRITE: array[boolean] of string[9] = ('{"read":','{"write":');
var s,i: integer;
    rw: boolean;
begin
  Stats.ComputeDetailsTo(W);
  W.CancelLastChar('}');
  if fCache<>nil then begin
    W.AddShort(',"cachedMemoryBytes":');
    W.AddU(fCache.CachedMemory); // will also flush outdated JSON
    W.Add(',');
  end;
  if (fBackgroundTimer<>nil) and (fBackgroundTimer.Stats<>nil) then begin
    W.CancelLastComma;
    W.AddShort(',"backgroundTimer":');
    fBackgroundTimer.Stats.ComputeDetailsTo(W);
    W.Add(',');
  end;
  if withtables in flags then begin
    W.CancelLastComma;
    W.AddShort(',"tables":[');
    Stats.Lock; // thread-safe Stats.fPerTable[] access
    try
      for i := 0 to fModel.TablesMax do begin
        W.Add('{"%":[',[fModel.TableProps[i].Props.SQLTableName]);
        for rw := False to True do
          if (i<Length(Stats.fPerTable[rw])) and
             (Stats.fPerTable[rw,i]<>nil) and
             (Stats.fPerTable[rw,i].TaskCount<>0) then begin
            W.AddShort(READWRITE[rw]);
            Stats.fPerTable[rw,i].ComputeDetailsTo(W);
            W.Add('}',',');
          end;
        W.CancelLastComma;
        W.AddShort(']},');
      end;
    finally
      Stats.UnLock;
    end;
    W.CancelLastComma;
    W.Add(']',',');
  end;
  if withmethods in flags then begin
    W.CancelLastComma;
    W.AddShort(',"methods":[');
    for i := 0 to high(fPublishedMethod) do
      with fPublishedMethod[i] do
      if (Stats<>nil) and (Stats.TaskCount<>0) then begin
        W.Add('{"%":',[Name]);
        Stats.ComputeDetailsTo(W);
        W.Add('}',',');
      end;
    W.CancelLastComma;
    W.Add(']',',');
  end;
  if withinterfaces in flags then begin
    W.CancelLastComma;
    W.AddShort(',"interfaces":[');
    for s := 0 to fServices.Count-1 do
    with fServices.Index(s) as TServiceFactoryServer do
      for i := 0 to fInterface.MethodsCount-1 do
      if fStats[i]<>nil then begin
        W.Add('{"%":',[fInterface.fMethods[i].InterfaceDotMethodName]);
        fStats[i].ComputeDetailsTo(W);
        W.Add('}',',');
      end;
    W.CancelLastComma;
    W.Add(']',',');
  end;
  if (withsessions in flags) and (fSessions<>nil) then begin
    W.CancelLastComma;
    W.AddShort(',"sessions":[');
    fSessions.Safe.Lock;
    try
      for s := 0 to fSessions.Count-1 do begin
        W.WriteObject(fSessions.List[s]);
        W.CancelLastChar('}');
        with TAuthSession(fSessions.List[s]) do begin
          W.AddShort(',"methods":[');
          for i := 0 to high(fMethods) do
            if fMethods[i]<>nil then begin
              W.Add('{"%":',[fPublishedMethod[i].Name]);
              fMethods[i].ComputeDetailsTo(W);
              W.Add('}',',');
            end;
          W.CancelLastComma;
          W.AddShort('],"interfaces":[');
          for i := 0 to high(fInterfaces) do
            if fInterfaces[i]<>nil then begin
              W.Add('{"%":',[Services.fInterfaceMethod[i].InterfaceDotMethodName]);
              fInterfaces[i].ComputeDetailsTo(W);
              W.Add('}',',');
            end;
          W.CancelLastComma;
          W.AddShort(']},');
        end;
      end;
    finally
      fSessions.Safe.UnLock;
    end;
    W.CancelLastComma;
    W.Add(']',',');
  end;
  W.CancelLastComma;
  W.Add('}');
end;

procedure TSQLRestServer.Stat(Ctxt: TSQLRestServerURIContext);
var W: TTextWriter;
    json,xml,name: RawUTF8;
    temp: TTextWriterStackBuffer;
begin
  W := TJSONSerializer.CreateOwnedStream(temp);
  try
    name := Ctxt.InputUTF8OrVoid['findservice'];
    if name='' then begin
      InternalStat(Ctxt,W);
      name := 'Stats';
    end else
      AssociatedServices.FindServiceAll(name,W);
    W.SetText(json);
    if Ctxt.InputExists['format'] or
       IdemPropNameU(Ctxt.URIBlobFieldName,'json') then
      json := JSONReformat(json) else
      if IdemPropNameU(Ctxt.URIBlobFieldName,'xml') then begin
        JSONBufferToXML(pointer(json),XMLUTF8_HEADER,'<'+name+'>',xml);
        Ctxt.Returns(xml,200,XML_CONTENT_TYPE_HEADER);
        exit;
      end;
    Ctxt.Returns(json);
  finally
    W.Free;
  end;
end;

procedure TSQLRestServer.SetStatUsage(usage: TSynMonitorUsage);
begin
  if fStatUsage=usage then
    exit;
  if usage=nil then begin
    // e.g. from TTestServiceOrientedArchitecture.ClientSideRESTSessionsStats
    FreeAndNil(fStatUsage);
    exit;
  end;
  if fStatUsage<>nil then
    raise EModelException.CreateUTF8('%.StatUsage should be set once', [self]);
  fStatUsage := usage;
  fStatUsage.Track(fStats,'rest');
end;

procedure TSQLRestServer.AdministrationExecute(const DatabaseName,SQL: RawUTF8;
  var result: TServiceCustomAnswer);
var isAjax: boolean;
    name,interf,method: RawUTF8;
    obj: TObject;
    call: TSQLRestURIParams;
    info: TDocVariantData;
    P: PUTF8Char;

  procedure PrepareCall;
  begin
    call.Init;
    call.LowLevelFlags := [llfSecured]; // admin access considered as safe
    BYPASS_ACCESS_RIGHTS := SUPERVISOR_ACCESS_RIGHTS;
    call.RestAccessRights := @BYPASS_ACCESS_RIGHTS;
    call.Url := Model.Root;
  end;

begin
  isAjax := not NoAjaxJson;
  if isAjax then
    NoAjaxJson := true; // reduce memory use from a Delphi (ToolsAdmin) tool
  try
    if (SQL<>'') and (SQL[1]='#') then begin
      P := @SQL[2];
      case IdemPCharArray(P,['INTERFACES','STATS(','STATS','SERVICES','SESSIONS',
        'GET','POST','WRAPPER','HELP','INFO']) of
      0: result.Content := ServicesPublishedInterfaces;
      1: begin
        name := copy(SQL,8,length(SQL)-8);
        obj := ServiceMethodStat[name];
        if obj=nil then begin
          Split(name,'.',interf,method);
          obj := Services[interf];
          if obj<>nil then
            obj := (obj as TServiceFactoryServer).Stat[method] else
            obj := nil;
        end;
        if obj<>nil then
          result.Content := ObjectToJSON(obj);
      end;
      2: result.Content := StatsAsJson;
      3: result.Content := Services.AsJson;
      4: result.Content := SessionsAsJson;
      5,6: begin
        PrepareCall;
        GetNextItem(P,' ',call.Method); // GET or POST
        if P<>nil then
          call.Url := call.Url+'/'+RawUTF8(P);
        URI(call);
        result.Content := call.OutBody;
      end;
      7: begin
        PrepareCall;
        call.Method := 'GET';
        call.Url := call.Url+'/wrapper/context';
        URI(call);
        result.Content := call.OutBody;
      end;
      8: begin
        inherited;
        result.Content[length(result.Content)] := '|';
        result.Content := result.Content+'#interfaces|#wrapper|#info|'+
          '#stats|#stats(method)|#stats(interface.method)|#services|#sessions|'+
          '#get url|#post url"';
      end;
      9: begin
        info.InitJSONInPlace(pointer(result.Content)); // from DatabaseExecute()
        InternalInfo(info);
        result.Content := info.ToJSON;
      end;
      else inherited AdministrationExecute(DatabaseName,SQL,result);
      end;
    end else
      inherited; // will execute the SQL
  finally
    NoAjaxJson := not isAjax;
  end;
end;

procedure TSQLRestServer.Timestamp(Ctxt: TSQLRestServerURIContext);
{$ifndef NOVARIANTS}
  procedure DoInfo;
  var info: TDocVariantData;
  begin
    info.InitFast;
    InternalInfo(info);
    Ctxt.Returns(info.ToJSON('','',jsonHumanReadable));
  end;
{$endif}
begin
{$ifndef NOVARIANTS}
  if IdemPropNameU(Ctxt.URIBlobFieldName,'info') and
     not (rsoTimestampInfoURIDisable in fOptions) then
    DoInfo else
{$endif}
    Ctxt.Returns(Int64ToUtf8(ServerTimestamp),HTTP_SUCCESS,TEXT_CONTENT_TYPE_HEADER);
end;

procedure TSQLRestServer.CacheFlush(Ctxt: TSQLRestServerURIContext);
var i,count: integer;
begin
  case Ctxt.Method of
  mGET: begin
    if Ctxt.Table=nil then
      Cache.Flush else
      if Ctxt.TableID=0 then
        Cache.Flush(Ctxt.Table) else
        Cache.SetCache(Ctxt.Table,Ctxt.TableID);
    Ctxt.Success;
  end;
  mPOST:
    if Ctxt.URIBlobFieldName='_callback_' then
      // as called from TSQLHttpClientWebsockets.FakeCallbackUnregister
      (Services as TServiceContainerServer).FakeCallbackRelease(Ctxt) else
    if Ctxt.URIBlobFieldName='_ping_' then begin
      count := 0;
      if Ctxt.Session>CONST_AUTHENTICATION_NOT_USED then
        for i := 0 to Services.Count-1 do
          inc(count,TServiceFactoryServer(Services.fInterface[i].Service).
            RenewSession(Ctxt.Session));
      InternalLog('Renew % authenticated session % from %: count=%',
        [Model.Root,Ctxt.Session,Ctxt.RemoteIPNotLocal,count],sllUserAuth);
      Ctxt.Returns(['count',count]);
    end;
  end;
end;

procedure TSQLRestServer.Batch(Ctxt: TSQLRestServerURIContext);
var Results: TInt64DynArray;
    i: integer;
begin
  if not (Ctxt.Method in [mPUT,mPOST]) then begin
    Ctxt.Error('PUT/POST only');
    exit;
  end;
  try
    EngineBatchSend(Ctxt.Table,Ctxt.Call.InBody,TIDDynArray(Results),0);
  except
    on E: Exception do begin
      Ctxt.Error(E,'did break % BATCH process',[Ctxt.Table],HTTP_SERVERERROR);
      exit;
    end;
  end;
  // send back operation status array
  Ctxt.Call.OutStatus := HTTP_SUCCESS;
  for i := 0 to length(Results)-1 do
    if Results[i]<>HTTP_SUCCESS then begin
      Ctxt.Call.OutBody := Int64DynArrayToCSV(pointer(Results),length(Results),'[',']');
      exit;
    end;
  Ctxt.Call.OutBody := '["OK"]';  // to save bandwith if no adding
end;

var
  ServerNonceHash: TSHA3; // faster than THMAC_SHA256 on small input
  ServerNonceCache: array[boolean] of record
    tix: cardinal;
    res: RawUTF8;
  end;

function CurrentServerNonce(Previous: boolean): RawUTF8;
var ticks: cardinal;
    hash: TSHA3;
    res: THash256;
begin
  ticks := UnixTimeUTC div (60*5); // 5 minutes resolution
  if Previous then
    dec(ticks);
  with ServerNonceCache[Previous] do
    if ticks=tix then begin
      result := res;
      exit;
    end;
  if ServerNonceHash.Algorithm<>SHA3_256 then begin
    ServerNonceHash.Init(SHA3_256);
    TAESPRNG.Main.Fill(@res,SizeOf(res)); // ensure unpredictable nonce
    ServerNonceHash.Update(@res,SizeOf(res));
  end;
  hash := ServerNonceHash; // thread-safe SHA-3 sponge reuse
  hash.Update(@ticks,SizeOf(ticks));
  hash.Final(res,true);
  result := BinToHexLower(@res,SizeOf(res));
  with ServerNonceCache[Previous] do begin
    tix := ticks;
    res := result;
  end;
end;

procedure TSQLRestServer.SessionCreate(var User: TSQLAuthUser;
  Ctxt: TSQLRestServerURIContext; out Session: TAuthSession);
var i: PtrInt;
begin
  Session := nil;
  if (reOneSessionPerUser in Ctxt.Call^.RestAccessRights^.AllowRemoteExecute) and
     (fSessions<>nil) then
    for i := 0 to fSessions.Count-1 do
      if TAuthSession(fSessions.List[i]).User.fID=User.fID then begin
        {$ifdef WITHLOG}
        with TAuthSession(fSessions.List[i]) do
          Ctxt.Log.Log(sllUserAuth,'User.LogonName=% already connected from %/%',
            [User.LogonName,RemoteIP,Ctxt.Call^.LowLevelConnectionID],self);
        {$endif}
        Ctxt.AuthenticationFailed(afSessionAlreadyStartedForThisUser);
        exit; // user already connected
      end;
  Session := fSessionClass.Create(Ctxt,User);
  if Assigned(OnSessionCreate) then
    if OnSessionCreate(self,Session,Ctxt) then begin // TRUE aborts session creation
      {$ifdef WITHLOG}
      Ctxt.Log.Log(sllUserAuth,'Session aborted by OnSessionCreate() callback '+
         'for User.LogonName=% (connected from %/%) - clients=%, sessions=%',
        [User.LogonName,Session.RemoteIP,Ctxt.Call^.LowLevelConnectionID,
         fStats.GetClientsCurrent,fSessions.Count],self);
      {$endif}
      Ctxt.AuthenticationFailed(afSessionCreationAborted);
      User := nil;
      FreeAndNil(Session);
      exit;
    end;
  User := nil; // will be freed by TAuthSession.Destroy
  fSessions.Add(Session);
  fStats.ClientConnect;
end;

procedure TSQLRestServer.Auth(Ctxt: TSQLRestServerURIContext);
var i: integer;
begin
  if fSessionAuthentication=nil then
    exit;
  fSessions.Safe.Lock;
  try
    for i := 0 to length(fSessionAuthentication)-1 do
      if fSessionAuthentication[i].Auth(Ctxt) then
        break; // found an authentication, which may be successfull or not
  finally
    fSessions.Safe.UnLock;
  end;
end;

procedure TSQLRestServer.InternalSafeProtocol(var Call: TSQLRestURIParams;
  var SafeID: integer);
var res: TProtocolResult;
    P: PUTF8Char;
    prot: IProtocol;
begin
  if SafeID<>0 then begin
    // todo: encrypt Call.OutBody+OutHeader
    exit;
  end;
  P := pointer(Call.Url);
  inc(P,length(fSafeRootUpper)); // IdemPChar() done by caller
  if P^='/' then
    inc(P);
  if IdemPChar(P,'OPEN') then begin
    if fSafeProtocolNext=nil then
      fSafeProtocolNext := fSafeProtocol.Clone;
    res := fSafeProtocolNext.ProcessHandshake(Call.InBody,Call.OutBody);
    InternalLog('InternalSafeProtocol ProcessHandshake=%',[ToText(res)^]);
    if not (res in [sprSuccess,sprUnsupported]) then
      exit;
    prot := fSafeProtocolNext;
    fSafeProtocolNext := nil;
    // todo: register the new connection and return new SafeID
    exit;
  end;
  SafeID := GetCardinal(P);
  if SafeID=0 then
    exit;
  // todo: store IProtocol instance in the associated session
  // todo: decrypt Call.Url+Method+Inbody+InHeader or close connection
end;

procedure TSQLRestServer.SessionDelete(aSessionIndex: integer;
  Ctxt: TSQLRestServerURIContext);
var sess: TAuthSession;
begin
  if (self<>nil) and (cardinal(aSessionIndex)<cardinal(fSessions.Count)) then begin
    sess := fSessions.List[aSessionIndex];
    if Services<>nil then
      (Services as TServiceContainerServer).OnCloseSession(sess.IDCardinal);
    if Ctxt=nil then
      InternalLog('Deleted session %:%/%',[sess.User.LogonName,sess.IDCardinal,
        fSessions.Count],sllUserAuth) else
      InternalLog('Deleted session %:%/% from %/%',[sess.User.LogonName,sess.IDCardinal,
        fSessions.Count,sess.RemoteIP,Ctxt.Call^.LowLevelConnectionID],sllUserAuth);
    if Assigned(OnSessionClosed) then
      OnSessionClosed(self,sess,Ctxt);
    fSessions.Delete(aSessionIndex);
    fStats.ClientDisconnect;
  end;
end;

function TSQLRestServer.SessionAccess(Ctxt: TSQLRestServerURIContext): TAuthSession;
var i: integer;
    tix, session: cardinal;
    sessions: ^TAuthSession;
begin // caller of RetrieveSession() made fSessions.Safe.Lock
  if (self<>nil) and (fSessions<>nil) then begin
    tix := GetTickCount64 shr 10;
    if tix<>fSessionsDeprecatedTix then begin
      fSessionsDeprecatedTix := tix; // check deprecated sessions every second
      for i := fSessions.Count-1 downto 0 do
        if tix>TAuthSession(fSessions.List[i]).TimeOutTix then
          SessionDelete(i,nil);
    end;
    // retrieve session from its ID
    sessions := pointer(fSessions.List);
    session := Ctxt.Session;
    for i := 1 to fSessions.Count do
      if sessions^.IDCardinal=session then begin
        result := sessions^;
        result.fTimeOutTix := tix+result.TimeoutShr10;
        Ctxt.fSession := result; // for TSQLRestServer internal use
        // make local copy of TAuthSession information
        Ctxt.SessionUser := result.User.fID;
        Ctxt.SessionGroup := result.User.GroupRights.fID;
        Ctxt.SessionUserName := result.User.LogonName;
        if (result.RemoteIP<>'') and (Ctxt.fRemoteIP='') then
          Ctxt.fRemoteIP := result.RemoteIP;
        Ctxt.fSessionAccessRights := result.fAccessRights;
        Ctxt.Call^.RestAccessRights := @Ctxt.fSessionAccessRights;
        exit;
      end else
        inc(sessions);
  end;
  result := nil;
end;

function TSQLRestServer.SessionGetUser(aSessionID: Cardinal): TSQLAuthUser;
var i: integer;
begin
  result := nil;
  if self=nil then
    exit;
  fSessions.Safe.Lock;
  try
    for i := 0 to fSessions.Count-1 do
      with TAuthSession(fSessions.List[i]) do
      if IDCardinal=aSessionID then begin
        if User<>nil then begin
          result := User.CreateCopy as fSQLAuthUserClass;
          result.GroupRights := nil;
        end;
        Break;
      end;
  finally
    fSessions.Safe.UnLock;
  end;
end;


function TSQLRestServer.SessionsAsJson: RawJSON;
var i: integer;
    W: TJSONSerializer;
    temp: TTextWriterStackBuffer;
begin
  result := '';
  if (self=nil) or (fSessions.Count=0) then
    exit;
  W := TJSONSerializer.CreateOwnedStream(temp);
  try
    fSessions.Safe.Lock;
    try
      W.Add('[');
      for i := 0 to fSessions.Count-1 do begin
        W.WriteObject(fSessions.List[i]);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add(']');
      W.SetText(RawUTF8(result));
    finally
      fSessions.Safe.UnLock;
    end;
  finally
    W.Free;
  end;
end;

const
  MAGIC_SESSION: cardinal = $A5ABA5AB;

procedure TSQLRestServer.SessionsSaveToFile(const aFileName: TFileName);
var i: integer;
    MS: TRawByteStringStream;
    W: TFileBufferWriter;
    s: RawByteString;
begin
  if self=nil then
    exit;
  DeleteFile(aFileName);
  MS := TRawByteStringStream.Create;
  try
    W := TFileBufferWriter.Create(MS);
    fSessions.Safe.Lock;
    try
      W.WriteVarUInt32(InternalState);
      SQLAuthUserClass.RecordProps.SaveBinaryHeader(W);
      SQLAuthGroupClass.RecordProps.SaveBinaryHeader(W);
      W.WriteVarUInt32(fSessions.Count);
      for i := 0 to fSessions.Count-1 do
        TAuthSession(fSessions.List[i]).SaveTo(W);
      W.Write4(fSessionCounter);
      W.Write4(MAGIC_SESSION+1);
      W.Flush;
    finally
      fSessions.Safe.UnLock;
      W.Free;
    end;
    s := SynLZCompress(MS.DataString);
    SymmetricEncrypt(MAGIC_SESSION,s);
    FileFromString(s,aFileName,true);
  finally
    MS.Free;
  end;
end;

procedure TSQLRestServer.SessionsLoadFromFile(const aFileName: TFileName;
  andDeleteExistingFileAfterRead: boolean);
procedure ContentError;
begin
  raise ESynException.CreateUTF8('%.SessionsLoadFromFile("%")',[self,aFileName]);
end;
var i,n: integer;
    s: RawByteString;
    R: TFileBufferReader;
    P,PEnd: PAnsiChar;
begin
  if self=nil then
    exit;
  s := StringFromFile(aFileName);
  SymmetricEncrypt(MAGIC_SESSION,s);
  s := SynLZDecompress(s);
  if s='' then
    exit;
  R.OpenFrom(pointer(s),length(s));
  fSessions.Safe.Lock;
  try
    InternalState := R.ReadVarUInt32;
    if not SQLAuthUserClass.RecordProps.CheckBinaryHeader(R) or
       not SQLAuthGroupClass.RecordProps.CheckBinaryHeader(R) then
      ContentError;
    n := R.ReadVarUInt32;
    P := R.CurrentMemory(0,@PEnd);
    fSessions.Clear;
    for i := 1 to n do begin
      fSessions.Add(fSessionClass.CreateFrom(P,PEnd,self));
      fStats.ClientConnect;
    end;
    fSessionCounter := PCardinal(P)^;
    inc(P,4);
    if PCardinal(P)^<>MAGIC_SESSION+1 then
      ContentError;
  finally
    fSessions.Safe.UnLock;
    R.Close;
  end;
  if andDeleteExistingFileAfterRead then
    DeleteFile(aFileName);
end;

function TSQLRestServer.CacheWorthItForTable(aTableIndex: cardinal): boolean;
begin
  if self=nil then
    result := false else
    result := (aTableIndex>=cardinal(length(fStaticData))) or
      not fStaticData[aTableIndex].InheritsFrom(TSQLRestStorageInMemory);
end;

procedure TSQLRestServer.BeginCurrentThread(Sender: TThread);
var i, tc: integer;
    id: TThreadID;
begin
  tc := fStats.NotifyThreadCount(1);
  id := GetCurrentThreadId;
  if Sender=nil then
    raise ECommunicationException.CreateUTF8('%.BeginCurrentThread(nil)',[self]);
  InternalLog('BeginCurrentThread(%) root=% ThreadID=% ThreadCount=%',
    [Sender.ClassType,Model.Root,pointer(id),tc]);
  if Sender.ThreadID<>id then
    raise ECommunicationException.CreateUTF8(
      '%.BeginCurrentThread(Thread.ID=%) and CurrentThreadID=% should match',
      [self,pointer(Sender.ThreadID),pointer(id)]);
  with PServiceRunningContext(@ServiceContext)^ do // P..(@..)^ for ONE GetTls()
    if RunningThread<>Sender then // e.g. if length(TSQLHttpServer.fDBServers)>1
      if RunningThread<>nil then
        raise ECommunicationException.CreateUTF8('%.BeginCurrentThread() twice',[self]) else
        RunningThread := Sender;
  if fStaticVirtualTable<>nil then
    for i := 0 to high(fStaticVirtualTable) do
      if (fStaticVirtualTable[i]<>nil) and
         fStaticVirtualTable[i].InheritsFrom(TSQLRestStorage) then
        TSQLRestStorage(fStaticVirtualTable[i]).BeginCurrentThread(Sender);
end;

procedure TSQLRestServer.EndCurrentThread(Sender: TThread);
var i, tc: integer;
    id: TThreadID;
    Inst: TServiceFactoryServerInstance;
begin
  tc := fStats.NotifyThreadCount(-1);
  id := GetCurrentThreadId;
  if Sender=nil then
    raise ECommunicationException.CreateUTF8('%.EndCurrentThread(nil)',[self]);
  InternalLog('EndCurrentThread(%) ThreadID=% ThreadCount=%',
    [Sender.ClassType,pointer(id),tc]);
  if Sender.ThreadID<>id then
    raise ECommunicationException.CreateUTF8(
      '%.EndCurrentThread(%.ID=%) should match CurrentThreadID=%',
      [self,Sender,pointer(Sender.ThreadID),pointer(id)]);
 if fStaticVirtualTable<>nil then
   for i := 0 to high(fStaticVirtualTable) do
     if (fStaticVirtualTable[i]<>nil) and
        fStaticVirtualTable[i].InheritsFrom(TSQLRestStorage) then
       TSQLRestStorage(fStaticVirtualTable[i]).EndCurrentThread(Sender);
  if Services<>nil then begin
    Inst.InstanceID := PtrUInt(id);
    for i := 0 to Services.Count-1 do
      with TServiceFactoryServer(Services.fInterface[i].Service) do
      if InstanceCreation=sicPerThread then
        InternalInstanceRetrieve(Inst,ord(imFree),0);
  end;
  with PServiceRunningContext(@ServiceContext)^ do // P..(@..)^ for ONE GetTls()
    if RunningThread<>nil then  // e.g. if length(TSQLHttpServer.fDBServers)>1
      if RunningThread<>Sender then
        raise ECommunicationException.CreateUTF8(
          '%.EndCurrentThread(%) should match RunningThread=%',
          [self,Sender,RunningThread]) else
        RunningThread := nil;
  inherited EndCurrentThread(Sender); // should be done eventually
end;


{ TSQLRecordModification }

function TSQLRecordModification.ModifiedID: TID;
begin
  if self=nil then
    result := 0 else
    result := RecordRef(fModifiedRecord).ID;
end;

function TSQLRecordModification.ModifiedTable(Model: TSQLModel): TSQLRecordClass;
begin
  if (self=nil) or (Model=nil) then
    result := nil else
    result := RecordRef(fModifiedRecord).Table(Model);
end;

function TSQLRecordModification.ModifiedTableIndex: integer;
begin
  if self=nil then
    result := 0 else
    result := RecordRef(fModifiedRecord).TableIndex;
end;


{ TSQLRecordHistory }

class procedure TSQLRecordHistory.InitializeTable(Server: TSQLRestServer;
  const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
begin
  inherited InitializeTable(Server,FieldName,Options);
  if FieldName='' then
    Server.CreateSQLMultiIndex(Self,['ModifiedRecord','Event'],false);
end;

destructor TSQLRecordHistory.Destroy;
begin
  inherited;
  fHistoryAdd.Free;
end;

constructor TSQLRecordHistory.CreateHistory(aClient: TSQLRest;
  aTable: TSQLRecordClass; aID: TID);
var Reference: RecordRef;
    Rec: TSQLRecord;
    HistJson: TSQLRecordHistory;
begin
  if (aClient=nil) or (aID<=0) then
    raise EORMException.CreateUTF8('Invalid %.CreateHistory(%,%,%) call',
      [self,aClient,aTable,aID]);
  // read BLOB changes
  Reference.From(aClient.Model,aTable,aID);
  fModifiedRecord := Reference.Value;
  fEvent := heArchiveBlob;
  Create(aClient,'ModifiedRecord=? and Event=%',[ord(heArchiveBlob)],[fModifiedRecord]);
  if fID<>0 then
    aClient.RetrieveBlobFields(self); // load former fHistory field
  if not HistoryOpen(aClient.Model) then
    raise EORMException.CreateUTF8('HistoryOpen in %.CreateHistory(%,%,%)',
      [self,aClient,aTable,aID]);
  // append JSON changes
  HistJson := RecordClass.CreateAndFillPrepare(aClient,
    'ModifiedRecord=? and Event<>%',[ord(heArchiveBlob)],[fModifiedRecord])
    as TSQLRecordHistory;
  try
    if HistJson.FillTable.RowCount=0 then
      exit; // no JSON to append
    Rec := HistoryGetLast;
    try
      while HistJson.FillOne do begin
        Rec.FillFrom(pointer(HistJson.SentDataJSON));
        HistoryAdd(Rec,HistJson);
      end;
      HistorySave(nil); // update internal fHistory field
    finally
      Rec.Free;
    end;
  finally
    HistJson.Free;
  end;
  // prepare for HistoryCount and HistoryGet() from internal fHistory field
  HistoryOpen(aClient.Model);
end;

class procedure TSQLRecordHistory.InitializeFields(const Fields: array of const;
  var JSON: RawUTF8);
begin // you may use a TDocVariant to add some custom fields in your own class
  JSON := JSONEncode(Fields);
end;

function TSQLRecordHistory.HistoryOpen(Model: TSQLModel): boolean;
var len: cardinal;
    start,i: integer;
    R: TFileBufferReader;
    tmp: RawByteString;
begin
  result := false;
  fHistoryModel := Model;
  fHistoryUncompressed := '';
  fHistoryTable := ModifiedTable(Model);
  fHistoryUncompressedCount := 0;
  fHistoryUncompressedOffset := nil;
  if fHistoryTable=nil then
    exit; // invalid Model or ModifiedRecord
  tmp := SynLZDecompress(fHistory);
  len := length(tmp);
  if len>4 then begin
    R.OpenFrom(pointer(tmp),len);
    if not fHistoryTable.RecordProps.CheckBinaryHeader(R) then
      exit; // invalid content: TSQLRecord layout may have changed
    R.ReadVarUInt32Array(fHistoryUncompressedOffset);
    fHistoryUncompressedCount := length(fHistoryUncompressedOffset);
    start := R.CurrentPosition;
    for i := 0 to fHistoryUncompressedCount-1 do
      inc(fHistoryUncompressedOffset[i],start);
    fHistoryUncompressed := tmp;
  end;
  result := true;
end;

function TSQLRecordHistory.HistoryCount: integer;
begin
  if (self=nil) or (fHistoryUncompressed='') then
    result := 0 else
    result := fHistoryUncompressedCount;
end;

function TSQLRecordHistory.HistoryGet(Index: integer;
  out Event: TSQLHistoryEvent; out Timestamp: TModTime; Rec: TSQLRecord): boolean;
var P,PEnd: PAnsiChar;
begin
  result := false;
  if cardinal(Index)>=cardinal(HistoryCount) then
    exit;
  P := pointer(fHistoryUncompressed);
  PEnd := P+length(fHistoryUncompressed);
  inc(P,fHistoryUncompressedOffset[Index]);
  if P>=PEnd then
    exit;
  Event := TSQLHistoryEvent(P^); inc(P);
  P := pointer(FromVarUInt64Safe(pointer(P),pointer(PEnd),PQWord(@Timestamp)^));
  if P=nil then
    exit;
  if (Rec<>nil) and (Rec.RecordClass=fHistoryTable)  then begin
    if Event=heDelete then
      Rec.ClearProperties else
      Rec.SetBinaryValuesSimpleFields(P,PEnd);
    Rec.fID := ModifiedID;
    if P=nil then
      exit;
  end;
  result := true;
end;

function TSQLRecordHistory.HistoryGet(Index: integer; Rec: TSQLRecord): boolean;
var Event: TSQLHistoryEvent;
    Timestamp: TModTime;
begin
  result := HistoryGet(Index,Event,Timestamp,Rec);
end;

function TSQLRecordHistory.HistoryGet(Index: integer): TSQLRecord;
var Event: TSQLHistoryEvent;
    Timestamp: TModTime;
begin
  if fHistoryTable=nil then
    result := nil else begin
    result := fHistoryTable.Create;
    if not HistoryGet(Index,Event,Timestamp,result) then
      FreeAndNil(result);
  end;
end;

function TSQLRecordHistory.HistoryGetLast(Rec: TSQLRecord): boolean;
begin
  result := HistoryGet(fHistoryUncompressedCount-1,Rec);
end;

function TSQLRecordHistory.HistoryGetLast: TSQLRecord;
var Event: TSQLHistoryEvent;
    Timestamp: TModTime;
begin
  if fHistoryTable=nil then
    result := nil else begin
    result := fHistoryTable.Create; // always return an instance
    HistoryGet(fHistoryUncompressedCount-1,Event,Timestamp,result);
  end;
end;

procedure TSQLRecordHistory.HistoryAdd(Rec: TSQLRecord; Hist: TSQLRecordHistory);
begin
  if (self=nil) or (fHistoryModel=nil) or (Rec.RecordClass<>fHistoryTable) then
    exit;
  if fHistoryAdd=nil then
    fHistoryAdd := TFileBufferWriter.Create(TRawByteStringStream);
  AddInteger(fHistoryAddOffset,fHistoryAddCount,fHistoryAdd.TotalWritten);
  fHistoryAdd.Write1(Ord(Hist.Event));
  fHistoryAdd.WriteVarUInt64(Hist.Timestamp);
  if Hist.Event<>heDelete then
    Rec.GetBinaryValuesSimpleFields(fHistoryAdd);
end;

function TSQLRecordHistory.HistorySave(Server: TSQLRestServer;
  LastRec: TSQLRecord): boolean;
var size,i,maxSize,TableHistoryIndex: integer;
    firstOldIndex,firstOldOffset, firstNewIndex,firstNewOffset: integer;
    newOffset: TIntegerDynArray;
    DBRec: TSQLRecord;
    HistTemp: TSQLRecordHistory;
    W: TFileBufferWriter;
begin
  result := false;
  if (self=nil) or (fHistoryTable=nil) or (fModifiedRecord=0) then
    exit; // wrong call
  try
    // ensure latest item matches "official" one, as read from DB
    if (Server<>nil) and (LastRec<>nil) and (LastRec.fID=ModifiedID) then begin
      DBRec := Server.Retrieve(ModifiedRecord);
      if DBRec<>nil then
      try // may be just deleted
        if not DBRec.SameRecord(LastRec) then begin
          HistTemp := RecordClass.Create as TSQLRecordHistory;
          try
            HistTemp.fEvent := heUpdate;
            HistTemp.fTimestamp := Server.ServerTimestamp;
            HistoryAdd(DBRec,HistTemp);
          finally
            HistTemp.Free;
          end;
        end;
      finally
        DBRec.Free;
      end;
    end;
    if fHistoryAdd=nil then
      exit; // nothing new
    // ensure resulting size matches specified criteria
    firstOldIndex := 0;
    TableHistoryIndex := 0;
    if Server=nil then
      maxSize := maxInt else begin
      TableHistoryIndex := Server.Model.GetTableIndexExisting(RecordClass);
      maxSize := Server.fTrackChangesHistory[TableHistoryIndex].MaxUncompressedBlobSize;
    end;
    size := fHistoryAdd.TotalWritten;
    if (size>maxSize) or (fHistoryUncompressedCount=0) then
      // e.g. if fHistory.Add() is already bigger than expected
      firstOldIndex := fHistoryUncompressedCount else begin
      inc(size,Length(fHistoryUncompressed)-fHistoryUncompressedOffset[0]);
      while (firstOldIndex<fHistoryUncompressedCount-1) and (size>maxSize) do begin
        dec(size,fHistoryUncompressedOffset[firstOldIndex+1]-fHistoryUncompressedOffset[firstOldIndex]);
        inc(firstOldIndex);
      end;
    end;
    // creates and store new History BLOB
    W := TFileBufferWriter.Create(TRawByteStringStream);
    try
      // compute offsets
      if firstOldIndex=fHistoryUncompressedCount then
        firstOldOffset := length(fHistoryUncompressed) else
        firstOldOffset := fHistoryUncompressedOffset[firstOldIndex];
      SetLength(newOffset,fHistoryUncompressedCount-firstOldIndex+fHistoryAddCount);
      for i := firstOldIndex to fHistoryUncompressedCount-1 do
        newOffset[i-firstOldIndex] := fHistoryUncompressedOffset[i]-firstOldOffset;
      firstNewIndex := fHistoryUncompressedCount-firstOldIndex;
      firstNewOffset := Length(fHistoryUncompressed)-firstOldOffset;
      for i := 0 to fHistoryAddCount-1 do
        newOffset[firstNewIndex+i] := fHistoryAddOffset[i]+firstNewOffset;
      // write header
      fHistoryTable.RecordProps.SaveBinaryHeader(W);
      W.WriteVarUInt32Array(newOffset,length(newOffset),wkOffsetU);
      // write data
      W.Write(@PByteArray(fHistoryUncompressed)[firstOldOffset],firstNewOffset);
      fHistoryAdd.Flush;
      W.WriteBinary((fHistoryAdd.Stream as TRawByteStringStream).DataString);
      W.Flush;
      fHistoryUncompressed := (W.Stream as TRawByteStringStream).DataString;
      fHistory := SynLZCompress(fHistoryUncompressed);
      if (Server<>nil) and (fID<>0) then begin
        Server.EngineUpdateField(TableHistoryIndex,
          'Timestamp',Int64ToUTF8(Server.ServerTimestamp),'RowID',Int64ToUtf8(fID));
        Server.EngineUpdateBlob(TableHistoryIndex,fID,
          RecordProps.BlobFields[0].PropInfo,fHistory);
      end;
      result := true;
    finally
      W.Free;
    end;
  finally
    fHistoryUncompressed := '';
    fHistoryUncompressedOffset := nil;
    FreeAndNil(fHistoryAdd);
    fHistoryAddOffset := nil;
    fHistoryAddCount := 0;
  end;
end;

procedure TSQLRestServer.TrackChangesFlush(aTableHistory: TSQLRecordHistoryClass);
var HistBlob: TSQLRecordHistory;
    Rec: TSQLRecord;
    HistJson: TSQLRecordHistory;
    WhereClause, JSON: RawUTF8;
    HistID, ModifiedRecord: TInt64DynArray;
    TableHistoryIndex,i,HistIDCount,n: integer;
    ModifRecord, ModifRecordCount, MaxRevisionJSON: integer;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter('TrackChangesFlush(%)',[aTableHistory],self);
  {$endif}
  fAcquireExecution[execORMWrite].Safe.Lock; // avoid race condition
  try // low-level Add(TSQLRecordHistory) without cache
    TableHistoryIndex := Model.GetTableIndexExisting(aTableHistory);
    MaxRevisionJSON := fTrackChangesHistory[TableHistoryIndex].MaxRevisionJSON;
    if MaxRevisionJSON<=0 then
      MaxRevisionJSON := 10;
    // we will compress into BLOB only when we got more than 10 revisions of a record
    with MultiFieldValues(aTableHistory,'RowID,ModifiedRecord',
      'Event<>%',[ord(heArchiveBlob)],[]) do
    try
      GetRowValues(fFieldIndexID,HistID);
      GetRowValues(FieldIndex('ModifiedRecord'),ModifiedRecord);
    finally
      Free;
    end;
    QuickSortInt64(pointer(ModifiedRecord),pointer(HistID),0,high(ModifiedRecord));
    ModifRecord := 0;
    ModifRecordCount := 0;
    n := 0;
    HistIDCount := 0;
    for i := 0 to high(ModifiedRecord) do begin
      if (ModifiedRecord[i]=0) or (HistID[i]=0) then
        raise EORMException.CreateUTF8('%.TrackChangesFlush: Invalid %.ID=%',
          [self,aTableHistory,HistID[i]]);
      if ModifiedRecord[i]<>ModifRecord then begin
        if ModifRecordCount>MaxRevisionJSON then
          HistIDCount := n else
          n := HistIDCount;
        ModifRecord := ModifiedRecord[i];
        ModifRecordCount := 1;
      end else
        inc(ModifRecordCount);
      HistID[n] := HistID[i];
      inc(n);
    end;
    if ModifRecordCount>MaxRevisionJSON then
      HistIDCount := n;
    if HistIDCount=0 then
      exit; // nothing to compress
    QuickSortInt64(Pointer(HistID),0,HistIDCount-1);
    WhereClause := Int64DynArrayToCSV(Pointer(HistID),HistIDCount,'RowID in (',')');
    { following SQL is much slower with external tables, and won't work
      with TSQLRestStorageInMemory -> manual process instead
    WhereClause := FormatUTF8('ModifiedRecord in (select ModifiedRecord from '+
        '(select ModifiedRecord, count(*) NumItems from % group by ModifiedRecord) '+
        'where NumItems>% order by ModifiedRecord) and History is null',
        [aTableHistory.SQLTableName,MaxRevisionJSON]); }
    Rec := nil;
    HistBlob := nil;
    HistJson := aTableHistory.CreateAndFillPrepare(self,WhereClause);
    try
      HistBlob := aTableHistory.Create;
      while HistJson.FillOne do begin
        if HistJson.ModifiedRecord<>HistBlob.ModifiedRecord then begin
          if HistBlob.ModifiedRecord<>0 then
            HistBlob.HistorySave(self,Rec);
          FreeAndNil(Rec);
          HistBlob.fHistory := '';
          HistBlob.fID := 0;
          HistBlob.fEvent := heArchiveBlob;
          if not Retrieve('ModifiedRecord=? and Event=%',
              [ord(heArchiveBlob)],[HistJson.ModifiedRecord],HistBlob) then
            HistBlob.fModifiedRecord := HistJson.ModifiedRecord else
            RetrieveBlobFields(HistBlob);
          if not HistBlob.HistoryOpen(Model) then begin
            InternalLog('Invalid %.History BLOB content for ID=%: % '+
              'layout may have changed -> flush any previous content',
              [HistBlob.RecordClass,HistBlob.fID,HistJson.ModifiedTable(Model)],sllError);
            HistBlob.fID := 0;
          end;
          if HistBlob.fID<>0 then // allow changes appending to HistBlob
            Rec := HistBlob.HistoryGetLast else begin
            // HistBlob.fID=0 -> no previous BLOB content
            JSON := JSONEncode(['ModifiedRecord',HistJson.ModifiedRecord,
              'Timestamp',ServerTimestamp,'Event',ord(heArchiveBlob)]);
            if HistJson.Event=heAdd then begin // allow versioning from scratch
              HistBlob.fID := EngineAdd(TableHistoryIndex,JSON);
              Rec := HistJson.ModifiedTable(Model).Create;
              HistBlob.HistoryOpen(Model);
            end else begin
              Rec := Retrieve(HistJson.ModifiedRecord);
              if Rec<>nil then
              try // initialize BLOB with latest revision
                HistBlob.fID := EngineAdd(TableHistoryIndex,JSON);
                HistBlob.HistoryOpen(Model);
                HistBlob.HistoryAdd(Rec,HistJson);
              finally
                FreeAndNil(Rec); // ignore partial SentDataJSON for this record
              end;
            end;
          end;
        end;
        if (Rec=nil) or (HistBlob.fID=0) then
          continue; // only append modifications to BLOB if valid
        Rec.FillFrom(pointer(HistJson.SentDataJSON));
        HistBlob.HistoryAdd(Rec,HistJson);
      end;
      if HistBlob.ModifiedRecord<>0 then
        HistBlob.HistorySave(self,Rec);
      SetLength(HistID,HistIDCount);
      EngineDeleteWhere(TableHistoryIndex,WhereClause,TIDDynArray(HistID));
    finally
      HistJson.Free;
      HistBlob.Free;
      Rec.Free;
    end;
  finally
    fAcquireExecution[execORMWrite].Safe.UnLock;
  end;
end;

function TSQLRestServer.InternalUpdateEvent(aEvent: TSQLEvent; aTableIndex: integer;
  aID: TID; const aSentData: RawUTF8; aIsBlobFields: PSQLFieldBits): boolean;
  procedure DoTrackChanges(TableHistoryIndex: integer);
  var TableHistoryClass: TSQLRecordHistoryClass;
      JSON: RawUTF8;
      Event: TSQLHistoryEvent;
  begin
    case aEvent of
    seAdd:    Event := heAdd;
    seUpdate: Event := heUpdate;
    seDelete: Event := heDelete;
    else exit;
    end;
    TableHistoryClass := TSQLRecordHistoryClass(Model.Tables[TableHistoryIndex]);
    TableHistoryClass.InitializeFields(['ModifiedRecord',aTableIndex+aID shl 6,
      'Event',ord(Event),'SentDataJSON',aSentData,'Timestamp',ServerTimestamp],JSON);
    fAcquireExecution[execORMWrite].Safe.Lock; // avoid race condition
    try // low-level Add(TSQLRecordHistory) without cache
      EngineAdd(TableHistoryIndex,JSON);
      { TODO: use a BATCH (in background thread) to speed up TSQLHistory storage? }
      if fTrackChangesHistory[TableHistoryIndex].CurrentRow>
          fTrackChangesHistory[TableHistoryIndex].MaxSentDataJsonRow then begin
        // gather & compress TSQLRecordHistory.SentDataJson into History BLOB
        TrackChangesFlush(TableHistoryClass);
        fTrackChangesHistory[TableHistoryIndex].CurrentRow := 0;
      end else
        // fast append as JSON until reached MaxSentDataJsonRow
        inc(fTrackChangesHistory[TableHistoryIndex].CurrentRow);
    finally
      fAcquireExecution[execORMWrite].Safe.UnLock;
    end;
  end;
var TableHistoryIndex: integer;
begin
  if aID<=0 then
    result := false else
    if aIsBlobFields<>nil then
      // BLOB fields update
      if (aEvent=seUpdateBlob) and Assigned(OnBlobUpdateEvent) then
        result := OnBlobUpdateEvent(
          self,seUpdate,fModel.Tables[aTableIndex],aID,aIsBlobFields^) else
        result := true else begin
      // track simple fields modification
      if cardinal(aTableIndex)<fTrackChangesHistoryTableIndexCount then begin
        TableHistoryIndex := fTrackChangesHistoryTableIndex[aTableIndex];
        if TableHistoryIndex>=0 then
          DoTrackChanges(TableHistoryIndex);
      end;
      if Assigned(OnUpdateEvent) then
        result := OnUpdateEvent(self,aEvent,fModel.Tables[aTableIndex],aID,aSentData) else
        result := true; // true on success, false if error (but action continues)
    end;
end;

procedure TSQLRestServer.TrackChanges(const aTable: array of TSQLRecordClass;
  aTableHistory: TSQLRecordHistoryClass; aMaxHistoryRowBeforeBlob,
  aMaxHistoryRowPerRecord, aMaxUncompressedBlobSize: integer);
var t, tableIndex, TableHistoryIndex: integer;
begin
  if (self=nil) or (high(aTable)<0) then
    exit;
  if aMaxHistoryRowBeforeBlob<=0 then // disable change tracking
    TableHistoryIndex := -1 else begin
    if aTableHistory=nil then
      aTableHistory := TSQLRecordHistory;
    TableHistoryIndex := Model.GetTableIndexExisting(aTableHistory);
  end;
  for t := 0 to high(aTable) do begin
    tableIndex := Model.GetTableIndexExisting(aTable[t]);
    if aTable[t].InheritsFrom(TSQLRecordHistory) then
      raise EORMException.CreateUTF8('%.TrackChanges([%]) not allowed',[self,aTable[t]]);
    if cardinal(tableIndex)<fTrackChangesHistoryTableIndexCount then begin
      fTrackChangesHistoryTableIndex[tableIndex] := TableHistoryIndex;
      if TableHistoryIndex>=0 then
        with fTrackChangesHistory[TableHistoryIndex] do begin
          if CurrentRow=0 then
            CurrentRow := TableRowCount(aTableHistory);
          MaxSentDataJsonRow := aMaxHistoryRowBeforeBlob;
          MaxRevisionJSON := aMaxHistoryRowPerRecord;
          MaxUncompressedBlobSize := aMaxUncompressedBlobSize;
        end;
    end;
  end;
end;

function TSQLRestServer.InternalUpdateEventNeeded(aTableIndex: integer): boolean;
begin
  result := (self<>nil) and (Assigned(OnUpdateEvent) or
    ((cardinal(aTableIndex)<fTrackChangesHistoryTableIndexCount) and
     (fTrackChangesHistoryTableIndex[aTableIndex]>=0)));
end;

function TSQLRestServer.EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID;
var Rest: TSQLRest;
begin
  Rest := GetStaticTableIndex(TableModelIndex);
  if Rest=nil then
    result := MainEngineAdd(TableModelIndex,SentData) else
    result := Rest.EngineAdd(TableModelIndex,SentData);
end;

function TSQLRestServer.EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8;
var Rest: TSQLRest;
begin
  Rest := GetStaticTableIndex(TableModelIndex);
  if Rest=nil then
    result := MainEngineRetrieve(TableModelIndex,ID) else
    result := Rest.EngineRetrieve(TableModelIndex,ID);
end;

function TSQLRestServer.EngineList(const SQL: RawUTF8; ForceAJAX: Boolean;
  ReturnedRowCount: PPtrInt): RawUTF8;
var Rest: TSQLRest;
    StaticSQL: RawUTF8;
begin
  StaticSQL := SQL;
  Rest := InternalAdaptSQL(Model.GetTableIndexFromSQLSelect(SQL,false),StaticSQL);
  if Rest=nil then
    result := MainEngineList(SQL,ForceAJAX,ReturnedRowCount) else
    result := Rest.EngineList(StaticSQL,ForceAJAX,ReturnedRowCount);
end;

function TSQLRestServer.EngineUpdate(TableModelIndex: integer; ID: TID;
  const SentData: RawUTF8): boolean;
var Rest: TSQLRest;
begin
  Rest := GetStaticTableIndex(TableModelIndex);
  if Rest=nil then
    result := MainEngineUpdate(TableModelIndex,ID,SentData) else
    result := Rest.EngineUpdate(TableModelIndex,ID,SentData);
end;

function TSQLRestServer.EngineDelete(TableModelIndex: integer; ID: TID): boolean;
var Rest: TSQLRest;
begin
  Rest := GetStaticTableIndex(TableModelIndex);
  if Rest=nil then
    result := MainEngineDelete(TableModelIndex,ID) else
    result := Rest.EngineDelete(TableModelIndex,ID);
  if result then
    if Model.TableProps[TableModelIndex].Props.RecordVersionField<>nil then
      InternalRecordVersionDelete(TableModelIndex,ID,nil);
end;

function TSQLRestServer.EngineDeleteWhere(TableModelIndex: integer;
  const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean;
var Rest: TSQLRest;
    Batch: TSQLRestBatch;
    i: integer;
begin
  case length(IDs) of
  0: result := false;
  1: result := EngineDelete(TableModelIndex,IDs[0]);
  else begin
    Rest := GetStaticTableIndex(TableModelIndex);
    if Rest=nil then
      result := MainEngineDeleteWhere(TableModelIndex,SQLWhere,IDs) else
      result := Rest.EngineDeleteWhere(TableModelIndex,SQLWhere,IDs);
    if (Model.TableProps[TableModelIndex].Props.RecordVersionField=nil) or
       not result then
      exit;
    Batch := TSQLRestBatch.Create(Self,Model.Tables[TableModelIndex],1000);
    try
      for i := 0 to high(IDs) do
        InternalRecordVersionDelete(TableModelIndex,IDs[i],Batch);
      BatchSend(Batch); // allow faster deletion for engines allowing it
    finally
      Batch.Free;
    end;
  end;
  end;
end;

function TSQLRestServer.EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean;
var Rest: TSQLRest;
begin
  Rest := GetStaticTableIndex(TableModelIndex);
  if Rest=nil then
    result := MainEngineRetrieveBlob(TableModelIndex,aID,BlobField,BlobData) else
    result := Rest.EngineRetrieveBlob(TableModelIndex,aID,BlobField,BlobData);
end;

function TSQLRestServer.EngineUpdateBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean;
var Rest: TSQLRest;
begin
  Rest := GetStaticTableIndex(TableModelIndex);
  if Rest=nil then
    result := MainEngineUpdateBlob(TableModelIndex,aID,BlobField,BlobData) else
    result := Rest.EngineUpdateBlob(TableModelIndex,aID,BlobField,BlobData);
end;

function TSQLRestServer.EngineUpdateField(TableModelIndex: integer;
  const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean;
var Rest: TSQLRest;
begin
  Rest := GetStaticTableIndex(TableModelIndex);
  if Rest=nil then
    result := MainEngineUpdateField(TableModelIndex,SetFieldName,SetValue,
      WhereFieldName,WhereValue) else
    result := Rest.EngineUpdateField(TableModelIndex,SetFieldName,SetValue,
      WhereFieldName,WhereValue);
end;

function TSQLRestServer.EngineUpdateFieldIncrement(TableModelIndex: integer;
  ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean;
var Rest: TSQLRest;
begin
  Rest := GetStaticTableIndex(TableModelIndex);
  if Rest=nil then
    result := MainEngineUpdateFieldIncrement(TableModelIndex,ID,FieldName,Increment) else
    result := Rest.EngineUpdateFieldIncrement(TableModelIndex,ID,FieldName,Increment);
end;

function TSQLRestServer.EngineBatchSend(Table: TSQLRecordClass;
  var Data: RawUTF8; var Results: TIDDynArray; ExpectedResultsCount: integer): integer;
var EndOfObject: AnsiChar;
    wasString, OK: boolean;
    TableName, Value, ErrMsg: RawUTF8;
    URIMethod, RunningBatchURIMethod: TSQLURIMethod;
    RunningBatchRest, RunningRest: TSQLRest;
    Sent, Method, MethodTable: PUTF8Char;
    AutomaticTransactionPerRow: cardinal;
    RowCountForCurrentTransaction: cardinal;
    RunTableTransactions: array of TSQLRest;
    RunMainTransaction: boolean;
    ID: TID;
    Count: integer;
    timeoutTix: Int64;
    batchOptions: TSQLRestBatchOptions;
    RunTable, RunningBatchTable: TSQLRecordClass;
    RunTableIndex,i,TableIndex: integer;
    RunStatic: TSQLRest;
    RunStaticKind: TSQLRestServerKind;
    CurrentContext: TSQLRestServerURIContext;
    counts: array[mPOST..mDELETE] of cardinal;

  procedure PerformAutomaticCommit;
  var i: integer;
  begin
    if RunningBatchRest<>nil then begin
      RunningBatchRest.InternalBatchStop; // send pending rows before commit
      RunningBatchRest := nil;
      RunningBatchTable := nil;
    end;
    for i := 0 to high(RunTableTransactions) do
      if RunTableTransactions[i]<>nil then begin
        RunTableTransactions[i].Commit(CONST_AUTHENTICATION_NOT_USED,true);
        if RunTableTransactions[i]=Self then
          RunMainTransaction := false;
        RunTableTransactions[i] := nil; // to acquire and begin a new transaction
      end;
    RowCountForCurrentTransaction := 0;
  end;
  function IsNotAllowed: boolean;
  begin
    result := (CurrentContext<>nil) and (CurrentContext.Command=execORMWrite) and
      not CurrentContext.Call.RestAccessRights^.CanExecuteORMWrite(
        URIMethod,RunTable,RunTableIndex,ID,CurrentContext);
  end;

{$ifdef WITHLOG}
var log: ISynLog; // for Enter auto-leave to work with FPC
{$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter('EngineBatchSend % inlen=%',[Table,length(Data)],self);
  {$endif}
  Sent := UniqueRawUTF8(Data); // parsed, therefore modified in-placed
  if Sent=nil then
    raise EORMBatchException.CreateUTF8('%.EngineBatchSend(%,"")',[self,Table]);
  if Table<>nil then begin
    TableIndex := Model.GetTableIndexExisting(Table);
    // unserialize expected sequence array as '{"Table":["cmd",values,...]}'
    if not NextNotSpaceCharIs(Sent,'{') then
      raise EORMBatchException.CreateUTF8('%.EngineBatchSend: Missing {',[self]);
    TableName := GetJSONPropName(Sent);
    if (TableName='') or (Sent=nil) or
       not IdemPropNameU(TableName,Model.TableProps[TableIndex].Props.SQLTableName) then
      raise EORMBatchException.CreateUTF8('%.EngineBatchSend(%): Wrong "Table":"%"',
        [self,Table,TableName]);
  end else // or '["cmd@Table":values,...]'
    TableIndex := -1;
  if not NextNotSpaceCharIs(Sent,'[') then
    raise EORMBatchException.CreateUTF8('%.EngineBatchSend: Missing [',[self]);
  if IdemPChar(Sent,'"AUTOMATICTRANSACTIONPERROW",') then begin
    inc(Sent,29);
    AutomaticTransactionPerRow := GetNextItemCardinal(Sent,',');
  end else
    AutomaticTransactionPerRow := 0;
  SetLength(RunTableTransactions,Model.TablesMax+1);
  RunMainTransaction := false;
  RowCountForCurrentTransaction := 0;
  if IdemPChar(Sent,'"OPTIONS",') then begin
    inc(Sent,10);
    byte(batchOptions) := GetNextItemCardinal(Sent,',');
  end else
    byte(batchOptions) := 0;
  CurrentContext := ServiceContext.Request;
  MethodTable := nil;
  RunningBatchRest := nil;
  RunningBatchTable := nil;
  RunningBatchURIMethod := mNone;
  Count := 0;
  FillCharFast(counts,SizeOf(counts),0);
  fAcquireExecution[execORMWrite].fSafe.Lock; // multi thread protection
  try // to protect automatic transactions and global write lock
  try // to protect InternalBatchStart/Stop locking
    repeat // main loop: process one POST/PUT/DELETE per iteration
      // retrieve method name and associated (static) table
      Method := GetJSONField(Sent,Sent,@wasString);
      if (Sent=nil) or (Method=nil) or not wasString then
        raise EORMBatchException.CreateUTF8('%.EngineBatchSend: Missing CMD',[self]);
      MethodTable := PosChar(Method,'@');
      if MethodTable=nil then begin // e.g. '{"Table":[...,"POST",{object},...]}'
        if TableIndex<0 then
          raise EORMBatchException.CreateUTF8(
            '%.EngineBatchSend: "..@Table" expected',[self]);
        RunTableIndex := TableIndex;
        RunTable := Table;
      end else begin                // e.g. '[...,"POST@Table",{object},...]'
        RunTableIndex := Model.GetTableIndexPtr(MethodTable+1);
        if RunTableIndex<0 then
          raise EORMBatchException.CreateUTF8('%.EngineBatchSend: Unknown %',
            [self,MethodTable]);
        RunTable := Model.Tables[RunTableIndex];
      end;
      RunStatic := GetStaticTableIndex(RunTableIndex,RunStaticKind);
      if RunStatic=nil then
        RunningRest := self else
        RunningRest := RunStatic;
      // get CRUD method and associated Value/ID
      case IdemPCharArray(Method,['POST','PUT','DELETE','SIMPLE']) of
        // IdemPCharArray() will ignore '@' char if appended after method name
        0: begin
          // '{"Table":[...,"POST",{object},...]}' or '[...,"POST@Table",{object},...]'
          URIMethod := mPOST;
          Value := JSONGetObject(Sent,@ID,EndOfObject,true);
          if Sent=nil then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: Wrong POST',[self]);
          if IsNotAllowed then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: POST/Add not allowed on %',[self,RunTable]);
          if not RecordCanBeUpdated(RunTable,ID,seAdd,@ErrMsg)  then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: POST impossible: %',[self,ErrMsg]);
        end;
        1: begin
          // '{"Table":[...,"PUT",{object},...]}' or '[...,"PUT@Table",{object},...]'
          URIMethod := mPUT;
          Value := JSONGetObject(Sent,@ID,EndOfObject,false);
          if (Sent=nil) or (Value='') or (ID<=0) then
            raise EORMBatchException.CreateUTF8('%.EngineBatchSend: Wrong PUT',[self]);
          if IsNotAllowed then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: PUT/Update not allowed on %',[self,RunTable]);
        end;
        2: begin
          // '{"Table":[...,"DELETE",ID,...]}' or '[...,"DELETE@Table",ID,...]'
          URIMethod := mDELETE;
          ID := GetInt64(GetJSONField(Sent,Sent,@wasString,@EndOfObject));
          if (ID<=0) or wasString then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: Wrong DELETE',[self]);
          if IsNotAllowed then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: DELETE not allowed on %',[self,RunTable]);
          if not RecordCanBeUpdated(RunTable,ID,seDelete,@ErrMsg) then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: DELETE impossible [%]',[self,ErrMsg]);
        end;
        3: begin
          // '{"Table":[...,"SIMPLE",[values],...]}' or '[...,"SIMPLE@Table",[values],...]'
          URIMethod := mPOST;
          Value := Model.TableProps[RunTableIndex].Props.
            SaveSimpleFieldsFromJsonArray(Sent,EndOfObject,true);
          ID := 0; // no ID is never transmitted with simple fields
          if (Sent=nil) or (Value='') then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: Wrong SIMPLE',[self]);
          if IsNotAllowed then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: SIMPLE/Add not allowed on %',[self,RunTable]);
          if not RecordCanBeUpdated(RunTable,0,seAdd,@ErrMsg)  then
            raise EORMBatchException.CreateUTF8(
              '%.EngineBatchSend: SIMPLE/Add impossible: %',[self,ErrMsg]);
        end;
        else raise EORMBatchException.CreateUTF8(
          '%.EngineBatchSend: Unknown [%] method',[self,Method]);
      end;
      if (Count=0) and (EndOfObject=']') then begin
        // single operation do not need a transaction nor InternalBatchStart/Stop
        AutomaticTransactionPerRow := 0;
        SetLength(Results,1);
      end else begin
        // handle auto-committed transaction process
        if AutomaticTransactionPerRow>0 then begin
          if RowCountForCurrentTransaction=AutomaticTransactionPerRow then
            PerformAutomaticCommit; // reached AutomaticTransactionPerRow chunk
          inc(RowCountForCurrentTransaction);
          if RunTableTransactions[RunTableIndex]=nil then
            // initiate transaction for this table if not started yet
            if (RunStatic<>nil) or not RunMainTransaction then begin
              timeoutTix := GetTickCount64+2000;
              repeat
                if RunningRest.TransactionBegin(RunTable, // acquire transaction
                     CONST_AUTHENTICATION_NOT_USED) then begin
                  RunTableTransactions[RunTableIndex] := RunningRest;
                  if RunStatic=nil then
                    RunMainTransaction := true;
                  Break;
                end;
                if GetTickCount64>timeoutTix then
                  raise EORMBatchException.CreateUTF8(
                    '%.EngineBatchSend: %.TransactionBegin timeout',[self,RunningRest]);
                SleepHiRes(1); // retry in 1 ms
              until fShutdownRequested;
            end;
        end;
        // handle batch pending request sending (if table or method changed)
        if (RunningBatchRest<>nil) and
           ((RunTable<>RunningBatchTable) or (RunningBatchURIMethod<>URIMethod)) then begin
          RunningBatchRest.InternalBatchStop; // send pending statements
          RunningBatchRest := nil;
          RunningBatchTable := nil;
        end;
        if (RunStatic<>nil) and (RunStatic<>RunningBatchRest) and
           RunStatic.InternalBatchStart(URIMethod,batchOptions) then begin
          RunningBatchRest := RunStatic;
          RunningBatchTable := RunTable;
          RunningBatchURIMethod := URIMethod;
        end else
        if (RunningBatchRest=nil) and (RunStatic=nil) and
           InternalBatchStart(URIMethod,batchOptions) then begin
          RunningBatchRest := self; // e.g. multi-insert in main SQlite3 engine
          RunningBatchTable := RunTable;
          RunningBatchURIMethod := URIMethod;
        end;
        if Count>=length(Results) then
          SetLength(Results,NextGrow(Count));
      end;
      // process CRUD method operation
      OK := false;
      Results[Count] := HTTP_NOTMODIFIED;
      case URIMethod of
      mDELETE: begin
        if EngineDelete(RunTableIndex,ID) then begin
          if fCache<>nil then
            fCache.NotifyDeletion(RunTableIndex,ID);
          if (RunningBatchRest<>nil) or
             AfterDeleteForceCoherency(RunTableIndex,ID) then begin
            Results[Count] := HTTP_SUCCESS; // 200 OK
            OK := true;
          end;
        end;
      end;
      mPOST: begin
        ID := EngineAdd(RunTableIndex,Value);
        Results[Count] := ID;
        if ID<>0 then begin
          if fCache<>nil then
            fCache.Notify(RunTableIndex,ID,Value,soInsert);
          OK := true;
        end;
      end;
      mPUT:
        if EngineUpdate(RunTableIndex,ID,Value) then begin
          Results[Count] := HTTP_SUCCESS; // 200 OK
          OK := true;
          if fCache<>nil then // JSON Value may be uncomplete -> delete from cache
            if not (boPutNoCacheFlush in batchOptions) then
              fCache.NotifyDeletion(RunTableIndex,ID);
        end;
      end;
      if (boRollbackOnError in batchOptions) and not OK then
        raise EORMBatchException.CreateUTF8('%.EngineBatchSend: Results[%]=% on % %',
          [self,Count,Results[Count],Method,RunTable]);
      inc(Count);
      inc(counts[URIMethod]);
    until EndOfObject=']';
    if (AutomaticTransactionPerRow>0) and (RowCountForCurrentTransaction>0) then
      // send pending rows within transaction
      PerformAutomaticCommit;
  finally
    try
      if RunningBatchRest<>nil then
        RunningBatchRest.InternalBatchStop; // send pending rows, and release Safe.Lock
    finally
      fAcquireExecution[execORMWrite].fSafe.UnLock;
      InternalLog('EngineBatchSend json=% add=% update=% delete=% %%',
        [KB(Data),counts[mPOST],counts[mPUT],counts[mDELETE],MethodTable,Table]);
    end;
  end;
  except
    on E: Exception do begin
      if (AutomaticTransactionPerRow>0) and (RowCountForCurrentTransaction>0) then begin
        for i := 0 to high(RunTableTransactions) do
          if RunTableTransactions[i]<>nil then
            RunTableTransactions[i].RollBack(CONST_AUTHENTICATION_NOT_USED);
        UniqueRawUTF8ZeroToTilde(data,1 shl 16);
        InternalLog('% -> PARTIAL rollback of latest auto-committed transaction data=%',
          [E,data], sllWarning);
      end;
      raise;
    end;
  end;
  if Table<>nil then begin // '{"Table":["cmd":values,...]}' format
    if Sent=nil then
      raise EORMBatchException.CreateUTF8('%.EngineBatchSend: % Truncated',[self,Table]);
    while not (Sent^ in ['}',#0]) do inc(Sent);
    if Sent^<>'}' then
      raise EORMBatchException.CreateUTF8('%.EngineBatchSend(%): Missing }',[self,Table]);
  end;
  // if we reached here, process was OK
  SetLength(Results,Count);
  result := HTTP_SUCCESS;
end;

function CurrentServiceContext: TServiceRunningContext;
begin
  result := ServiceContext;
end;

function CurrentServiceContextServer: TSQLRestServer;
begin
  with PServiceRunningContext(@ServiceContext)^ do
  if Request<>nil then
    result := Request.Server else
    result := nil;
end;


function ToText(gran: TSynMonitorUsageGranularity): PShortString;
begin
  result := GetEnumName(TypeInfo(TSynMonitorUsageGranularity),ord(gran));
end;

function ToText(ft: TSQLFieldType): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLFieldType),ord(ft));
end;

function ToText(vk: TSQLRecordVirtualKind): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLRecordVirtualKind),ord(vk));
end;

function ToText(e: TSQLEvent): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLEvent),ord(e));
end;

function ToText(he: TSQLHistoryEvent): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLHistoryEvent),ord(he));
end;

function ToText(o: TSQLOccasion): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLOccasion),ord(o));
end;

function ToText(dft: TSQLDBFieldType): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLDBFieldType),ord(dft));
end;

function ToText(si: TServiceInstanceImplementation): PShortString;
begin
  result := GetEnumName(TypeInfo(TServiceInstanceImplementation),ord(si));
end;

function ToText(cmd: TSQLRestServerURIContextCommand): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLRestServerURIContextCommand),ord(cmd));
end;

function ToText(op: TSQLQueryOperator): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLQueryOperator),ord(op));
end;

function ToText(V: TInterfaceMockSpyCheck): PShortString;
begin
  result := GetEnumName(TypeInfo(TInterfaceMockSpyCheck),ord(V));
end;

function ToText(m: TSQLURIMethod): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLURIMethod),ord(m));
end;

function ToText(o: TSynTableStatementOperator): PShortString;
begin
  result := GetEnumName(TypeInfo(TSynTableStatementOperator),ord(o));
end;

function ToText(t: TSQLVirtualTableTransaction): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLVirtualTableTransaction),ord(t));
end;

function ToText(a: TSQLRestServerAuthenticationSignedURIAlgo): PShortString;
begin
  result := GetEnumName(TypeInfo(TSQLRestServerAuthenticationSignedURIAlgo),ord(a));
end;

function ToText(res: TNotifyAuthenticationFailedReason): PShortString;
begin
  result := GetEnumName(TypeInfo(TNotifyAuthenticationFailedReason),ord(res));
end;



{ TSQLRestClientURIDll }

constructor TSQLRestClientURIDll.Create(aModel: TSQLModel; const DllName: TFileName);
var aRequest: TURIMapRequest;
    {$ifdef FPC}
    aDLL: TLibHandle;
    {$else}
    aDLL: THandle;
    {$endif}
begin
  {$ifdef KYLIX3}
  aDLL := LoadLibrary(pointer(DllName));
  {$else}
  {$ifdef FPC}
  aDLL := LoadLibrary(DllName);
  {$else}
  aDLL := LoadLibrary(pointer(DllName));
  {$endif}
  {$endif}
  if aDLL=0 then
    raise ECommunicationException.CreateUTF8('%.Create: LoadLibrary(%)',[self,DllName]);
  aRequest := GetProcAddress(aDLL,'URIRequest');
  if (@aRequest=nil) or (aRequest(nil,nil,nil,nil,nil).Lo<>HTTP_NOTFOUND) then begin
    FreeLibrary(aDLL);
    raise ECommunicationException.CreateUTF8(
      '%.Create: % doesn''t export a valid URIRequest() function',[self,DllName]);
  end;
  Create(aModel,aRequest);
  fLibraryHandle := aDLL;
end;

constructor TSQLRestClientURIDll.Create(aModel: TSQLModel; aRequest: TURIMapRequest);
begin
  inherited Create(aModel);
  Func := aRequest;
end;

destructor TSQLRestClientURIDll.Destroy;
begin
  if fLibraryHandle<>0 then
    FreeLibrary(fLibraryHandle);
  inherited;
end;

procedure TSQLRestClientURIDll.InternalURI(var Call: TSQLRestURIParams);
var result: Int64Rec;
    pHead, pResp: PUTF8Char;
begin
  if @Func=nil then begin
    Call.OutStatus := HTTP_NOTIMPLEMENTED; // 501 (no valid application or library)
    exit;
  end;
  pResp := nil;
  pHead := nil;
  try
    result := Func(pointer(Call.Url),pointer(Call.Method),pointer(Call.InBody),
      @pResp,@pHead);
    Call.OutStatus := result.Lo;
    Call.OutInternalState := result.Hi;
    if pHead<>nil then
      Call.OutHead := pHead;
    if pResp<>nil then
      Call.OutBody := pResp;
  finally // always release response memory allocated by the server
    if pResp<>nil then
      {$ifdef MSWINDOWS}
      if not USEFASTMM4ALLOC then
        GlobalFree(PtrUInt(pResp)) else
      {$endif}
        Freemem(pResp);
    if pHead<>nil then
      {$ifdef MSWINDOWS}
      if not USEFASTMM4ALLOC then
        GlobalFree(PtrUInt(pHead)) else
      {$endif}
        Freemem(pHead);
  end;
end;

function TSQLRestClientURIDll.InternalCheckOpen: boolean;
begin
  result := true; // success
end;

procedure TSQLRestClientURIDll.InternalClose;
begin
end;


{ TSQLRestClientRedirect }

constructor TSQLRestClientRedirect.Create(aModel: TSQLModel);
begin
  inherited Create(aModel);
  fModel.Owner := self;
end;

constructor TSQLRestClientRedirect.Create(aRedirected: TSQLRest);
begin
  if aRedirected=nil then
    raise EORMException.CreateUTF8('%.Create(nil)',[self]);
  Create(TSQLModel.Create(aRedirected.Model));
  RedirectTo(aRedirected);
end;

constructor TSQLRestClientRedirect.CreateOwned(aRedirected: TSQLRestServer);
begin
  Create(aRedirected);
  fPrivateGarbageCollector.Add(aRedirected);
end;

procedure TSQLRestClientRedirect.RedirectTo(aRedirected: TSQLRest);
begin
  fSafe.Enter;
  try
    fRedirectedClient := nil;
    fRedirectedServer := nil;
    if aRedirected=nil then
      exit; // redirection disabled
    if aRedirected.InheritsFrom(TSQLRestServer) then
      fRedirectedServer := aRedirected as TSQLRestServer else
    if aRedirected.InheritsFrom(TSQLRestClientURI) then
      fRedirectedClient := aRedirected as TSQLRestClientURI else
      raise EORMException.CreateUTF8('%.RedirectTo: % should be either % or %',
        [self,aRedirected,TSQLRestServer,TSQLRestClientURI]);
  finally
    fSafe.Leave;
  end;
end;

function TSQLRestClientRedirect.InternalCheckOpen: boolean;
begin
  result := Assigned(fRedirectedServer) or Assigned(fRedirectedClient);
end;

procedure TSQLRestClientRedirect.InternalClose;
begin
end;

procedure TSQLRestClientRedirect.InternalURI(var Call: TSQLRestURIParams);
begin
  fSafe.Enter;
  try
    if Assigned(fRedirectedServer) then
      fRedirectedServer.URI(Call) else
    if Assigned(fRedirectedClient) then
      // hook to access InternalURI() protected method
      TSQLRestClientRedirect(fRedirectedClient).InternalURI(Call) else
      Call.OutStatus := HTTP_GATEWAYTIMEOUT;
  finally
    fSafe.Leave;
  end;
end;


{$ifdef MSWINDOWS}

{$ifdef ANONYMOUSNAMEDPIPE}

// it should be necessary to Edit settings under Local Security Policy -> Local
// policies -> Security options -> Edit settings under "Network access" to allow
// for anonymous connections.

// BUT even with the pipe name added to the
//  SYSTEM\CurrentControlSet\Services\lanmanserver\parameters\NullSessionPipes
// registry key, code below didn't work

function GetUserSid(var SID: PSID; var Token: THandle): boolean;
var TokenUserSize: DWORD;
    TokenUserP: PSIDAndAttributes;
begin
  result := false;
  if not OpenThreadToken(GetCurrentThread,TOKEN_QUERY,True,Token) then
    if (GetLastError<>ERROR_NO_TOKEN) or
       not OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,Token) then
      exit;
  TokenUserP := nil;
  TokenUserSize := 0;
  try
    if not GetTokenInformation(Token,TokenUser,nil,0,TokenUserSize) and
       (GetLastError<>ERROR_INSUFFICIENT_BUFFER) then
      exit;
    TokenUserP := AllocMem(TokenUserSize);
    if not GetTokenInformation(Token,TokenUser,TokenUserP,TokenUserSize,TokenUserSize) then
      exit;
    SID := TokenUserP^.Sid;
    result := true;
  finally
    FreeMem(TokenUserP);
  end;
end;

type
  ACE_HEADER = record
    AceType: BYTE;
    AceFlags: BYTE;
    AceSize: WORD;
  end;
  ACCESS_ALLOWED_ACE = record
    Header: ACE_HEADER;
    Mask: ACCESS_MASK;
    SidStart: DWORD;
  end;

procedure InitializeSecurity(var SA: TSecurityAttributes; var SD);
const
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_ANONYMOUS_LOGON_RID = ($00000007);
  ACL_REVISION = 2;
var pSidAnonymous, pSidOwner: PSID;
    dwAclSize: integer;
    ACLP: PACL;
    Token: THandle;
begin
  FillcharFast(SD,SECURITY_DESCRIPTOR_MIN_LENGTH,0);
  // Initialize the new security descriptor
  if InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION) and
      GetUserSid(pSidOwner,Token) then begin
    AllocateAndInitializeSid(SECURITY_NT_AUTHORITY,1,
      SECURITY_ANONYMOUS_LOGON_RID,0,0,0,0,0,0,0,pSidAnonymous);
    try
      dwAclSize := SizeOf(TACL) +
        2 * ( SizeOf(ACCESS_ALLOWED_ACE) - SizeOf(DWORD) ) +
        GetLengthSid(pSidAnonymous) + GetLengthSid(pSidOwner) ;
      ACLP := AllocMem(dwAclSize);
      try
        InitializeAcl(ACLP^,dwAclSize,ACL_REVISION);
        if not AddAccessAllowedAce(ACLP^,ACL_REVISION,
           GENERIC_ALL,pSidOwner) then
          exit;
        if not AddAccessAllowedAce(ACLP^,ACL_REVISION,
           GENERIC_READ or GENERIC_WRITE,pSidAnonymous) then
          exit;
        if SetSecurityDescriptorDacl(@SD,true,ACLP,false) then begin
           // Set up the security attributes structure
           SA.nLength := SizeOf(TSecurityAttributes);
           SA.lpSecurityDescriptor := @SD;
           SA.bInheritHandle := true;
           exit; // mark OK
        end;
      finally
        FreeMem(ACLP);
      end;
    finally
      FreeSid(pSidAnonymous);
      CloseHandle(Token);
    end;
  end;
  FillcharFast(SA,SizeOf(SA),0); // mark error: no security
end;

{$else}

{$ifndef NOSECURITYFORNAMEDPIPECLIENTS}

{$if CompilerVersion >= 22.0} // fix Delphi XE incompatilibility
function InitializeSecurityDescriptor(pSecurityDescriptor: PSecurityDescriptor;
  dwRevision: DWORD): BOOL; stdcall; external advapi32;
function SetSecurityDescriptorDacl(pSecurityDescriptor: PSecurityDescriptor;
  bDaclPresent: BOOL; pDacl: PACL; bDaclDefaulted: BOOL): BOOL; stdcall; external advapi32;
{$ifend}

procedure InitializeSecurity(var SA: TSecurityAttributes; var SD);
begin
  FillcharFast(SD,SECURITY_DESCRIPTOR_MIN_LENGTH,0);
  // Initialize the new security descriptor
  if InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION) then begin
     // Add a NULL descriptor ACL to the security descriptor
     if SetSecurityDescriptorDacl(@SD, true, nil, false) then begin
        // Set up the security attributes structure
        SA.nLength := SizeOf(TSecurityAttributes);
        SA.lpSecurityDescriptor := @SD;
        SA.bInheritHandle := true;
        exit; // mark OK
     end;
  end;
  FillcharFast(SA,SizeOf(SA),0); // mark error: no security
end;

{$endif NOSECURITYFORNAMEDPIPECLIENTS}

{$endif ANONYMOUSNAMEDPIPE}


{ TSQLRestServerNamedPipe }

constructor TSQLRestServerNamedPipe.Create(aServer: TSQLRestServer;
  const PipeName: TFileName);
begin
  fServer := aServer;
  fPipeName := PipeName;
  inherited Create(aServer,false,false);
end;

destructor TSQLRestServerNamedPipe.Destroy;
var i: integer;
begin
  if fChildRunning>0 then begin
    for i := 0 to length(fChild)-1 do // close any still opened pipe
      if fChild[i]<>nil then
        fChild[i].Terminate;
    while fChildRunning>0 do
      SleepHiRes(64); // wait for all TSQLRestServerNamedPipeResponse.Destroy
  end;
  inherited;
end;

procedure TSQLRestServerNamedPipe.InternalExecute;
{$ifdef FPC}
const PIPE_UNLIMITED_INSTANCES = 255;
{$endif}
var aPipe: cardinal;
    Available: cardinal;
    {$ifndef NOSECURITYFORNAMEDPIPECLIENTS}
    fPipeSecurityAttributes: TSecurityAttributes;
    fPipeSecurityDescriptor: array[0..SECURITY_DESCRIPTOR_MIN_LENGTH] of byte;
    {$endif}
begin // see http://msdn.microsoft.com/en-us/library/aa365588(v=VS.85).aspx
  //writeln('TSQLRestServerNamedPipe=',integer(TSQLRestServerNamedPipe),'.Execute');
  {$ifndef NOSECURITYFORNAMEDPIPECLIENTS}
  InitializeSecurity(fPipeSecurityAttributes,fPipeSecurityDescriptor);
  {$endif}
  while not Terminated do begin
    //writeln('TSQLRestServerNamedPipe.CreateNamedPipe(',fPipeName,')');
    aPipe := CreateNamedPipe(pointer(fPipeName),
      PIPE_ACCESS_DUPLEX,
      PIPE_TYPE_BYTE or PIPE_READMODE_BYTE or PIPE_WAIT,
      PIPE_UNLIMITED_INSTANCES, 0, 0, 0,
      {$ifdef NOSECURITYFORNAMEDPIPECLIENTS}nil{$else}@fPipeSecurityAttributes{$endif});
    if aPipe=cardinal(INVALID_HANDLE_VALUE) then
      break;
    while not Terminated do
      if PeekNamedPipe(aPipe,nil,0,nil,@Available,nil) then
        if (Available>=4) then begin
          // PeekNamedPipe() made an implicit ConnectNamedPipe(aPipe,nil)
          TSQLRestServerNamedPipeResponse.Create(fServer,self,aPipe);
          aPipe := 0; // aPipe will be closed in TSQLRestServerNamedPipeResponse
          break;
        end
        else break // invalid request
      else SleepHiRes(128); // doesn't slow down connection but decreases CSwitch
    if aPipe<>0 then begin
      DisconnectNamedPipe(aPipe);
      CloseHandle(aPipe);
    end;
  end;
end;

procedure TSQLRestServerNamedPipe.AddChild(new: TSQLRestServerNamedPipeResponse);
var i: integer;
begin
  InterlockedIncrement(fChildRunning);
  i := ObjArrayFind(fChild,nil); // any free slot?
  if i<0 then
    ObjArrayAdd(fChild,new) else
    fChild[i] := new;
end;

procedure TSQLRestServerNamedPipe.RemoveChild(new: TSQLRestServerNamedPipeResponse);
var i: integer;
begin
  if self=nil then
    exit;
  new.fMasterThread := self;
  i := ObjArrayFind(fChild,new);
  if i>=0 then
    fChild[i] := nil; // reuse slot
  InterlockedDecrement(fChildRunning);
end;


{ TSQLRestServerNamedPipeResponse }

constructor TSQLRestServerNamedPipeResponse.Create(aServer: TSQLRestServer;
  aMasterThread: TSQLRestServerNamedPipe; aPipe: cardinal);
begin
  fServer := aServer;
  fPipe := aPipe;
{$ifdef LVCL}
  FOnTerminate := fServer.EndCurrentThread;
{$endif}
  fMasterThread := aMasterThread;
  fMasterThread.AddChild(self);
  FreeOnTerminate := true;
  inherited Create(fServer,false,false);
end;

destructor TSQLRestServerNamedPipeResponse.Destroy;
begin
  fMasterThread.RemoveChild(self);
  inherited;
end;

procedure TSQLRestServerNamedPipeResponse.InternalExecute;
var call: TSQLRestURIParams;
    Sleeper, Code: integer;
    Ticks64, ClientTimeOut64: Int64;
    RemoteIPHeader: RawUTF8;
    Available: cardinal;
begin
  if (fPipe=0) or (fPipe=Cardinal(INVALID_HANDLE_VALUE)) or (fServer=nil) then
    exit;
  RemoteIPHeader := 'RemoteIP: 127.0.0.1';
  call.Init;
  call.LowLevelConnectionID := fPipe;
  call.LowLevelFlags := [llfSecured]; // assume pipes communication is safe
  Ticks64 := 0;
  Sleeper := 0;
  ClientTimeOut64 := GetTickCount64+30*60*1000; // disconnect after 30 min idle
  try
    while not Terminated and not fMasterThread.Terminated do
    if // (WaitForSingleObject(fPipe,200)=WAIT_OBJECT_0)  = don't wait
       PeekNamedPipe(fPipe,nil,0,nil,@Available,nil) and (Available>=4) then begin
      FileRead(fPipe,Code,4);
      if (Code=integer(MAGIC_SYN)) // magic word for URI like request
        and not Terminated then
        try
          call.Url := ReadString(fPipe);
          call.Method := ReadString(fPipe);
          call.InHead := ReadString(fPipe);
          AddToCSV(RemoteIPHeader,call.InHead,#13#10);
          call.InBody := ReadString(fPipe);
          call.RestAccessRights := @SUPERVISOR_ACCESS_RIGHTS;
          call.OutHead := ''; // may not be reset explicitly by fServer.URI()
          call.OutBody := '';
          // it's up to URI overridden method to implement access rights
          fServer.URI(call);
          FileWrite(fPipe,call.OutStatus,SizeOf(cardinal));
          FileWrite(fPipe,call.OutInternalState,SizeOf(cardinal));
          WriteString(fPipe,call.OutHead);
          WriteString(fPipe,call.OutBody);
          FlushFileBuffers(fPipe); // Flush the pipe to allow the client to read
          Ticks64 := GetTickCount64+20; // start sleeping after 20 ms
          ClientTimeOut64 := Ticks64+30*60*1000;
          Sleeper := 0;
          SleepHiRes(0);
        except
          on Exception do // error in ReadString() or fServer.URI()
            break; // disconnect client
        end else
          break; // invalid magic word: disconnect client
    end else
    if (Ticks64=0) or (GetTickCount64>Ticks64) then begin
      if Sleeper<128 then
        inc(Sleeper,8);
      SleepHiRes(Sleeper); // doesn't slow down connection but decreases CSwitch
      Ticks64 := 0;
      if GetTickCount64>ClientTimeOut64 then begin
        fServer.InternalLog('Disconnected % after 30 min of inactivity',[self]);
        break;
      end;
    end else
      SleepHiRes(0);
  finally
    DisconnectNamedPipe(fPipe);
    CloseHandle(fPipe);
  end;
end;


{ TSQLRestClientURINamedPipe }

function ImpersonateAnonymousToken(ThreadHandle: THANDLE): BOOL; stdcall; external advapi32;

constructor TSQLRestClientURINamedPipe.Create(aModel: TSQLModel;
  const ApplicationName: TFileName);
begin
  inherited Create(aModel);
  if {$ifdef UNICODE}IdemPCharW{$else}IdemPChar{$endif}(pointer(ApplicationName),'\\') then
    fPipeName := ApplicationName else // caller specified a full path
    fPipeName := ServerPipeNamePrefix+ApplicationName;
end;

procedure TSQLRestClientURINamedPipe.DefinitionTo(Definition: TSynConnectionDefinition);
begin
  if Definition=nil then
    exit;
  inherited DefinitionTo(Definition); // write Kind + User/Password
  Definition.ServerName := StringToUTF8(fPipeName);
end;

constructor TSQLRestClientURINamedPipe.RegisteredClassCreateFrom(aModel: TSQLModel;
  aDefinition: TSynConnectionDefinition);
begin
  Create(aModel,UTF8ToString(aDefinition.ServerName));
  inherited RegisteredClassCreateFrom(aModel,aDefinition); // call SetUser()
end;

function TSQLRestClientURINamedPipe.InternalCheckOpen: boolean;
procedure InternalCreateClientPipe;
var Pipe: THandle;
    StartTime64: Int64;
    {$ifdef WITHLOG}
    log: ISynLog;
    {$endif}
procedure CreatePipe;
begin
  Pipe := CreateFile(pointer(fPipeName), GENERIC_READ or GENERIC_WRITE,
{$ifdef ANONYMOUSNAMEDPIPE}
    FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil, OPEN_EXISTING, SECURITY_SQOS_PRESENT or SECURITY_ANONYMOUS, 0);
{$else}
    0, {$ifdef NOSECURITYFORNAMEDPIPECLIENTS}nil{$else}@fPipeSecurityAttributes{$endif},
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0);
{$endif}
end;
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter(self, 'InternalCheckOpen');
  {$endif}
{$ifdef ANONYMOUSNAMEDPIPE}
  if not ImpersonateAnonymousToken(GetCurrentThread) then
     raise Exception.Create('ImpersonateAnonymousToken');
  try
{$else}
  {$ifndef NOSECURITYFORNAMEDPIPECLIENTS}
  InitializeSecurity(fPipeSecurityAttributes,fPipeSecurityDescriptor);
  {$endif}
{$endif}
  StartTime64 := GetTickCount64;
  CreatePipe;
  while (Pipe=INVALID_HANDLE_VALUE) and (GetLastError=ERROR_FILE_NOT_FOUND) do begin
    SleepHiRes(10); // wait for TSQLRestServerNamedPipe.EngineExecute to be reached
    CreatePipe;
    if (Pipe<>INVALID_HANDLE_VALUE) or (GetTickCount64>StartTime64+500) then
      break;
  end;
  StartTime64 := GetTickCount64;
  if (Pipe=INVALID_HANDLE_VALUE) and (GetLastError=ERROR_PIPE_BUSY) then
    InternalLog('Busy % -> retry',[fPipeName],sllDebug);
    repeat
      SleepHiRes(10);
      if WaitNamedPipe(pointer(fPipeName),50) then begin
        CreatePipe;
        if GetLastError<>ERROR_PIPE_BUSY then
          break;
      end;
    until GetTickCount64>StartTime64+2000;
  if Pipe=INVALID_HANDLE_VALUE then begin
    InternalLog('when connecting to % after % ms',
      [fPipeName,GetTickCount64-StartTime64],sllLastError);
    exit;
  end;
{$ifdef ANONYMOUSNAMEDPIPE}
  finally
    RevertToSelf; // we just needed to be anonymous during pipe connection
  end;
{$endif}
  InternalLog('Connected to %',[fPipeName],sllDebug);
  fServerPipe := Pipe;
end;
begin
  if fServerPipe<>0 then begin
    result := true;
    exit; // only reconnect if forced by InternalClose call or at first access
  end;
  InternalCreateClientPipe; // local sub-procedure to reduce stack overhead
  result := fServerPipe<>0;
end;

procedure TSQLRestClientURINamedPipe.InternalClose;
begin
  if fServerPipe<>0 then begin   // inherited; may use pipe -> close after
    WriteString(fServerPipe,''); // send integer=0 -> force server disconnect
    FileClose(fServerPipe);
  end;
end;

procedure TSQLRestClientURINamedPipe.InternalURI(var Call: TSQLRestURIParams);
var Card: cardinal;
{.$define TSQLRestClientURIDll_TIMEOUT} // to be tried over slow networks if errors
    {$ifdef TSQLRestClientURIDll_TIMEOUT}
    i: integer;
    {$endif}
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter(self, 'InternalURI');
  {$endif}
  Call.OutStatus := HTTP_NOTIMPLEMENTED; // 501 (no valid application or library)
  fSafe.Enter;
  try
    if InternalCheckOpen then
    try
      Card := MAGIC_SYN; // magic word
      if FileWrite(fServerPipe,Card,4)<>4 then begin
        SleepHiRes(0);
        WaitNamedPipe(pointer(fPipeName),200);
        if FileWrite(fServerPipe,Card,4)<>4 then begin // pipe may be broken
          SleepHiRes(10);
          FileClose(fServerPipe);
          fServerPipe := 0;
          if not InternalCheckOpen then // recreate connection
            exit;
          if (fServerPipe=Invalid_Handle_Value) or
             (FileWrite(fServerPipe,Card,4)<>4) then begin
            Card := GetLastError;
            InternalLog('reconnecting to %',[fPipeName],sllLastError);
            if fServerPipe<>Invalid_Handle_Value then
              FileClose(fServerPipe);
            fServerPipe := 0;
            exit; // no existing pipe
          end;
        end;
      end;
      // send the request
      WriteString(fServerPipe,Call.Url);
      WriteString(fServerPipe,Call.Method);
      WriteString(fServerPipe,Call.InHead);
      WriteString(fServerPipe,Call.InBody);
      FlushFileBuffers(fServerPipe);
      // receive the answer
      {$ifdef TSQLRestClientURIDll_TIMEOUT}
      for i := 0 to 25 do // wait up to 325 ms
        if PeekNamedPipe(fServerPipe,nil,0,nil,@Card,nil) and
           (Card>=SizeOf(Int64)) then begin
          FileRead(fServerPipe,Call.OutStatus,SizeOf(cardinal));
          FileRead(fServerPipe,Call.OutInternalState,SizeOf(cardinal));
          Call.OutHead := ReadString(fServerPipe);
          Call.OutBody := ReadString(fServerPipe);
          exit;
        end else
        SleepHiRes(i);
      Call.OutStatus := HTTP_TIMEOUT; // 408 Request Timeout Error
      {$else}
      if FileRead(fServerPipe,Call.OutStatus,SizeOf(cardinal))=SizeOf(cardinal) then begin
        // FileRead() waits till response arrived (or pipe is broken)
        FileRead(fServerPipe,Call.OutInternalState,SizeOf(cardinal));
        Call.OutHead := ReadString(fServerPipe);
        Call.OutBody := ReadString(fServerPipe);
      end else
        Call.OutStatus := HTTP_NOTFOUND;
      {$endif}
     except
       on E: Exception do begin // error in ReadString()
         InternalLog('% for PipeName=%',[E,fPipeName],sllLastError);
         Call.OutStatus := HTTP_NOTIMPLEMENTED; // 501 (no valid application or library)
         WriteString(fServerPipe,''); // try to notify the server of client logout
         FileClose(fServerPipe);
         fServerPipe := 0;
       end;
     end;
  finally
    fSafe.Leave;
  end;
  with Call do
    InternalLog('% % status=% state=%',[method,url,OutStatus,OutInternalState],sllClient);
end;

{$endif MSWINDOWS}


{ TSQLRestServerMonitor }

constructor TSQLRestServerMonitor.Create(aServer: TSQLRestServer);
begin
  if aServer=nil then
    raise EORMException.CreateUTF8('%.Create(nil)',[self]);
  inherited Create(aServer.Model.Root);
  fServer := aServer;
  SetLength(fPerTable[false],length(aServer.Model.Tables));
  SetLength(fPerTable[true],length(aServer.Model.Tables));
  fStartDate := NowUTCToString;
end;

destructor TSQLRestServerMonitor.Destroy;
begin
  ObjArrayClear(fPerTable[false]);
  ObjArrayClear(fPerTable[true]);
  inherited;
end;

procedure TSQLRestServerMonitor.ProcessSuccess(IsOutcomingFile: boolean);
begin
  fSafe^.Lock;
  try
    inc(fSuccess);
    if IsOutcomingFile then
      inc(fOutcomingFiles);
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSQLRestServerMonitor.NotifyORM(aMethod: TSQLURIMethod);
begin
  fSafe^.Lock;
  try
    case aMethod of
    mGET,mLOCK: inc(fRead);
    mPOST:      inc(fCreated);
    mPUT:       inc(fUpdated);
    mDELETE:    inc(fDeleted);
    end;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSQLRestServerMonitor.NotifyORMTable(TableIndex, DataSize: integer;
  Write: boolean; const MicroSecondsElapsed: QWord);
const RW: array[boolean] of RawUTF8 = ('.read','.write');
var st: TSynMonitorWithSize;
begin
  if TableIndex<0 then
    exit;
  fSafe^.Lock;
  try
    if TableIndex>=length(fPerTable[Write]) then
      // tables may have been added after Create()
      SetLength(fPerTable[Write],TableIndex+1);
    if fPerTable[Write,TableIndex]=nil then
      fPerTable[Write,TableIndex] := TSynMonitorWithSize.Create(
        fServer.Model.TableProps[TableIndex].Props.SQLTableName+RW[Write]);
    st := fPerTable[Write,TableIndex];
    st.FromExternalMicroSeconds(MicroSecondsElapsed);
    st.AddSize(DataSize);
    if fServer.fStatUsage<>nil then
      fServer.fStatUsage.Modified(st,[]);
  finally
    fSafe^.UnLock;
  end;
end;

function TSQLRestServerMonitor.NotifyThreadCount(delta: integer): integer;
begin
  if self=nil then
    result := 0 else begin
    fSafe^.Lock;
    try
      inc(fCurrentThreadCount,delta);
      result := fCurrentThreadCount;
      if delta<>0 then
        Changed;
    finally
      fSafe^.UnLock;
    end;
  end;
end;


{ TSQLMonitorUsage }

function TSQLMonitorUsage.UsageID(aProcessIDShift: integer): integer;
begin
  result := fID shr aProcessIDShift;
end;


{ TSynMonitorUsageRest }

constructor TSynMonitorUsageRest.Create(aStorage: TSQLRest;
  aProcessID: Int64; aStoredClass: TSQLMonitorUsageClass;
  aProcessIDShift: integer);
var g: TSynMonitorUsageGranularity;
begin
  if aStorage=nil then
    raise ESynException.CreateUTF8('%.Create(nil)',[self]);
  if aProcessIDShift<0 then
    aProcessIDShift := 16 { see TSynUniqueIdentifierProcess } else
  if aProcessIDShift>40 then
    aProcessIDShift := 40;
  fProcessIDShift := aProcessIDShift;
  if aStoredClass=nil then
    fStoredClass := TSQLMonitorUsage else
    fStoredClass := aStoredClass;
  fStorage := aStorage;
  for g := low(fStoredCache) to high(fStoredCache) do
    fStoredCache[g] := fStoredClass.Create;
  fProcessID := aProcessID;
  {$ifdef WITHLOG}
  fLog := fStorage.LogFamily;
  {$endif}
  inherited Create;
end;

destructor TSynMonitorUsageRest.Destroy;
var g: TSynMonitorUsageGranularity;
begin
  inherited Destroy; // will save pending changes
  for g := low(fStoredCache) to high(fStoredCache) do
    fStoredCache[g].Free;
end;

function TSynMonitorUsageRest.LoadDB(ID: integer; Gran: TSynMonitorUsageGranularity;
  out Track: variant): boolean;
var recid: TID;
    rec: TSQLMonitorUsage;
begin
  if (ID=0) or (Gran<Low(fStoredCache)) or (Gran>high(fStoredCache)) then begin
    result := false;
    exit;
  end;
  rec := fStoredCache[Gran];
  recid := (Int64(ID) shl fProcessIDShift) or Int64(fProcessID);
  if rec.IDValue=recid then
    result := true else
  if fStorage.Retrieve(recid,rec) then begin // may use REST cache
    Track := rec.Info;
    if rec.Gran=mugHour then
      fComment := rec.Comment;
    if rec.Process<>fProcessID then
      fLog.SynLog.Log(sllWarning,'%.LoadDB(%,%) received Process=%, expected %',
        [ClassType,ID,ToText(Gran)^,rec.Process,fProcessID]);
    result := true;
  end else begin
    rec.ClearProperties;
    result := false;
  end;
end;

function TSynMonitorUsageRest.SaveDB(ID: integer; const Track: variant;
  Gran: TSynMonitorUsageGranularity): boolean;
var update: boolean;
    recid: TID;
    rec: TSQLMonitorUsage;
begin
  if (ID=0) or (Gran<Low(fStoredCache)) or (Gran>high(fStoredCache)) then begin
    result := false;
    exit;
  end;
  rec := fStoredCache[Gran];
  recid := (Int64(ID) shl fProcessIDShift) or Int64(fProcessID);
  if rec.IDValue=recid then // already available
    update := true else begin
    update := fStorage.Retrieve(recid,rec); // may use REST cache
    rec.IDValue := recid;
  end;
  rec.Gran := Gran;
  rec.Process := fProcessID;
  if Gran=mugHour then
    rec.Comment := fComment;
  rec.Info := Track;
  if fSaveBatch<>nil then
    if update then
      result := fSaveBatch.Update(rec)>=0 else
      result := fSaveBatch.Add(rec,true,true)>=0 else
    if update then
      result := fStorage.Update(rec) else
      result := fStorage.Add(rec,true,true)=recid;
end;


{ TSQLRestServerURI }

function TSQLRestServerURI.GetURI: TSQLRestServerURIString;
begin
  result := Address;
  if Port<>'' then
    result := result+':'+Port;
  if Root<>'' then
    result := result+'/'+Root;
end;

procedure TSQLRestServerURI.SetURI(const Value: TSQLRestServerURIString);
begin
  Split(Value,':',Address,Port);
  if Port<>'' then
    Split(Port,'/',Port,Root) else
    Split(Address,'/',Address,Root);
end;

function TSQLRestServerURI.Equals(const other: TSQLRestServerURI): boolean;
begin
  result := IdemPropNameU(Address,other.Address) and
            IdemPropNameU(Port,other.Port) and
            IdemPropNameU(Root,other.Root);
end;


{ TServicesPublishedInterfacesList }

constructor TServicesPublishedInterfacesList.Create(aTimeoutMS: integer);
begin
  inherited Create;
  fTimeOut := aTimeoutMS;
  fDynArray.Init(TypeInfo(TServicesPublishedInterfacesDynArray),List,@Count);
  fDynArrayTimeoutTix.Init(TypeInfo(TInt64DynArray),fTimeoutTix,@fTimeoutTixCount);
end;

function TServicesPublishedInterfacesList.FindURI(
  const aPublicURI: TSQLRestServerURI): integer;
var tix: Int64;
begin
  tix := GetTickCount64;
  Safe.Lock;
  try
    for result := 0 to Count-1 do
      if List[result].PublicURI.Equals(aPublicURI) then
        if (fTimeOut=0) or (fTimeoutTix[result]<tix) then
          exit;
    result := -1;
  finally
    Safe.UnLock;
  end;
end;

function TServicesPublishedInterfacesList.FindService(
  const aServiceName: RawUTF8): TSQLRestServerURIDynArray;
var i,n: integer;
    tix: Int64;
begin
  tix := GetTickCount64;
  result := nil;
  Safe.Lock;
  try
    n := 0;
    for i := Count-1 downto 0 do // downwards to return the latest first
      if FindPropName(List[i].Names,aServiceName)>=0 then
        if (fTimeOut=0) or (fTimeoutTix[i]<tix) then begin
          SetLength(result,n+1);
          result[n] := List[i].PublicURI;
          inc(n);
        end;
  finally
    Safe.UnLock;
  end;
end;

function TServicesPublishedInterfacesList.FindServiceAll(
  const aServiceName: RawUTF8): TSQLRestServerURIStringDynArray;
var i,n: integer;
    tix: Int64;
begin
  tix := GetTickCount64;
  result := nil;
  n := 0;
  Safe.Lock;
  try
    for i := Count-1 downto 0 do // downwards to return the latest first
      if FindPropName(List[i].Names,aServiceName)>=0 then
        if (fTimeOut=0) or (fTimeoutTix[i]<tix) then
          AddRawUTF8(TRawUTF8DynArray(result),n,List[i].PublicURI.URI);
  finally
    Safe.UnLock;
  end;
  SetLength(result,n);
end;

procedure TServicesPublishedInterfacesList.FindServiceAll(
  const aServiceName: RawUTF8; aWriter: TTextWriter);
var i: integer;
    tix: Int64;
begin
  tix := GetTickCount64;
  Safe.Lock;
  try
    aWriter.Add('[');
    if aServiceName='*' then begin
      // for RegisterFromServer: return all TServicesPublishedInterfaces
      for i := 0 to Count-1 do
        with List[i] do
          if (fTimeOut=0) or (fTimeoutTix[i]<tix) then begin
            aWriter.AddRecordJSON(List[i],TypeInfo(TServicesPublishedInterfaces));
            aWriter.Add(',');
          end;
    end else // from SQLRestClientURI.ServiceRetrieveAssociated
      // search matching (and non deprecated) services as TSQLRestServerURI
      for i := Count-1 downto 0 do // downwards to return the latest first
        with List[i] do
          if FindPropName(Names,aServiceName)>=0 then
            if (fTimeOut=0) or (fTimeoutTix[i]<tix) then begin
              aWriter.AddRecordJSON(PublicURI,TypeInfo(TSQLRestServerURI));
              aWriter.Add(',');
            end;
    aWriter.CancelLastComma;
    aWriter.Add(']');
  finally
    Safe.UnLock;
  end;
end;

function TServicesPublishedInterfacesList.RegisterFromServer(Client: TSQLRestClientURI): boolean;
var json: RawUTF8;
begin
  result := Client.CallBackGet('stat',['findservice','*'],json)=HTTP_SUCCESS;
  if result and (json<>'') then
    RegisterFromServerJSON(json);
end;

procedure TServicesPublishedInterfacesList.RegisterFromServerJSON(
  var PublishedJson: RawUTF8);
var tix: Int64;
    i: integer;
begin
  Safe.Lock;
  try
    fDynArray.LoadFromJSON(pointer(PublishedJson));
    fDynArrayTimeoutTix.Count := Count;
    tix := GetTickCount64;
    if fTimeout=0 then
      inc(tix,maxInt) else
      inc(tix,fTimeout);
    for i := 0 to Count-1 do
      fTimeoutTix[i] := tix;
  finally
    Safe.UnLock;
  end;
end;

procedure TServicesPublishedInterfacesList.RegisterFromClientJSON(
  var PublishedJson: RawUTF8);
var i: integer;
    nfo: TServicesPublishedInterfaces;
    crc: cardinal;
    tix: Int64;
    P: PUTF8Char;
begin
  if PublishedJson='' then
    exit;
  crc := crc32c(0,pointer(PublishedJson),length(PublishedJson));
  if (self=nil) or ((fLastPublishedJson<>0) and (crc=fLastPublishedJson)) then
    exit; // rough but working good in practice, when similar _contract_
  P := Pointer(PublishedJson);
  if P^='[' then
    inc(P); // when transmitted as [params] in a _contract_ HTTP body content
  if (RecordLoadJSON(nfo,P,TypeInfo(TServicesPublishedInterfaces))=nil) or
     (nfo.PublicURI.Address='') then
    exit; // invalid supplied JSON content
  Safe.Lock;
  try // store so that the latest updated version is always at the end
    for i := 0 to Count-1 do
      if List[i].PublicURI.Equals(nfo.PublicURI) then begin // ignore Timeout
        fDynArray.Delete(i);
        fDynArrayTimeoutTix.Delete(i);
        break;
      end;
    if nfo.Names<>nil then begin
      fDynArray.Add(nfo);
      tix := GetTickCount64;
      if fTimeout=0 then
        inc(tix,maxInt) else
        inc(tix,fTimeout);
      fDynArrayTimeoutTix.Add(tix);
    end;
    fLastPublishedJson := crc;
  finally
    Safe.UnLock;
  end;
end;


{ TSQLRestStorageRecordBased }

function TSQLRestStorageRecordBased.EngineAdd(TableModelIndex: integer;
  const SentData: RawUTF8): TID;
var Rec: TSQLRecord;
begin
  result := 0; // mark error
  if (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then
    exit;
  Rec := fStoredClass.Create;
  try
    Rec.FillFrom(SentData);
    StorageLock(true,'EngineAdd');
    try
      result := AddOne(Rec,Rec.fID>0,SentData);
    finally
      StorageUnLock;
    end;
  finally
    if result<=0 then
      Rec.Free; // on success, Rec is owned by fValue: TObjectList
  end;
end;

function TSQLRestStorageRecordBased.EngineUpdate(TableModelIndex: integer; ID: TID;
  const SentData: RawUTF8): boolean;
var Rec: TSQLRecord;
begin
  // this implementation won't handle partial fields update (e.g. BatchUpdate
  // after FillPrepare) - but TSQLRestStorageInMemory.EngineUpdate will
  if (ID<=0) or (TableModelIndex<0) or
     (Model.Tables[TableModelIndex]<>fStoredClass) then begin
    result := false; // mark error
    exit;
  end;
  StorageLock(true,'EngineUpdate');
  try
    Rec := fStoredClass.Create;
    try
      Rec.FillFrom(SentData);
      Rec.fID := ID;
      result := UpdateOne(Rec,SentData);
    finally
      Rec.Free;
    end;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageRecordBased.UpdateOne(ID: TID;
  const Values: TSQLVarDynArray): boolean;
var Rec: TSQLRecord;
begin
  if (ID<=0) then begin
    result := false; // mark error
    exit;
  end;
  StorageLock(true,'UpdateOne');
  try
    Rec := fStoredClass.Create;
    try
      Rec.SetFieldSQLVars(Values);
      Rec.fID := ID;
      result := UpdateOne(Rec,Rec.GetJSONValues(true,False,soUpdate));
    finally
      Rec.Free;
    end;
  finally
    StorageUnLock;
  end;
end;


{ TSQLRestStorageInMemoryUnique }

constructor TSQLRestStorageInMemoryUnique.Create(aOwner: TSQLRestStorageInMemory;
  aField: TSQLPropInfo);
begin
  fOwner := aOwner;
  fPropInfo := aField;
  fCaseInsensitive := not(aBinaryCollation in aField.Attributes);
  fHasher.Init(@fOwner.fValues,nil,EventHash,nil,nil,EventCompare,false);
end;

function TSQLRestStorageInMemoryUnique.EventCompare(const A,B): integer;
begin
  result := fPropInfo.CompareValue(TSQLRecord(A),TSQLRecord(B),fCaseInsensitive);
end;

function TSQLRestStorageInMemoryUnique.EventHash(const Elem): cardinal;
begin
  result := fPropInfo.GetHash(TSQLRecord(Elem),fCaseInsensitive);
end;

function TSQLRestStorageInMemoryUnique.Find(Rec: TSQLRecord): integer;
begin
  if self=nil then // no Unique index for this field
    result := -1 else begin
    fLastFindHashCode := fPropInfo.GetHash(Rec,fCaseInsensitive);
    result := fHasher.Find(@Rec,fLastFindHashCode);
  end;
end;

function TSQLRestStorageInMemoryUnique.AddedAfterFind(Rec: TSQLRecord): boolean;
begin
  fHasher.FindBeforeAdd(@Rec,result,fLastFindHashCode);
end;


{ TSQLRestStorageInMemory }

constructor TSQLRestStorageInMemory.Create(aClass: TSQLRecordClass; aServer: TSQLRestServer;
  const aFileName: TFileName; aBinaryFile: boolean);
var f: integer;
begin
  inherited Create(aClass,aServer);
  if (fStoredClassProps<>nil) and (fStoredClassProps.Kind in INSERT_WITH_ID) then
    raise EModelException.CreateUTF8('%.Create: % virtual table can''t be static',
      [self,aClass]);
  fFileName := aFileName;
  fBinaryFile := aBinaryFile;
  fValues.Init(TypeInfo(TSQLRecordObjArray),fValue,TSQLRecordDynArrayHashOne,
    TSQLRecordDynArrayCompare,nil,@fCount); // hashed and compared by ID
  fValues.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}IsObjArray := true;
  fSearchRec := fStoredClass.Create;
  if (ClassType<>TSQLRestStorageInMemory) and (fStoredClassProps<>nil) then
    with fStoredClassProps do begin // used by AdaptSQLForEngineList() method
      fBasicUpperSQLSelect[false] := SynCommons.UpperCase(SQL.SelectAllWithRowID);
      SetLength(fBasicUpperSQLSelect[false],length(fBasicUpperSQLSelect[false])-1); // trim right ';'
      fBasicUpperSQLSelect[true] := StringReplaceAll(fBasicUpperSQLSelect[false],' ROWID,',' ID,');
    end;
  if not IsZero(fIsUnique) then
    with fStoredClassRecordProps.Fields do begin
      SetLength(fUnique,Count);
      for f := 0 to Count-1 do
        if f in fIsUnique then
          fUnique[f] := TSQLRestStorageInMemoryUnique.Create(self,List[f]);
    end;
  ReloadFromFile;
end;

destructor TSQLRestStorageInMemory.Destroy;
begin
  UpdateFile;
  ObjArrayClear(fUnique);
  fValues.Clear; // to free all stored TSQLRecord instances
  fSearchRec.Free;
  inherited Destroy;
end;

function TSQLRestStorageInMemory.IDToIndex(ID: TID): PtrInt;
begin
  if self<>nil then begin
    fSearchRec.fID := ID;
    result := fValues.FindHashed(fSearchRec);
  end else
    result := -1;
end;

function TSQLRestStorageInMemory.AddOne(Rec: TSQLRecord; ForceID: boolean;
  const SentData: RawUTF8): TID;
var ndx, f: PtrInt;
    added: boolean;
begin
  result := -1; // error
  if (self=nil) or (Rec=nil) then
    exit;
  // ensure no duplicated ID or unique field
  for f := 0 to high(fUnique) do
    if f in fIsUnique then begin
      ndx := fUnique[f].Find(Rec);
      if ndx>=0 then begin
        InternalLog('AddOne: non unique %.% on % %',
          [fStoredClass,fUnique[f].PropInfo.Name,fValue[ndx],Rec],sllDB);
        exit;
      end;
    end;
  if ForceID then begin
    if Rec.fID<=0 then
      raise EORMException.CreateUTF8('%.AddOne(%.ForceID=0)',[self,Rec]);
    ndx := fValues.FindHashed(Rec);
    if ndx>=0 then begin
      InternalLog('AddOne: non unique %.ID on % %',[fStoredClass,fValue[ndx],Rec],sllDB);
      exit;
    end;
    if Rec.fID>fMaxID then
      fMaxID := Rec.fID else
      fUnSortedID := true;
  end else begin
    inc(fMaxID); // increasing sequence
    Rec.fID := fMaxID;
  end;
  // update internal hash tables and add to internal list
  for f := 0 to high(fUnique) do
    if f in fIsUnique then
      if not fUnique[f].AddedAfterFind(Rec) then // paranoid
        raise EORMException.CreateUTF8('%.AddOne on %.%',[self,Rec,fUnique[f].PropInfo.Name]);
  ndx := fValues.FindHashedForAdding(Rec,added);
  if added then
    fValue[ndx] := Rec else
    raise EORMException.CreateUTF8('%.AddOne % failed',[self,Rec]); // paranoid
  result := Rec.fID; // success
  fModified := true;
  if Owner<>nil then
    Owner.InternalUpdateEvent(seAdd,fStoredClassProps.TableIndex,result,SentData,nil);
end;

function TSQLRestStorageInMemory.UniqueFieldsUpdateOK(aRec: TSQLRecord; aUpdateIndex: integer): boolean;
var f,ndx: PtrInt;
begin
  result := false;
  for f := 0 to high(fUnique) do
  if f in fIsUnique then begin
    ndx := fUnique[f].Find(aRec);
    if (ndx>=0) and (ndx<>aUpdateIndex) then begin
      InternalLog('UniqueFieldsUpdateOK failed on % %',[fUnique[f].PropInfo.Name,aRec],sllDB);
      exit;
    end;
  end;
  result := true;
end;

function TSQLRestStorageInMemory.EngineDelete(TableModelIndex: integer; ID: TID): boolean;
begin
  if (self=nil) or (ID<=0) or (TableModelIndex<0) or
     (Model.Tables[TableModelIndex]<>fStoredClass) then
    result := false else begin
    StorageLock(True,'EngineDelete');
    try
      result := DeleteOne(IDToIndex(ID));
    finally
      StorageUnLock;
    end;
  end;
end;

function FindMaxID(p: PSQLRecord; n: integer): TID;
var id: TID;
begin
  result := 0;
  if n>0 then
    repeat
      id := p^.fID;
      if id>result then // branchless cmovg on 64-bit FPC
        result := id;
      inc(p);
      dec(n);
    until n=0;
end;

function FindMaxIDAndCheckSorted(p: PSQLRecord; n: integer; var unsorted: boolean): TID;
var id,prev: TID;
    {$ifndef CPUX86} lastnotsorted: pointer; {$endif}
begin
  prev := 0;
  result := 0;
  {$ifdef CPUX86} unsorted := false; {$else} lastnotsorted := nil; {$endif}
  if n>0 then
    repeat
      id := p^.fID;
      if id>result then // cmovg on 64-bit FPC
        result := id;
      if id<=prev then
        {$ifdef CPUX86}
        unsorted := true;
        {$else}
        lastnotsorted := p; // cmovle on 64-bit FPC
        {$endif}
      prev := id;
      inc(p);
      dec(n);
    until n=0;
  {$ifndef CPUX86} unsorted := lastnotsorted<>nil; {$endif}
end;

function TSQLRestStorageInMemory.DeleteOne(aIndex: integer): boolean;
var f: integer;
    rec: TSQLRecord;
begin
  if cardinal(aIndex)>=cardinal(fCount) then
    result := false else begin
    rec := fValue[aIndex];
    if rec.fID=fMaxID then
      fMaxID := 0; // recompute
    if Owner<>nil then // notify BEFORE deletion
       Owner.InternalUpdateEvent(seDelete,fStoredClassProps.TableIndex,rec.fID,'',nil);
    for f := 0 to high(fUnique) do
      if f in fIsUnique then
        if fUnique[f].Hasher.FindBeforeDelete(@rec)<aIndex then
          raise EORMException.CreateUTF8('%.DeleteOne(%) failed on %',
            [self,aIndex,fUnique[f].PropInfo.Name]);
    if fValues.FindHashedAndDelete(rec)<>aIndex then
      raise EORMException.CreateUTF8('%.DeleteOne(%) failed',[self,aIndex]);
    if fMaxID=0 then
      fMaxID := FindMaxID(pointer(fValue),fCount);
    fModified := true;
    result := true;
  end;
end;

function TSQLRestStorageInMemory.EngineDeleteWhere(TableModelIndex: Integer;
  const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean;
var ndx: TIntegerDynArray;
    n,i: PtrInt;
begin // RecordCanBeUpdated() has already been called
  result := false;
  n := length(IDs);
  SetLength(ndx,n);
  dec(n);
  StorageLock(True,'EngineDeleteWhere');
  try
    for i := 0 to n do begin
      if IDs[i]=fMaxID then
        fMaxID := 0; // force recompute
      ndx[i] := IDToIndex(IDs[i]);
      if ndx[i]<0 then
        exit;
    end;
    QuickSortInteger(pointer(ndx),0,n); // slightly faster in reverse order
    for i := n downto 0 do
      DeleteOne(ndx[i]);
    if fMaxID=0 then
      fMaxID := FindMaxID(pointer(fValue),fCount);
    result := true;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.EngineExecute(const aSQL: RawUTF8): boolean;
begin
  result := false; // there is no SQL engine with this class
end;

function TSQLRestStorageInMemory.GetID(Index: integer): TID;
begin
  if (self=nil) or (cardinal(Index)>=cardinal(fCount)) then
    result := 0 else
    result := fValue[Index].fID;
end;

function TSQLRestStorageInMemory.GetItem(Index: integer): TSQLRecord;
begin
  if self<>nil then
    if cardinal(Index)>=cardinal(fCount) then
      raise EORMException.CreateUTF8('%.GetItem(%) out of range',[self,Index]) else
      result := fValue[Index] else
    result := nil;
end;

procedure TSQLRestStorageInMemory.GetJSONValuesEvent(aDest: pointer;
  aRec: TSQLRecord; aIndex: integer);
var W: TJSONSerializer absolute aDest;
begin
  aRec.GetJSONValues(W);
  W.Add(',');
end;

function TSQLRestStorageInMemory.AdaptSQLForEngineList(var SQL: RawUTF8): boolean;
var P: PUTF8Char;
    Prop: RawUTF8;
    WithoutRowID: boolean;
begin
  result := inherited AdaptSQLForEngineList(SQL);
  if result then
    exit; // 'select * from table'
  if IdemPropNameU(fBasicSQLCount,SQL) or
     IdemPropNameU(fBasicSQLHasRows[false],SQL) or
     IdemPropNameU(fBasicSQLHasRows[true],SQL) then begin
    result := true;
    exit; // 'select count(*) from table' will be handled as static
  end;
  if fBasicUpperSQLSelect[false]='' then
    exit;
  if IdemPChar(pointer(SQL),pointer(fBasicUpperSQLSelect[false])) then
    WithoutRowID := false else
    if IdemPChar(pointer(SQL),pointer(fBasicUpperSQLSelect[true])) then
      WithoutRowID := true else
      exit;
  P := pointer(SQL);
  inc(P,length(fBasicUpperSQLSelect[WithoutRowID]));
  if P^ in [#0,';'] then begin
    result := true; // properly ended the WHERE clause as 'SELECT * FROM table'
    exit;
  end;
  P := GotoNextNotSpace(P);
  if not IdemPChar(P,'WHERE ') then begin
    if IdemPChar(P,'LIMIT ') then
      result := true;
    exit;
  end;
  P := GotoNextNotSpace(P+6);
  GetNextItem(P,'=',Prop);
  if (P=nil) or (fStoredClassRecordProps.Fields.IndexByName(Prop)<0) then
    exit;
  if PWord(P)^=ord(':')+ord('(') shl 8 then
    inc(P,2); // +2 to ignore :(...): parameter
  if P^ in ['''','"'] then begin
    P := GotoEndOfQuotedString(P);
    if not (P^ in ['''','"']) then
      exit;
  end;
  repeat inc(P) until P^ in [#0..' ',';',')']; // go to end of value
  if PWord(P)^=ord(')')+ord(':')shl 8 then
    inc(P,2); // ignore :(...): parameter
  P := GotoNextNotSpace(P);
  if (P^ in [#0,';']) or IdemPChar(P,'LIMIT ') then
    result := true; // properly ended the WHERE clause as 'FIELDNAME=value'
end;

function TSQLRestStorageInMemory.FindWhereEqual(const WhereFieldName, WhereValue: RawUTF8;
  OnFind: TFindWhereEqualEvent; Dest: pointer; FoundLimit,FoundOffset: integer;
  CaseInsensitive: boolean): PtrInt;
var WhereFieldIndex: integer;
begin
  result := 0;
  if (Self=nil) or not Assigned(OnFind) then
    exit;
  if IsRowID(pointer(WhereFieldName)) then
    WhereFieldIndex := 0 else begin
    WhereFieldIndex := fStoredClassRecordProps.Fields.IndexByName(pointer(WhereFieldName));
    if WhereFieldIndex<0 then
      exit;
    inc(WhereFieldIndex); // FindWhereEqual() expects index = RTTI+1
  end;
  result := FindWhereEqual(WhereFieldIndex,WhereValue,Onfind,Dest,
    FoundLimit,FoundOffset,CaseInsensitive);
end;

function TSQLRestStorageInMemory.FindWhereEqual(WhereField: integer;
  const WhereValue: RawUTF8; OnFind: TFindWhereEqualEvent; Dest: pointer;
  FoundLimit,FoundOffset: PtrInt; CaseInsensitive: boolean): PtrInt;
var i, currentRow, found: PtrInt;
    v: Int64;
    err: integer;
    P: TSQLPropInfo;
    nfo: PPropInfo;
    offs: PtrUInt;
    ot: TOrdType;
    vp: PPtrUInt;

  function FoundOneAndReachedLimit: boolean;
  begin
    result := false; // continue search
    if FoundOffset>0 then begin // omit first FoundOffset rows
      inc(currentRow);
      if currentRow>FoundOffset then
        FoundOffset := 0 else
        exit;
    end;
    if Assigned(OnFind) then
      OnFind(Dest,fValue[i],i);
    inc(found);
    if found>=FoundLimit then
      result := true; // stop the loop
  end;

begin
  result := 0;
  if fCount=0 then
    exit;
  if FoundLimit<=0 then
    FoundLimit := maxInt;
  if WhereField=SYNTABLESTATEMENTWHEREID then begin
    if FoundOffset<=0 then begin // omit first FoundOffset rows
      v := GetInt64(pointer(WhereValue),err);
      if (err=0) and (v>0) then begin
        i := IDToIndex(v); // use fast ID hash table
        if i>=0 then begin
          if Assigned(OnFind) then
            OnFind(Dest,fValue[i],i);
          inc(result);
        end;
      end;
    end;
    exit;
  end else
  if cardinal(WhereField)>cardinal(fStoredClassRecordProps.Fields.Count) then
    exit;
  dec(WhereField); // WHERE WhereField=WhereValue (WhereField=RTTIfield+1)
  P := fStoredClassRecordProps.Fields.List[WhereField];
  if not (P.SQLFieldType in COPIABLE_FIELDS) then
    exit; // nothing to search (e.g. sftUnknown or sftMany)
  // use fUnique[] hash array for O(1) search if available
  if WhereField in fIsUnique then begin
    if FoundOffset<=0 then begin // omit first FoundOffset rows
      P.SetValueVar(fSearchRec,WhereValue,false); // private copy for comparison
      i := fUnique[WhereField].Find(fSearchRec);
      if i>=0 then begin
        if Assigned(OnFind) then
          OnFind(Dest,fValue[i],i);
        inc(result);
      end;
    end;
    exit;
  end;
  // full scan optimized search for a specified value
  found := 0;
  currentRow := 0;
  if P.InheritsFrom(TSQLPropInfoRTTIInt32) and (TSQLPropInfoRTTIInt32(P).PropInfo^.
     PropType^.Kind in [tkInteger,tkEnumeration,tkSet]) then begin // 8/16/32-bit
    v := GetInt64(pointer(WhereValue),err); // 64-bit for cardinal
    if err<>0 then
      exit;
    nfo := TSQLPropInfoRTTI(P).PropInfo;
    offs := TSQLPropInfoRTTI(P).fGetterIsFieldPropOffset;
    if offs<>0 then begin // plain field with no getter
      ot := nfo^.PropType^.OrdType;
      if ot in [otSLong,otULong] then begin // handle very common 32-bit Integer field
        vp := pointer(fValue);
        for i := 0 to fCount-1 do
          if (PCardinal(vp^+offs)^=PCardinal(@v)^) and FoundOneAndReachedLimit then
            break else
            inc(vp);
      end else // inlined GetOrdProp() for 8-bit or 16-bit values
        for i := 0 to fCount-1 do
          if (FromOrdType(ot,pointer(PtrUInt(fValue[i])+offs))=v) and FoundOneAndReachedLimit then
            break;
    end else // has getter -> use GetOrdProp()
    for i := 0 to fCount-1 do
      if (nfo^.GetOrdProp(fValue[i])=v) and FoundOneAndReachedLimit then
        break;
  end else
  if P.InheritsFrom(TSQLPropInfoRTTIInt64) then begin // 64-bit integer
    v := GetInt64(pointer(WhereValue),err);
    if err<>0 then
      exit;
    nfo := TSQLPropInfoRTTI(P).PropInfo;
    offs := TSQLPropInfoRTTI(P).fGetterIsFieldPropOffset;
    if offs<>0 then begin // plain field with no getter
      vp := pointer(fValue);
      for i := 0 to fCount-1 do
        if (PInt64(vp^+offs)^=v) and FoundOneAndReachedLimit then
          break else
          inc(vp);
    end else // handle getter
    for i := 0 to fCount-1 do
      if (nfo^.GetInt64Prop(fValue[i])=v) and FoundOneAndReachedLimit then
        break;
  end else begin // generic search using fast CompareValue() overridden methods
    P.SetValueVar(fSearchRec,WhereValue,false); // private copy for comparison
    for i := 0 to fCount-1 do
      if (P.CompareValue(fValue[i],fSearchRec,CaseInsensitive)=0) and
         FoundOneAndReachedLimit then
        break;
  end;
  result := found;
end;

function TSQLRestStorageInMemory.FindMax(WhereField: integer; out max: Int64): boolean;
var P: TSQLPropInfo;
    nfo: PPropInfo;
    i: PtrInt;
    v: Int64;
begin
  result := false;
  max := low(Int64);
  if fCount=0 then
    exit;
  if WhereField=SYNTABLESTATEMENTWHEREID then begin
    max := fMaxID;
    result := true;
    exit;
  end;
  if cardinal(WhereField)>cardinal(fStoredClassRecordProps.Fields.Count) then
    exit;
  dec(WhereField); // WHERE WhereField=WhereValue (WhereField=RTTIfield+1)
  P := fStoredClassRecordProps.Fields.List[WhereField];
  if P.InheritsFrom(TSQLPropInfoRTTIInt32) then begin
    nfo := TSQLPropInfoRTTI(P).PropInfo;
    for i := 0 to fCount-1 do begin
      v := nfo.GetOrdProp(fValue[i]);
      if v>max then
        max := v;
    end;
    result := true;
  end
  else if P.InheritsFrom(TSQLPropInfoRTTIInt64) then begin
    nfo := TSQLPropInfoRTTI(P).PropInfo;
    for i := 0 to fCount-1 do begin
      v := nfo.GetInt64Prop(fValue[i]);
      if v>max then
        max := v;
    end;
    result := true;
  end;
end;

procedure TSQLRestStorageInMemory.ForEach(WillModifyContent: boolean;
  OnEachProcess: TFindWhereEqualEvent; Dest: pointer);
var i: PtrInt;
begin
  if (self=nil) or (fCount=0) or not Assigned(OnEachProcess) then
    exit;
  StorageLock(WillModifyContent,'ForEach');
  try
    for i := 0 to fCount-1 do
      OnEachProcess(Dest,fValue[i],i);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.GetJSONValues(Stream: TStream;
  Expand: boolean; Stmt: TSynTableStatement): PtrInt;
var ndx,KnownRowsCount: PtrInt;
    {$ifndef NOVARIANTS}
    j: PtrInt;
    id: Int64;
    {$endif}
    W: TJSONSerializer;
    IsNull: boolean;
    Prop: TSQLPropInfo;
    bits: TSQLFieldBits;
    withID: boolean;
label err;
begin // exact same format as TSQLTable.GetJSONValues()
  result := 0;
  if length(Stmt.Where)>1 then
    raise EORMException.CreateUTF8('%.GetJSONValues on % with Stmt.Where[]=%',
      [self,fStoredClass,length(Stmt.Where)]);
  if Stmt.Where=nil then // no WHERE statement -> get all rows -> set rows count
    if (Stmt.Limit>0) and (fCount>Stmt.Limit) then
      KnownRowsCount := Stmt.Limit else
      KnownRowsCount := fCount else
    KnownRowsCount := 0;
  Stmt.SelectFieldBits(bits,withID);
  W := fStoredClassRecordProps.CreateJSONWriter(Stream,Expand,withID,bits,
    KnownRowsCount,{bufsize=}256 shl 10);
  if W<>nil then
  try
    if Expand then
      W.Add('[');
    if Stmt.Where=nil then begin // no WHERE statement -> all rows
      for ndx := 0 to KnownRowsCount-1 do begin
        if Expand then
          W.AddCR; // for better readability
        fValue[ndx].GetJSONValues(W);
        W.Add(',');
      end;
      result := KnownRowsCount;
    end else
    case Stmt.Where[0].Operator of
    opEqualTo:
      result := FindWhereEqual(Stmt.Where[0].Field,Stmt.Where[0].Value,
        GetJSONValuesEvent,W,Stmt.Limit,Stmt.Offset);
    {$ifndef NOVARIANTS}
    opIn:
      if (Stmt.Where[0].Field<>0) or // only handle ID IN (..) by now
         (Stmt.Offset>0) then
        goto err else
        with _Safe(Stmt.Where[0].ValueVariant)^ do
          for ndx := 0 to Count-1 do
            if VariantToInt64(Values[ndx],id) then begin
              j := IDToIndex(id);
              if j>=0 then begin
                fValue[j].GetJSONValues(W);
                W.Add(',');
                inc(result);
                if (Stmt.Limit>0) and (result>=Stmt.Limit) then
                  break;
              end;
            end else
              goto err;
    {$endif}
    opIsNull, opIsNotNull:
      if Stmt.Where[0].Field>0 then begin
        Prop := fStoredClassRecordProps.Fields.List[Stmt.Where[0].Field-1];
        if Prop.InheritsFrom(TSQLPropInfoRTTIRawBlob) then begin
          IsNull := Stmt.Where[0].Operator=opIsNull;
          for ndx := 0 to fCount-1 do
          if TSQLPropInfoRTTIRawBlob(Prop).IsNull(fValue[ndx])=IsNull then begin
            fValue[ndx].GetJSONValues(W);
            W.Add(',');
            inc(result);
            if (Stmt.Limit>0) and (result>=Stmt.Limit) then
              break;
          end;
        end else
          goto err;
      end else
        goto err;
    else begin
err:  W.CancelAll;
      result := 0;
      exit;
    end;
    end;
    if (result=0) and W.Expand then begin
      // we want the field names at least, even with no data
      W.Expand := false; //  {"fieldCount":2,"values":["col1","col2"]}
      W.CancelAll;
      fStoredClassRecordProps.SetJSONWriterColumnNames(W,0);
    end;
    W.EndJSONObject(KnownRowsCount,result);
  finally
    W.Free;
  end;
end;

procedure TSQLRestStorageInMemory.GetAllIDs(out ID: TIDDynArray);
var i: PtrInt;
begin
  StorageLock(false,'GetAllIDs');
  try
    SetLength(ID,fCount);
    for i := 0 to Count-1 do
      ID[i] := fValue[i].fID;
  finally
    StorageUnlock;
  end;
end;

function TSQLRestStorageInMemory.EngineList(const SQL: RawUTF8;
  ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8;
// - GetJSONValues/FindWhereEqual will handle basic REST commands (not all SQL)
// only valid SQL command is "SELECT Field1,Field2 FROM Table WHERE ID=120;",
// i.e one Table SELECT with one optional "WHERE fieldname = value" statement
// - handle also basic "SELECT Count(*) FROM TableName;" SQL statement
// Note: this is sufficient for OneFieldValue() and MultiFieldValue() to work
var MS: TRawByteStringStream;
    ResCount: PtrInt;
    Stmt: TSynTableStatement;
    max: Int64;
  procedure SetCount(aCount: integer);
  begin
    FormatUTF8('[{"Count(*)":%}]'#$A,[aCount],result);
    ResCount := 1;
  end;
begin
  result := '';
  ResCount := 0;
  StorageLock(false,'EngineList');
  try
    if IdemPropNameU(fBasicSQLCount,SQL) then
      SetCount(TableRowCount(fStoredClass)) else
    if IdemPropNameU(fBasicSQLHasRows[false],SQL) or
       IdemPropNameU(fBasicSQLHasRows[true],SQL) then
      if TableRowCount(fStoredClass)=0 then begin
        result := '{"fieldCount":1,"values":["RowID"]}'#$A;
        ResCount := 0;
      end else begin // return one row with fake ID=1
        result := '[{"RowID":1}]'#$A;
        ResCount := 1;
      end else begin
      Stmt := TSynTableStatement.Create(SQL,
        fStoredClassRecordProps.Fields.IndexByName,
        fStoredClassRecordProps.SimpleFieldsBits[soSelect]);
      try
        if (Stmt.SQLStatement='') or  // parsing failed
           (length(Stmt.Where)>1) or // only a SINGLE expression is allowed yet
           not IdemPropNameU(Stmt.TableName,fStoredClassRecordProps.SQLTableName) then
          // invalid request -> return ''
          exit;
        if Stmt.SelectFunctionCount=0 then begin
          // save rows as JSON, with appropriate search according to Where.* arguments
          MS := TRawByteStringStream.Create;
          try
            ForceAJAX := ForceAJAX or not Owner.NoAJAXJSON;
            ResCount := GetJSONValues(MS,ForceAJAX,Stmt);
            result := MS.DataString;
          finally
            MS.Free;
          end;
        end else
        if (length(Stmt.Select)<>1) or (Stmt.SelectFunctionCount<>1) or
           ((Stmt.Limit>1) or (Stmt.Offset<>0)) then
           // handle a single max() or count() function with no LIMIT nor OFFSET
          exit else
          case Stmt.Select[0].FunctionKnown of
           funcCountStar:
            if Stmt.Where=nil then
              // was e.g. "SELECT Count(*) FROM TableName;"
              SetCount(TableRowCount(fStoredClass)) else begin
              // was e.g. "SELECT Count(*) FROM TableName WHERE ..."
              ResCount := FindWhereEqual(Stmt.Where[0].Field,Stmt.Where[0].Value,
                DoNothingEvent,nil,0,0);
              case Stmt.Where[0].Operator of
              opEqualTo:    SetCount(ResCount);
              opNotEqualTo: SetCount(TableRowCount(fStoredClass)-ResCount);
              end;
            end;
            funcMax:
              if (Stmt.Where=nil) and FindMax(Stmt.Select[0].Field,max) then begin
                FormatUTF8('[{"Max()":%}]'#$A,[max],result);
                ResCount := 1;
              end;
            else exit; // unhandled Distinct() or other SQL functions
           end;
      finally
        Stmt.Free;
      end;
    end;
  finally
    StorageUnLock;
  end;
  if ReturnedRowCount<>nil then
    ReturnedRowCount^ := ResCount;
end;

procedure TSQLRestStorageInMemory.DropValues(andUpdateFile: boolean);
var f: PtrInt;
    timer: TPrecisionTimer;
begin
  StorageLock(true,'DropValues');
  try
    fUnSortedID := false;
    fMaxID := 0;
    if fCount>0 then begin
      timer.Start;
      for f := 0 to high(fUnique) do
        if f in fIsUnique then
          fUnique[f].Hasher.Clear;
      fValues.Hasher.Clear;
      fValues.Clear;
      if andUpdateFile then begin
        fModified := true;
        UpdateFile;
      end;
      InternalLog('DropValues % in %',[fStoredClass,timer.Stop]);
    end;
  finally
    StorageUnLock;
  end;
end;

procedure TSQLRestStorageInMemory.LoadFromJSON(const aJSON: RawUTF8);
var tmp: TSynTempBuffer;
begin
  tmp.Init(aJSON);
  try
    LoadFromJSON(tmp.buf,tmp.len);
  finally
    tmp.Done;
  end;
end;

procedure TSQLRestStorageInMemory.ComputeStateAfterLoad(var loaded: TPrecisionTimer;
  binary: boolean);
const _CALLER: array[boolean] of string[7] = ('JSON','Binary');
var f,c: PtrInt;
    cf: RawUTF8;
    timer: TPrecisionTimer;
begin // now fValue[] contains the just loaded data
  loaded.Pause;
  timer.Start;
  fCount := length(fValue);
  c := fValues.ReHash;
  if c>0 then
    cf := 'ID' else
    for f := 0 to high(fUnique) do
      if f in fIsUnique then begin
        c := fUnique[f].Hasher.ReHash({forced=}true,{grow=}false);
        if c>0 then begin
          cf := fUnique[f].PropInfo.Name;
          break;
        end;
      end;
  if c>0 then begin
    DropValues({andupdatefile=}false);
    raise EORMException.CreateUTF8('%.LoadFrom%: found % % in %.% field',
      [self,_CALLER[binary],Plural('duplicate',c),fStoredClass,cf]);
  end;
  if binary then begin
    fMaxID := FindMaxID(pointer(fValue),fCount);
    fUnSortedID := false; // by SaveToBinary design
  end else // JSON may have been tampered
    fMaxID := FindMaxIDAndCheckSorted(pointer(fValue),fCount,fUnSortedID);
  InternalLog('LoadFrom% % count=% load=% index=%',
    [_CALLER[binary],fStoredClass,fCount,loaded.Stop,timer.Stop]);
end;

procedure TSQLRestStorageInMemory.LoadFromJSON(JSONBuffer: PUTF8Char; JSONBufferLen: integer);
var T: TSQLTableJSON;
    timer: TPrecisionTimer;
begin
  StorageLock(true,'LoadFromJSON');
  try
    timer.Start;
    if fCount>0 then
      DropValues({andupdatefile=}false);
    fModified := false;
    if JSONBuffer=nil then
      exit;
    T := TSQLTableJSON.CreateFromTables([fStoredClass],'',JSONBuffer,JSONBufferLen);
    try
      if T.fFieldIndexID<0 then // no ID field -> load is impossible
        exit;
      T.ToObjArray(fValue,fStoredClass);
    finally
      T.Free;
    end;
    ComputeStateAfterLoad(timer,{binary=}false);
  finally
    StorageUnLock;
  end;
end;

procedure TSQLRestStorageInMemory.SaveToJSON(Stream: TStream; Expand: Boolean);
var i,j: PtrInt;
    W: TJSONSerializer;
    ndx: TIntegerDynArray;
begin
  if self=nil then
    exit;
  StorageLock(false,'SaveToJSON');
  try
    if fUnSortedID then
      fValues.CreateOrderedIndex(ndx,nil); // write in ascending ID order
    W := fStoredClassRecordProps.CreateJSONWriter(
      Stream,Expand,true,ALL_FIELDS,fCount,{bufsize=}1 shl 20);
    try
      if Expand then
        W.Add('[');
      for i := 0 to fCount-1 do begin
        if Expand then
          W.AddCR; // for better readability
        if ndx=nil then
          j := i else
          j := ndx[i];
        fValue[j].GetJSONValues(W);
        W.Add(',');
      end;
      W.EndJSONObject(fCount,fCount);
    finally
      W.Free;
    end;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.SaveToJSON(Expand: Boolean): RawUTF8;
var MS: TRawByteStringStream;
begin
  if self=nil then
    result := '' else begin
    MS := TRawByteStringStream.Create;
    try
      SaveToJSON(MS,Expand);
      result := MS.DataString;
    finally
      MS.Free;
    end;
  end;
end;

function TSQLRestStorageInMemory.SaveToBinary: RawByteString;
var MS: TRawByteStringStream;
begin
  if self=nil then
    result := '' else begin
    MS := TRawByteStringStream.Create;
    try
      SaveToBinary(MS);
      result := MS.DataString;
    finally
      MS.Free;
    end;
  end;
end;

const
  TSQLRESTSTORAGEINMEMORY_MAGIC = $A5ABA5A5;

function TSQLRestStorageInMemory.LoadFromBinary(Stream: TStream): boolean;
var R: TFileBufferReader;
    MS: TMemoryStream;
    i,n,f: PtrInt;
    ID32: TIntegerDynArray;
    P,PEnd: PAnsiChar;
    rec: TSQLRecord;
    id: TID;
    s: RawUTF8;
    prop: TSQLPropInfo;
    timer: TPrecisionTimer;
begin
  result := false;
  if self=nil then
    exit;
  timer.Start;
  MS := StreamUnSynLZ(Stream,TSQLRESTSTORAGEINMEMORY_MAGIC);
  if MS=nil then
    exit;
  StorageLock(true,'LoadFromBinary');
  try
    // check header: expect same exact RTTI
    R.OpenFrom(MS.Memory,MS.Size);
    R.Read(s);
    if (s<>'') and  // new fixed format
       not IdemPropNameU(s,'TSQLRecordProperties') then // old buggy format
      exit;
    if not fStoredClassRecordProps.CheckBinaryHeader(R) then
      exit;
    // create instances and read their IDs
    if fCount>0 then
      DropValues({andupdatefile=}false);
    fModified := false;
    n := R.ReadVarUInt32Array(ID32);
    SetLength(fValue,abs(n)); // allocate all at once
    if n<0 then begin // was wkFakeMarker -> TID were stored as VarUInt64 diffs
      n := abs(n);
      id := 0;
      for i := 0 to n-1 do begin
        rec := fStoredClass.Create;  // avoid URW699 with Delphi6/Kylix
        id := id+{$ifdef FPC_OR_UNICODE}TID{$endif}(R.ReadVarUInt64);
        rec.fID := id;
        fValue[i] := rec;
      end;
    end else
      for i := 0 to n-1 do begin
        rec := fStoredClass.Create;
        rec.fID := ID32[i];
        fValue[i] := rec;
      end;
    // read content, grouped by field (for better compression)
    P := R.CurrentMemory(0,@PEnd);
    for f := 0 to fStoredClassRecordProps.Fields.Count-1 do begin
      prop := fStoredClassRecordProps.Fields.List[f];
      for i := 0 to n-1 do begin
        P := prop.SetBinary(fValue[i],P,PEnd);
        if P=nil then begin
          DropValues(false); // on error, reset all values
          exit;
        end;
      end;
    end;
    ComputeStateAfterLoad(timer,{binary=}true);
    Result := true;
  finally
    StorageUnlock;
    R.Close;
    MS.Free;
  end;
end;

function TSQLRestStorageInMemory.LoadFromBinary(const Buffer: RawByteString): boolean;
var S: TStream;
begin
  S := TRawByteStringStream.Create(Buffer);
  try
    result := LoadFromBinary(S);
  finally
    S.Free;
  end;
end;

procedure TSQLRestStorageInMemory.LoadFromResource(ResourceName: string;
  Instance: THandle);
var S: TStream;
begin
  if ResourceName = '' then
    ResourceName := fStoredClass.ClassName;
  if Instance=0 then
    Instance := HInstance;
  S := TResourceStream.Create(Instance,ResourceName,pointer(10));
  try
    if not LoadFromBinary(S) then
      raise EORMException.CreateUTF8('%.LoadFromResource with invalid % content',
        [self,fStoredClass]);
  finally
    S.Free;
  end;
end;

function TSQLRestStorageInMemory.SaveToBinary(Stream: TStream): integer;
var W: TFileBufferWriter;
    MS: THeapMemoryStream;
    i,j,f: PtrInt;
    hasInt64ID: boolean;
    p: PID;
    lastID,newID: TID;
    ndx,id32: TIntegerDynArray;
begin
  result := 0;
  if (self=nil) or (Stream=nil) then
    exit;
  MS := THeapMemoryStream.Create;
  W := TFileBufferWriter.Create(MS,1 shl 20);
  try
    StorageLock(false,'SaveToBinary');
    try
      // primitive magic and fields signature for file type identification
      W.Write1(0); // ClassName='TSQLRecordProperties' in old buggy format
      fStoredClassRecordProps.SaveBinaryHeader(W);
      // write IDs - in increasing order
      if fUnSortedID then
        fValues.CreateOrderedIndex(ndx,nil);
      SetLength(id32,fCount);
      hasInt64ID := false;
      for i := 0 to fCount-1 do begin
        if ndx=nil then
          j := i else
          j := ndx[i];
        p := @fValue[j].fID;
        if p^>high(cardinal) then begin
          hasInt64ID := true;
          break;
        end else
          id32[i] := PInteger(p)^;
      end;
      if hasInt64ID then begin
        W.WriteVarUInt32(fCount);
        W.Write1(ord(wkFakeMarker)); // fake marker
        lastID := 0;
        for i := 0 to fCount-1 do begin // a bit less efficient than wkSorted
          if ndx=nil then
            j := i else
            j := ndx[i];
          newID := fValue[j].fID;
          if newID<=lastID then
            raise EORMException.CreateUTF8('%.SaveToBinary(%): duplicated ID',
              [self,fStoredClass]);
          W.WriteVarUInt64(newID-lastID);
          lastID := newID;
        end;
      end else
        W.WriteVarUInt32Values(pointer(id32),fCount,wkSorted); // very efficient
      // write content, grouped by field (for better compression)
      for f := 0 to fStoredClassRecordProps.Fields.Count-1 do
        with fStoredClassRecordProps.Fields.List[f] do
          if ndx=nil then
            for i := 0 to fCount-1 do
              GetBinary(fValue[i],W) else
            for i := 0 to fCount-1 do
              GetBinary(fValue[ndx[i]],W);
    finally
      StorageUnLock;
    end;
    W.Flush;
    result := StreamSynLZ(MS,Stream,TSQLRESTSTORAGEINMEMORY_MAGIC);
  finally
    W.Free;
    MS.Free;
  end;
end;

function TSQLRestStorageInMemory.EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8;
var i: integer;
begin // TableModelIndex is not useful here
  StorageLock(false,'EngineRetrieve');
  try
    i := IDToIndex(ID);
    if i<0 then
      result := '' else
      result := fValue[i].GetJSONValues(true,true,soSelect);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.GetOne(aID: TID): TSQLRecord;
var i: integer;
begin
  if aID = 0 then
    result := nil else begin
    StorageLock(false,'GetOne');
    try
      i := IDToIndex(aID);
      if i<0 then
        result := nil else
        result := fValue[i].CreateCopy;
    finally
      StorageUnLock;
    end;
  end;
end;

function TSQLRestStorageInMemory.EngineUpdateFieldIncrement(TableModelIndex: integer;
  ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean;
var i,err: integer;
    P: TSQLPropInfo;
    V: RawUTF8;
    wasString: boolean;
    int: Int64;
begin
  result := false;
  if (ID<0) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then
    exit;
  P := fStoredClassProps.Prop[FieldName];
  if P=nil then
    exit;
  if P.PropertyIndex in fIsUnique then begin
    InternalLog('EngineUpdateFieldIncrement(%) on UNIQUE %.%',[ID,fStoredClass,P.Name],sllDB);
    exit;
  end;
  StorageLock(false,'EngineUpdateFieldIncrement');
  try
    i := IDToIndex(ID);
    if i<0 then begin
      InternalLog('EngineUpdateFieldIncrement(%): %.ID=% not found',[P.Name,fStoredClass,ID],sllDB);
      exit;
    end;
    P.GetValueVar(fValue[i],false,V,@wasstring);
    int := GetInt64(pointer(V),err);
    if wasString or (err<>0) then begin
      InternalLog('EngineUpdateFieldIncrement: %.%=[%] not an integer',[fStoredClass,P.Name,V],sllDB);
      exit;
    end;
    Int64ToUtf8(int+Increment,V);
    P.SetValueVar(fValue[i],V,false);
    fModified := true;
    result := true;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.EngineUpdateField(TableModelIndex: integer;
  const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean;
var P: TSQLPropInfo;
    WhereValueString, SetValueString, SetValueJson: RawUTF8;
    i, WhereFieldIndex: PtrInt;
    SetValueWasString: boolean;
    match: TSynList;
    rec: TSQLRecord;
begin
  result := false;
  if (TableModelIndex<0) or (fModel.Tables[TableModelIndex]<>fStoredClass) or
     (SetFieldName='') or (SetValue='') or
     (WhereFieldName='') or (WhereValue='') then
    exit;
  // handle destination field RTTI
  P := fStoredClassRecordProps.Fields.ByRawUTF8Name(SetFieldName);
  if P=nil then
    exit; // don't allow setting ID field, which is Read Only
  if P.PropertyIndex in fIsUnique then begin
    InternalLog('EngineUpdateField on UNIQUE %.%',[fStoredClass,P.Name],sllDB);
    exit; { TODO : allow update UNIQUE field? }
  end;
  SetValueWasString := SetValue[1]='"';
  if SetValueWasString then
    UnQuoteSQLStringVar(pointer(SetValue),SetValueString) else
    SetValueString := SetValue;
  // handle search field RTTI
  if IsRowID(pointer(WhereFieldName)) then begin
    WhereFieldIndex := 0;
    WhereValueString := WhereValue;
  end else begin
    WhereFieldIndex := fStoredClassRecordProps.Fields.IndexByName(WhereFieldName);
    if WhereFieldIndex<0  then
      exit;
    inc(WhereFieldIndex); // FindWhereEqual() expects index = RTTI+1
  end;
  if WhereValue[1]='"' then
    UnQuoteSQLStringVar(pointer(WhereValue),WhereValueString) else
    WhereValueString := WhereValue;
  // search indexes, then apply updates
  match := TSynList.Create;
  StorageLock(true,'EngineUpdateField');
  try
    // find matching match[]
    if FindWhereEqual(WhereFieldIndex,WhereValueString,DoAddToListEvent,match,0,0)=0 then
      exit; // match.Count=0 -> nothing to update
    // check that all records can be updated
    for i := 0 to match.Count-1 do
      if not RecordCanBeUpdated(fStoredClass,TSQLRecord(match.List[i]).fID,seUpdate) then
        exit; // one record update fails -> abort all
    // update field value
    for i := 0 to match.Count-1 do begin
      rec := match.List[i];
      P.SetValueVar(rec,SetValueString,SetValueWasString);
      if Owner<>nil then begin
        if SetValueJson='' then
          JSONEncodeNameSQLValue(P.Name,SetValue,SetValueJson);
        Owner.InternalUpdateEvent(seUpdate,fStoredClassProps.TableIndex,rec.fID,SetValueJson,nil);
      end;
    end;
    fModified := true;
    result := true;
  finally
    StorageUnLock;
    match.Free;
  end;
end;

function TSQLRestStorageInMemory.EngineUpdate(TableModelIndex: integer; ID: TID;
  const SentData: RawUTF8): boolean;
var i: PtrInt;
    rec: TSQLRecord;
begin
  result := false;
  if (ID<0) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then
    exit;
  if SentData='' then begin
    result := True;
    exit;
  end;
  StorageLock(true,'EngineUpdate');
  try
    i := IDToIndex(ID);
    if (i<0) or not RecordCanBeUpdated(fStoredClass,ID,seUpdate) then
      exit;
    if fUnique<>nil then begin
      rec := fValue[i].CreateCopy; // copy since can be a partial update
      rec.FillFrom(SentData);      // overwrite updated properties
      if not UniqueFieldsUpdateOK(rec,i) then begin
        rec.Free;
        exit;
      end;
      fValue[i].Free;   // avoid memory leak
      fValue[i] := rec; // replace item in list
    end else // direct in-place (partial) update
      fValue[i].FillFrom(SentData);
    fModified := true;
    result := true;
    if Owner<>nil then
      Owner.InternalUpdateEvent(seUpdate,fStoredClassProps.TableIndex,ID,SentData,nil);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.UpdateOne(Rec: TSQLRecord; const SentData: RawUTF8): boolean;
var i: PtrInt;
begin
  result := false;
  if (Rec=nil) or (PSQLRecordClass(Rec)^<>fStoredClass) or (Rec.fID<=0) then
    exit;
  StorageLock(true,'UpdateOne');
  try
    i := IDToIndex(Rec.fID);
    if (i<0) or not RecordCanBeUpdated(fStoredClass,Rec.fID,seUpdate) then
      exit;
    if (fUnique<>nil) and not UniqueFieldsUpdateOK(Rec,i) then
      exit;
    CopyObject(Rec,fValue[i]);
    fModified := true;
    result := true;
    if Owner<>nil then
      Owner.InternalUpdateEvent(seUpdate,fStoredClassProps.TableIndex,Rec.fID,SentData,nil);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.UpdateOne(ID: TID; const Values: TSQLVarDynArray): boolean;
var i: PtrInt;
    rec: TSQLRecord;
begin
  result := false;
  if ID<=0 then
    exit;
  StorageLock(true,'UpdateOne');
  try
    i := IDToIndex(ID);
    if (i<0) or not RecordCanBeUpdated(fStoredClass,ID,seUpdate) then
      exit;
    if fUnique<>nil then begin
      rec := fValue[i].CreateCopy; // copy since can be a partial update
      if not rec.SetFieldSQLVars(Values) or not UniqueFieldsUpdateOK(rec,i) then begin
        rec.Free;
        exit;
      end;
      fValue[i].Free; // avoid memory leak
      fValue[i] := rec;
    end else
    if not fValue[i].SetFieldSQLVars(Values) then
      exit;
    fModified := true;
    result := true;
    if Owner<>nil then
      Owner.InternalUpdateEvent(seUpdate,fStoredClassProps.TableIndex,ID,
        fValue[i].GetJSONValues(True,False,soUpdate),nil);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean;
var i: integer;
begin
  result := false;
  if (TableModelIndex<0) or not BlobField^.IsBlob or
     (fModel.Tables[TableModelIndex]<>fStoredClass) then
    exit;
  StorageLock(false,'EngineRetrieveBlob');
  try
    i := IDToIndex(aID);
    if i<0 then
      exit;
    // get result blob directly from RTTI property description
    BlobField.GetLongStrProp(fValue[i],RawByteString(BlobData));
    result := true;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.RetrieveBlobFields(Value: TSQLRecord): boolean;
var i,f: integer;
begin
  result := false;
  if (Value<>nil) and (Value.fID>0) and (PSQLRecordClass(Value)^=fStoredClass) then
  with Value.RecordProps do
  if BlobFields<>nil then begin
    StorageLock(false,'RetrieveBlobFields');
    try
      i := IDToIndex(Value.fID);
      if i<0 then
        exit;
      for f := 0 to high(BlobFields) do
        BlobFields[f].CopyValue(fValue[i],Value);
      result := true;
    finally
      StorageUnLock;
    end;
  end;
end;

function TSQLRestStorageInMemory.EngineUpdateBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean;
var i: integer;
    AffectedField: TSQLFieldBits;
begin
  result := false;
  if (aID<0) or (TableModelIndex<0) or not BlobField^.IsBlob or
     (fModel.Tables[TableModelIndex]<>fStoredClass) then
    exit;
  StorageLock(true,'EngineUpdateBlob');
  try
    i := IDToIndex(aID);
    if (i<0) or not RecordCanBeUpdated(fStoredClass,aID,seUpdate) then
      exit;
    // set blob value directly from RTTI property description
    BlobField.SetLongStrProp(fValue[i],BlobData);
    if Owner<>nil then begin
      fStoredClassRecordProps.FieldBitsFromBlobField(BlobField,AffectedField);
      Owner.InternalUpdateEvent(seUpdateBlob,fStoredClassProps.TableIndex,aID,'',@AffectedField);
    end;
    fModified := true;
    result := true;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageInMemory.UpdateBlobFields(Value: TSQLRecord): boolean;
var i,f: integer;
begin
  result := false;
  if (Value<>nil) and (Value.fID>0) and (PSQLRecordClass(Value)^=fStoredClass) then
  with Value.RecordProps do
  if BlobFields<>nil then begin
    StorageLock(true,'UpdateBlobFields');
    try
      i := IDToIndex(Value.fID);
      if (i<0) or not RecordCanBeUpdated(Table,Value.fID,seUpdate) then
        exit;
      for f := 0 to high(BlobFields) do
        BlobFields[f].CopyValue(Value,fValue[i]);
      if Owner<>nil then
        Owner.InternalUpdateEvent(seUpdateBlob,fStoredClassProps.TableIndex,Value.fID,'',
          @fStoredClassRecordProps.FieldBits[sftBlob]);
      fModified := true;
      result := true;
    finally
      StorageUnLock;
    end;
  end else
    result := true; // as TSQLRest.UpdateblobFields()
end;

function TSQLRestStorageInMemory.TableRowCount(Table: TSQLRecordClass): Int64;
begin
  if Table<>fStoredClass then
    result := 0 else
    result := fCount;
end;

function TSQLRestStorageInMemory.TableHasRows(Table: TSQLRecordClass): boolean;
begin
  result := (Table=fStoredClass) and (fCount>0);
end;

function TSQLRestStorageInMemory.MemberExists(Table: TSQLRecordClass; ID: TID): boolean;
begin
  StorageLock(false,'UpdateFile');
  try
    result := (Table=fStoredClass) and (IDToIndex(ID)>=0);
  finally
    StorageUnLock;
  end;
end;

procedure TSQLRestStorageInMemory.UpdateFile;
var F: TFileStream;
    timer: TPrecisionTimer;
begin
  if (self=nil) or not fModified or (FileName='') then
    exit;
  timer.Start;
  StorageLock(false,'UpdateFile');
  try
    DeleteFile(FileName); // always erase previous file
    if fCount>0 then begin
      F := TFileStream.Create(FileName,fmCreate);
      try
        if BinaryFile then
          SaveToBinary(F) else
          SaveToJSON(F,true);
      finally
        F.Free;
      end;
    end;
    fModified := false;
  finally
    StorageUnLock;
  end;
  InternalLog('UpdateFile % in %',[fStoredClass,timer.Stop],sllDB);
end;

procedure TSQLRestStorageInMemory.SetFileName(const aFileName: TFileName);
begin
  if aFileName=fFileName then
    exit;
  fFileName := aFileName;
  fModified := true;
end;

procedure TSQLRestStorageInMemory.SetBinaryFile(aBinary: boolean);
begin
  if aBinary=fBinaryFile then
    Exit;
  fBinaryFile := aBinary;
  fModified := true;
end;

procedure TSQLRestStorageInMemory.ReloadFromFile;
var JSON: RawUTF8;
    Stream: TStream;
begin
  if (fFileName<>'') and FileExists(fFileName) then begin
    if fBinaryFile then begin
      Stream := FileStreamSequentialRead(fFileName);
      try
        LoadFromBinary(Stream)
      finally
        Stream.Free;
      end;
    end else begin
      JSON := AnyTextFileToRawUTF8(fFileName,true);
      LoadFromJSON(pointer(JSON),length(JSON)); // buffer parsed in-place
    end;
  end;
end;

function TSQLRestStorageInMemory.SearchField(const FieldName, FieldValue: RawUTF8;
  out ResultID: TIDDynArray): boolean;
var n, WhereField,i: integer;
    match: TSynList;
begin
  result := false;
  if (self=nil) or (fCount=0) then
    exit;
  if IsRowID(pointer(FieldName)) then
    WhereField := SYNTABLESTATEMENTWHEREID else begin
    WhereField := fStoredClassRecordProps.Fields.IndexByName(FieldName);
    if WhereField<0 then
      exit;
    inc(WhereField); // FindWhereEqual() expects index = RTTI+1
  end;
  match := TSynList.Create;
  try
    StorageLock(false,'SearchField');
    try
      n := FindWhereEqual(WhereField,FieldValue,DoAddToListEvent,match,0,0);
      if n=0 then
        exit;
      SetLength(ResultID,n);
      for i := 0 to n-1 do
        ResultID[i] := TSQLRecord(match.List[i]).fID;
    finally
      StorageUnLock;
    end;
  finally
    match.Free;
  end;
end;

function TSQLRestStorageInMemory.SearchEvent(const FieldName, FieldValue: RawUTF8;
  OnFind: TFindWhereEqualEvent; Dest: pointer; FoundLimit,FoundOffset: PtrInt): integer;
begin
  result := 0;
  if (self=nil) or (fCount=0) or (FieldName='') then
    exit;
  StorageLock(false,'SearchEvent');
  try
    result := FindWhereEqual(FieldName,FieldValue,OnFind,Dest,FoundLimit,FoundOffset);
  finally
    StorageUnlock;
  end;
end;

function TSQLRestStorageInMemory.SearchCopy(const FieldName, FieldValue: RawUTF8): pointer;
begin
  if SearchEvent(FieldName,FieldValue,DoCopyEvent,@result,1,0)=0 then
    result := nil;
end;

function TSQLRestStorageInMemory.SearchInstance(const FieldName, FieldValue: RawUTF8): pointer;
begin
  if SearchEvent(FieldName,FieldValue,DoInstanceEvent,@result,1,0)=0 then
    result := nil;
end;

function TSQLRestStorageInMemory.SearchIndex(const FieldName, FieldValue: RawUTF8): integer;
begin
  if SearchEvent(FieldName,FieldValue,DoIndexEvent,@result,1,0)=0 then
    result := -1;
end;

function TSQLRestStorageInMemory.SearchCount(const FieldName, FieldValue: RawUTF8): integer;
begin
  result := SearchEvent(FieldName,FieldValue,DoNothingEvent,nil,0,0);
end;

class procedure TSQLRestStorageInMemory.DoNothingEvent(aDest: pointer;
  aRec: TSQLRecord; aIndex: integer);
begin
end;

class procedure TSQLRestStorageInMemory.DoCopyEvent(aDest: pointer;
  aRec: TSQLRecord; aIndex: integer);
begin
  if aDest<>nil then
    PPointer(aDest)^ := aRec.CreateCopy;
end;

class procedure TSQLRestStorageInMemory.DoAddToListEvent(aDest: pointer;
  aRec: TSQLRecord; aIndex: integer);
begin
  if aDest<>nil then
    TSynList(aDest).Add(aRec);
end;

class procedure TSQLRestStorageInMemory.DoInstanceEvent(aDest: pointer;
  aRec: TSQLRecord; aIndex: integer);
begin
  if aDest<>nil then
    PPointer(aDest)^ := aRec;
end;

class procedure TSQLRestStorageInMemory.DoIndexEvent(aDest: pointer; aRec: TSQLRecord;
  aIndex: integer);
begin
  if aDest<>nil then
    PInteger(aDest)^ := aIndex;
end;


{ TSQLRestStorageInMemoryExternal }

constructor TSQLRestStorageInMemoryExternal.Create(aClass: TSQLRecordClass;
  aServer: TSQLRestServer; const aFileName: TFileName = ''; aBinaryFile: boolean=false);
begin
  inherited Create(aClass,aServer,aFileName,aBinaryFile);
  fStorageLockShouldIncreaseOwnerInternalState := false; // done by overriden StorageLock()
end;

procedure TSQLRestStorageInMemoryExternal.StorageLock(WillModifyContent: boolean;
  const msg: RawUTF8);
begin
  inherited StorageLock(WillModifyContent,msg);
  if WillModifyContent and (Owner<>nil) then
    Owner.FlushInternalDBCache;
end;


{ TSQLRestStorageRemote }

constructor TSQLRestStorageRemote.Create(aClass: TSQLRecordClass;
  aServer: TSQLRestServer; aRemoteRest: TSQLRest);
begin
  if aRemoteRest=nil then
    raise EORMException.CreateUTF8('%.Create(nil)',[self]);
  inherited Create(aClass,aServer);
  fRemoteTableIndex := aRemoteRest.Model.GetTableIndexExisting(aClass);
  fRemoteRest := aRemoteRest;
end;

function TSQLRestStorageRemote.EngineAdd(TableModelIndex: integer;
  const SentData: RawUTF8): TID;
begin
  result := fRemoteRest.EngineAdd(fRemoteTableIndex,SentData);
end;

function TSQLRestStorageRemote.EngineDelete(TableModelIndex: integer; ID: TID): boolean;
begin
  result := fRemoteRest.EngineDelete(fRemoteTableIndex,ID);
end;

function TSQLRestStorageRemote.EngineDeleteWhere(TableModelIndex: Integer;
  const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean;
begin
  result := fRemoteRest.EngineDeleteWhere(fRemoteTableIndex,SQLWhere,IDs);
end;

function TSQLRestStorageRemote.EngineExecute(const aSQL: RawUTF8): boolean;
begin
  result := fRemoteRest.EngineExecute(aSQL);
end;

function TSQLRestStorageRemote.EngineList(const SQL: RawUTF8;
  ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8;
begin
  result := fRemoteRest.EngineList(SQL,ForceAJAX,ReturnedRowCount);
end;

function TSQLRestStorageRemote.EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8;
begin
  result := fRemoteRest.EngineRetrieve(fRemoteTableIndex,ID);
end;

function TSQLRestStorageRemote.EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean;
begin
  if (self=nil) or (BlobField=nil) then
    result := false else
    result := fRemoteRest.EngineRetrieveBlob(fRemoteTableIndex,aID,BlobField,BlobData);
end;

function TSQLRestStorageRemote.EngineUpdate(TableModelIndex: integer;
  ID: TID; const SentData: RawUTF8): boolean;
begin
  result := fRemoteRest.EngineUpdate(fRemoteTableIndex,ID,SentData);
end;

function TSQLRestStorageRemote.EngineUpdateBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean;
begin
  if (self=nil) or (BlobField=nil) then
    result := false else
    result := fRemoteRest.EngineUpdateBlob(fRemoteTableIndex,aID,BlobField,BlobData);
end;

function TSQLRestStorageRemote.EngineUpdateField(TableModelIndex: integer;
  const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean;
begin
  result := fRemoteRest.EngineUpdateField(fRemoteTableIndex,SetFieldName,SetValue,WhereFieldName,WhereValue);
end;

function TSQLRestStorageRemote.EngineUpdateFieldIncrement(TableModelIndex: integer;
  ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean;
begin
   result := fRemoteRest.EngineUpdateFieldIncrement(fRemoteTableIndex,ID,FieldName,Increment);
end;


{ TSQLRestStorageShard }

const MIN_SHARD = 1000;

constructor TSQLRestStorageShard.Create(aClass: TSQLRecordClass;
  aServer: TSQLRestServer; aShardRange: TID; aOptions: TSQLRestStorageShardOptions;
  aMaxShardCount: integer);
var i,n: integer;
begin
  if aShardRange<MIN_SHARD then
    raise EORMException.CreateUTF8('%.Create(%,aShardRange=%<%) does not make sense',
      [self,aClass,aShardRange,MIN_SHARD]);
  inherited Create(aClass,aServer);
  fShardRange := aShardRange;
  fShardLast := -1;
  fOptions := aOptions;
  if aMaxShardCount<2 then
    fMaxShardCount := 2 else
    fMaxShardCount := aMaxShardCount;
  InitShards; // set fShards[], fShardLast, fShardOffset and fShardLastID
  n := length(fShards);
  fShardNextID := (n+fShardOffset)*fShardRange+1;
  SetLength(fShardTableIndex,n);
  for i := 0 to fShardLast do
    if fShards[i]=nil then
      fShardTableIndex[i] := -1 else
      fShardTableIndex[i] := fShards[i].Model.GetTableIndexExisting(aClass);
  InternalLog('Create(%,range=%,maxcount=%) [%..%]',[fStoredClass,fShardRange,
    fMaxShardCount,fShardOffset,fShardOffset+n-1],sllDB);
end;

destructor TSQLRestStorageShard.Destroy;
var i,j: integer;
    rest: TSQLRest;
begin
  try
    if not (ssoNoConsolidateAtDestroy in fOptions) then
      ConsolidateShards;
  finally
    inherited Destroy;
    for i := 0 to high(fShards) do begin
      rest := fShards[i];
      if rest=nil then
        continue;
      rest.Free;
      for j := i+1 to high(fShards) do
        if fShards[j]=rest then
          fShards[j] := nil; // same instance re-used in fShards[]
    end;
  end;
end;

procedure TSQLRestStorageShard.ConsolidateShards;
begin // do nothing by default
end;


procedure TSQLRestStorageShard.RemoveShard(aShardIndex: integer);
begin
  StorageLock(true,'RemoveShard');
  try
    if (fShards<>nil) and (cardinal(aShardIndex)<=cardinal(fShardLast)) then begin
      FreeAndNil(fShards[aShardIndex]);
      fShardTableIndex[aShardIndex] := -1;
    end;
  finally
    StorageUnLock;
  end;
end;

procedure TSQLRestStorageShard.InternalAddNewShard;
var rest: TSQLRest;
    i: integer;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter('InternalAddNewShard: #% for %',[fShardLast+1,fStoredClass],self);
  {$endif}
  rest := InitNewShard;
  if rest=nil then
    raise EORMException.CreateUTF8('%.InitNewShard(%) =nil',[self,fStoredClass]);
  inc(fShardNextID,fShardRange);
  SetLength(fShardTableIndex,fShardLast+1);
  fShardTableIndex[fShardLast] := rest.Model.GetTableIndexExisting(fStoredClass);
  if fShardLast>=fMaxShardCount then
    for i := 0 to fShardLast do
      if fShards[i]<>nil then begin
        RemoveShard(i);
        break;
      end;
end;

function TSQLRestStorageShard.ShardFromID(aID: TID; out aShardTableIndex: integer;
  out aShard: TSQLRest; aOccasion: TSQLOccasion; aShardIndex: PInteger): boolean;
var ndx: cardinal;
begin
  result := false;
  if aID<=0 then
    exit;
  case aOccasion of
    soUpdate:
      if ssoNoUpdate in fOptions then
        exit;
    soDelete:
      if ssoNoDelete in fOptions then
        exit;
  end;
  ndx := ((aID-1) div fShardRange)-fShardOffset;
  if (ndx<=cardinal(fShardLast)) and (fShards[ndx]<>nil) then begin
    case aOccasion of
      soUpdate:
        if (ssoNoUpdateButLastShard in fOptions) and (ndx<>cardinal(fShardLast)) then
          exit;
      soDelete:
        if (ssoNoDeleteButLastShard in fOptions) and (ndx<>cardinal(fShardLast)) then
          exit;
    end;
    aShard := fShards[ndx];
    aShardTableIndex := fShardTableIndex[ndx];
    if aShardIndex<>nil then
      aShardIndex^ := ndx;
    result := true;
  end;
end;

function TSQLRestStorageShard.EngineAdd(TableModelIndex: integer;
  const SentData: RawUTF8): TID;
var data: RawUTF8;
    i: Integer;
begin
  if JSONGetID(pointer(SentData),result) then
    raise EORMException.CreateUTF8('%.EngineAdd(%) unexpected ID in %',
      [self,fStoredClass,SentData]);
  StorageLock(true,'EngineAdd');
  try
    inc(fShardLastID);
    if fShardLastID>=fShardNextID then begin
      InternalAddNewShard;
      if fShardLastID>=fShardNextID then
        raise EORMException.CreateUTF8('%.EngineAdd(%) fShardNextID',[self,fStoredClass]);
    end;
    result := fShardLastID;
    i := PosExChar('{',SentData);
    if i=0 then
      FormatUTF8('{ID:%}',[result],data) else begin
      data := SentData;
      insert(FormatUTF8('ID:%,',[result]),data,i+1);
    end;
    if fShardBatch<>nil then
      InternalShardBatch(fShardLast).RawAdd(data) else begin
      if fShards[fShardLast].EngineAdd(fShardTableIndex[fShardLast],data)<>result then begin
        InternalLog('EngineAdd error %.ID=%',[fStoredClass,result],sllDB);
        result := 0;
      end;
    end;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineDelete(TableModelIndex: integer;
  ID: TID): boolean;
var tableIndex,shardIndex: integer;
    rest: TSQLRest;
begin
  StorageLock(true,'EngineDelete');
  try
    if not ShardFromID(ID,tableIndex,rest,soDelete,@shardIndex) then
      result := false else
      if fShardBatch<>nil then
        result := InternalShardBatch(shardIndex).Delete(ID)>=0 else
        result := rest.EngineDelete(tableIndex,ID);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineDeleteWhere(TableModelIndex: integer;
  const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean;
var i: integer;
    ndx: cardinal;
    id: array of TInt64DynArray; // IDs split per shard
    idn: TIntegerDynArray;
    sql: RawUTF8;
begin
  result := false;
  if (IDs=nil) or (ssoNoDelete in fOptions) then
    exit;
  StorageLock(true,'EngineDeleteWhere');
  try
    SetLength(id,fShardLast+1);
    SetLength(idn,fShardLast+1);
    for i := 0 to high(IDs) do begin
      ndx := ((IDs[i]-1) div fShardRange)-fShardOffset; // inlined ShardFromID()
      if (ndx>=cardinal(fShardLast)) or (fShards[ndx]=nil) then
        continue;
      if (ssoNoDeleteButLastShard in fOptions) and (ndx<>cardinal(fShardLast)) then
        continue;
      AddInt64(id[ndx],idn[ndx],IDs[i]);
    end;
    result := true;
    for i := 0 to high(id) do
      if id[i]<>nil then begin
        sql := Int64DynArrayToCSV(pointer(id[i]),idn[i],'ID in (',')');
        if not fShards[i].EngineDeleteWhere(fShardTableIndex[i],sql,TIDDynArray(id[i])) then
          result := false;
      end;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineExecute(const aSQL: RawUTF8): boolean;
begin
  StorageLock(false,'EngineExecute');
  try
    if (fShardLast>=0) and not (ssoNoExecute in fOptions) then
      result := fShards[fShardLast].EngineExecute(aSQL) else
      result := false;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.TableHasRows(Table: TSQLRecordClass): boolean;
begin
  result := fShards<>nil;
end;

function TSQLRestStorageShard.TableRowCount(Table: TSQLRecordClass): Int64;
var i: integer;
begin
  result := 0;
  InternalLog('TableRowCount(%) may take a while',[fStoredClass],sllWarning);
  for i := 0 to high(fShards) do // no StorageLock protection to avoid blocking
    if fShards[i]<>nil then
      inc(result,fShards[i].TableRowCount(fStoredClass));
end;

function TSQLRestStorageShard.EngineList(const SQL: RawUTF8;
  ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8;
var ResCount: PtrInt;
begin
  result := ''; // indicates error occurred
  StorageLock(false,'EngineList');
  try
    ResCount := 0;
    if IdemPropNameU(fBasicSQLCount,SQL) then begin
      FormatUTF8('[{"Count(*)":%}]'#$A,[TableRowCount(fStoredClass)],result);
      ResCount := 1;
    end else
    if IdemPropNameU(fBasicSQLHasRows[false],SQL) or
       IdemPropNameU(fBasicSQLHasRows[true],SQL) then
      if fShards<>nil then begin // return one row with fake ID=1
        result := '[{"RowID":1}]'#$A;
        ResCount := 1;
      end else
        result := '{"fieldCount":1,"values":["RowID"]}'#$A else begin
        if (fShardLast>=0) and not (ssoNoList in fOptions) then
          result := fShards[fShardLast].EngineList(SQL,ForceAJAX,@ResCount);
    end;
    if ReturnedRowCount<>nil then
      ReturnedRowCount^ := ResCount;
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineRetrieve(TableModelIndex: integer;
  ID: TID): RawUTF8;
var tableIndex: integer;
    rest: TSQLRest;
begin
  StorageLock(false,'EngineRetrieve');
  try
    if not ShardFromID(ID,tableIndex,rest) then
      result := '' else
      result := rest.EngineRetrieve(tableIndex,ID);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineRetrieveBlob(TableModelIndex: integer;
  aID: TID; BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean;
var tableIndex: integer;
    rest: TSQLRest;
begin
  StorageLock(false,'EngineRetrieveBlob');
  try
    if not ShardFromID(aID,tableIndex,rest) then
      result := false else
      result := rest.EngineRetrieveBlob(tableIndex,aID,BlobField,BlobData);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineUpdate(TableModelIndex: integer;
  ID: TID; const SentData: RawUTF8): boolean;
var tableIndex,shardIndex: integer;
    rest: TSQLRest;
begin
  StorageLock(true,'EngineUpdate');
  try
    if not ShardFromID(ID,tableIndex,rest,soUpdate,@shardIndex) then
      result := false else
      if fShardBatch<>nil then begin
        InternalShardBatch(shardIndex).RawUpdate(SentData,ID);
        result := true;
      end else
        result := rest.EngineUpdate(tableIndex,ID,SentData);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineUpdateBlob(TableModelIndex: integer;
  aID: TID; BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean;
var tableIndex: integer;
    rest: TSQLRest;
begin
  result := false;
  StorageLock(true,'EngineUpdateBlob');
  try
    if ShardFromID(aID,tableIndex,rest,soUpdate) then
      result := rest.EngineUpdateBlob(tableIndex,aID,BlobField,BlobData);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineUpdateField(TableModelIndex: integer;
  const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean;
begin
  result := false;
  StorageLock(true,'EngineUpdateField');
  try
    if not ((ssoNoUpdate in fOptions) or (ssoNoUpdateField in fOptions)) then
      result := fShards[fShardLast].EngineUpdateField(fShardTableIndex[fShardLast],
        SetFieldName,SetValue,WhereFieldName,WhereValue);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.EngineUpdateFieldIncrement(
  TableModelIndex: integer; ID: TID; const FieldName: RawUTF8;
  Increment: Int64): boolean;
var tableIndex: integer;
    rest: TSQLRest;
begin
  result := false;
  StorageLock(true,'EngineUpdateFieldIncrement');
  try
    if ShardFromID(ID,tableIndex,rest,soUpdate) then
      result := rest.EngineUpdateFieldIncrement(tableIndex,ID,FieldName,Increment);
  finally
    StorageUnLock;
  end;
end;

function TSQLRestStorageShard.InternalBatchStart(Method: TSQLURIMethod;
  BatchOptions: TSQLRestBatchOptions): boolean;
begin
  result := false;
  if ssoNoBatch in fOptions then
    exit;
  StorageLock(true,'InternalBatchStart'); // protected by try..finally in TSQLRestServer.RunBatch
  try
    if fShardBatch<>nil then
      raise EORMException.CreateUTF8('%.InternalBatchStop should have been called',[self]);
    if fShardLast<0 then // new DB -> force fShardBatch<>nil
      SetLength(fShardBatch,1) else
      SetLength(fShardBatch,fShardLast+1);
    result := true;
  finally
    if not result then // release lock on error
      StorageUnLock;
  end;
end;

function TSQLRestStorageShard.InternalShardBatch(ShardIndex: integer): TSQLRestBatch;
begin
  if cardinal(ShardIndex)>cardinal(fShardLast) then
    raise EORMException.CreateUTF8('%.InternalShardBatch(%)',[self,ShardIndex]);
  if fShardBatch=nil then
    raise EORMException.CreateUTF8('%.InternalBatchStart should have been called',[self]);
  if ShardIndex>=length(fShardBatch) then
    SetLength(fShardBatch,ShardIndex+1); // InitNewShard just called
  if fShardBatch[ShardIndex]=nil then
    if fShards[ShardIndex]<>nil then
      fShardBatch[ShardIndex] := TSQLRestBatch.Create(
        fShards[ShardIndex],fStoredClass,10000,[boExtendedJSON]) else
      raise EORMException.CreateUTF8('%.InternalShardBatch fShards[%]=nil',[self,ShardIndex]);
  result := fShardBatch[ShardIndex];
end;

procedure TSQLRestStorageShard.InternalBatchStop;
var i: integer;
begin
  try
    for i := 0 to high(fShardBatch) do
      if fShardBatch[i]<>nil then
        if fShards[i].BatchSend(fShardBatch[i])<>HTTP_SUCCESS then
          InternalLog('InternalBatchStop(%): %.BatchSend failed for shard #%',
            [fStoredClass,fShards[i].ClassType,i],sllWarning);
  finally
    ObjArrayClear(fShardBatch);
    StorageUnLock;
  end;
end;


{ TSQLRestStorage }

constructor TSQLRestStorage.Create(aClass: TSQLRecordClass; aServer: TSQLRestServer);
begin
  inherited Create(nil);
  if aClass=nil then
    raise EBusinessLayerException.CreateUTF8('%.Create(aClass=nil)',[self]);
  InitializeCriticalSection(fStorageCriticalSection);
  fStoredClass := aClass;
  fStoredClassRecordProps := aClass.RecordProps;
  if aServer<>nil then begin
    fOwner := aServer;
    fModel := aServer.Model;
   end else begin // fallback to an owned model instance
     fModel := TSQLModel.Create([aClass]);
     fModel.Owner := self;
   end;
  fStoredClassProps := fModel.Props[aClass];
  fStoredClassMapping := @fStoredClassProps.ExternalDB;
  fIsUnique := fStoredClassRecordProps.IsUniqueFieldsBits;
  fBasicSQLCount := 'SELECT COUNT(*) FROM '+fStoredClassRecordProps.SQLTableName;
  fBasicSQLHasRows[false] := 'SELECT RowID FROM '+fStoredClassRecordProps.SQLTableName+' LIMIT 1';
  fBasicSQLHasRows[true] := fBasicSQLHasRows[false];
  system.delete(fBasicSQLHasRows[true],8,3);
end;

destructor TSQLRestStorage.Destroy;
begin
  inherited;
  if fStorageCriticalSectionCount<>0 then
    raise EORMException.CreateUTF8('%.Destroy with CS=%',[self,fStorageCriticalSectionCount]);
  DeleteCriticalSection(fStorageCriticalSection);
  if fStorageVirtual<>nil then begin // no GPF e.g. if DB release after server
    fStorageVirtual.fStatic := nil;
    fStorageVirtual.fStaticStorage := nil;
  end;
end;

procedure TSQLRestStorage.BeginCurrentThread(Sender: TThread);
begin // called by TSQLRestServer.BeginCurrentThread
  // nothing to do in this basic REST static class
end;

procedure TSQLRestStorage.EndCurrentThread(Sender: TThread);
begin // called by TSQLRestServer.EndCurrentThread
  // nothing to do in this basic REST static class
end;

function TSQLRestStorage.ServiceContainer: TServiceContainer;
begin
  result := nil;
end;

function TSQLRestStorage.CreateSQLMultiIndex(Table: TSQLRecordClass;
  const FieldNames: array of RawUTF8; Unique: boolean; IndexName: RawUTF8): boolean;
begin
  result := false; // not implemented in this basic REST static class
end;

function TSQLRestStorage.SearchField(const FieldName: RawUTF8;
  FieldValue: Int64; out ResultID: TIDDynArray): boolean;
begin
  result := SearchField(FieldName,Int64ToUTF8(FieldValue),ResultID);
end;

function TSQLRestStorage.RecordCanBeUpdated(Table: TSQLRecordClass;
  ID: TID; Action: TSQLEvent; ErrorMsg: PRawUTF8 = nil): boolean;
begin
  result := ((Owner=nil) or Owner.RecordCanBeUpdated(Table,ID,Action,ErrorMsg));
end;

function TSQLRestStorage.RefreshedAndModified: boolean;
begin
  result := false; // no refresh necessary with "normal" static tables
end;

procedure TSQLRestStorage.StorageLock(WillModifyContent: boolean;
  const msg: RawUTF8);
begin
  if fStorageLockLogTrace or (fStorageCriticalSectionCount>1) then
    InternalLog('StorageLock % [%] %',[fStoredClass,msg,fStorageCriticalSectionCount]);
  EnterCriticalSection(fStorageCriticalSection);
  inc(fStorageCriticalSectionCount);
  if WillModifyContent and
     fStorageLockShouldIncreaseOwnerInternalState and (Owner<>nil) then
    inc(Owner.InternalState);
end;

procedure TSQLRestStorage.StorageUnLock;
begin
  dec(fStorageCriticalSectionCount);
  if fStorageLockLogTrace then
    InternalLog('StorageUnlock % %',[fStoredClass,fStorageCriticalSectionCount]);
  if fStorageCriticalSectionCount<0 then
    raise EORMException.CreateUTF8('%.StorageUnLock with CS=%',
      [self,fStorageCriticalSectionCount]);
  LeaveCriticalSection(fStorageCriticalSection);
end;

function TSQLRestStorage.GetCurrentSessionUserID: TID;
begin
  if fOwner=nil then
    result := 0 else
    result := fOwner.GetCurrentSessionUserID;
end;

procedure TSQLRestStorage.RecordVersionFieldHandle(Occasion: TSQLOccasion;
  var Decoder: TJSONObjectDecoder);
begin
  if fStoredClassRecordProps.RecordVersionField=nil then
    exit;
  if Owner=nil then
    raise EORMException.CreateUTF8('Owner=nil for %.%: TRecordVersion',
      [fStoredClass,fStoredClassRecordProps.RecordVersionField.Name]);
  Owner.InternalRecordVersionHandle(Occasion,fStoredClassProps.TableIndex,
    Decoder,fStoredClassRecordProps.RecordVersionField);
end;

function TSQLRestStorage.UnLock(Table: TSQLRecordClass; aID: TID): boolean;
begin
  result := Model.UnLock(Table,aID);
end;

function TSQLRestStorage.AdaptSQLForEngineList(var SQL: RawUTF8): boolean;
begin
  if fStoredClassProps=nil then
    result := false else begin
    result := IdemPropNameU(fStoredClassProps.SQL.SelectAllWithRowID,SQL);
    if result then
      SQL := fStoredClassProps.SQL.SelectAllWithID else
      result := IdemPropNameU(fStoredClassProps.SQL.SelectAllWithID,SQL);
  end;
end;

function TSQLRestStorage.GetStoredClassName: RawUTF8;
begin
  if self=nil then
    result := '' else
    ToText(fStoredClass,result);
end;


{ TSQLRestServerFullMemory }

constructor TSQLRestServerFullMemory.Create(aModel: TSQLModel;
  aHandleUserAuthentication: boolean);
var t: integer;
begin
  inherited Create(aModel,aHandleUserAuthentication);
  fStaticDataCount := length(fModel.Tables);
  SetLength(fStorage,fStaticDataCount);
  for t := 0 to fStaticDataCount-1 do begin
    fStorage[t] := (StaticDataCreate(fModel.Tables[t]) as TSQLRestStorageInMemory);
    fStorage[t].fStorageLockShouldIncreaseOwnerInternalState := true;
  end;
end;

constructor TSQLRestServerFullMemory.Create(aModel: TSQLModel;
  const aFileName: TFileName; aBinaryFile, aHandleUserAuthentication: boolean);
begin
  fFileName := aFileName;
  fBinaryFile := aBinaryFile;
  Create(aModel,aHandleUserAuthentication);
  LoadFromFile;
  CreateMissingTables(0,[]);
end;

constructor TSQLRestServerFullMemory.CreateWithOwnedAuthenticatedModel(
  const Tables: array of TSQLRecordClass; const aUserName,aHashedPassword: RawUTF8;
  aRoot: RawUTF8);
var User: TSQLAuthUser;
begin
  if aRoot='' then
    aRoot := 'root';
  if aUserName='' then
    CreateWithOwnModel(Tables,false,aRoot) else begin
    CreateWithOwnModel(Tables,true,aRoot);
    CreateMissingTables(0,[itoNoAutoCreateUsers]);
    User := TSQLAuthUser.Create;
    try
      User.LogonName := aUserName;
      User.PasswordHashHexa := aHashedPassword;
      User.GroupRights := TSQLAuthGroup(2); // member of 'Supervisor' group
      Add(User,true);
    finally
      User.Free;
    end;
  end;
end;

constructor TSQLRestServerFullMemory.RegisteredClassCreateFrom(aModel: TSQLModel;
  aServerHandleAuthentication: boolean; aDefinition: TSynConnectionDefinition);
begin
  fFileName := UTF8ToString(aDefinition.ServerName);
  fBinaryFile := aDefinition.DatabaseName<>''; // DefinitionTo() set 'binary'
  Create(aModel,aServerHandleAuthentication);
  LoadFromFile;
end;

procedure TSQLRestServerFullMemory.DefinitionTo(Definition: TSynConnectionDefinition);
begin
  if Definition=nil then
    exit;
  inherited; // set Kind
  Definition.ServerName := StringToUTF8(fFileName);
  if fBinaryFile then
    Definition.DatabaseName := 'binary';
end;

procedure TSQLRestServerFullMemory.CreateMissingTables(user_version: cardinal=0;
  Options: TSQLInitializeTableOptions=[]);
var t: integer;
begin
  inherited;
  // create any missing static instances
  if integer(fStaticDataCount)<>length(fModel.Tables) then begin
    SetLength(fStorage,length(fModel.Tables));
    for t := fStaticDataCount to high(fModel.Tables) do begin
      fStorage[t] := (StaticDataCreate(fModel.Tables[t]) as TSQLRestStorageInMemory);
      fStorage[t].fStorageLockShouldIncreaseOwnerInternalState := true;
    end;
    fStaticDataCount := length(fModel.Tables);
  end;
  // initialize new tables
  for t := 0 to fStaticDataCount-1 do
    with TSQLRestStorageInMemory(fStaticData[t]) do
    if Count=0 then // emulates TSQLRestServerDB.CreateMissingTables
      StoredClass.InitializeTable(Self,'',Options);
end;

destructor TSQLRestServerFullMemory.Destroy;
begin
  UpdateToFile;
  inherited;
end;

procedure TSQLRestServerFullMemory.DropDatabase;
var t: integer;
begin
  for t := 0 to fStaticDataCount-1 do
    TSQLRestStorageInMemory(fStaticData[t]).DropValues;
end;

procedure TSQLRestServerFullMemory.LoadFromStream(aStream: TStream);
var JSON: RawUTF8;
    P, TableName, Data: PUTF8Char;
    t: integer;
    wasString: boolean;
begin
  if aStream=nil then
    exit;
  if fBinaryFile then begin
    if ReadStringFromStream(aStream)=ToText(ClassType)+'00' then
    repeat
      t := Model.GetTableIndex(ReadStringFromStream(aStream));
    until (t<0) or
      not TSQLRestStorageInMemory(fStaticData[t]).LoadFromBinary(aStream);
  end else begin // [{"AuthUser":[{....},{...}]},{"AuthGroup":[{...},{...}]}]
    JSON := StreamToRawByteString(aStream); // assume UTF-8 content
    if JSON='' then
      exit;
    P := pointer(JSON);
    while (P^<>'[') do if P^=#0 then exit else inc(P);
    inc(P);
    repeat
      while (P^<>']') and (P^<>'{') do if P^=#0 then exit else inc(P);
      if P^=']' then break else inc(P);
      TableName := GetJSONField(P,P,@wasString);
      if not wasString or (P=nil) then
        exit;
      t := Model.GetTableIndexPtr(TableName);
      if t<0 then
        exit;
      Data := P;
      P := GotoNextJSONObjectOrArray(P);
      if P=nil then
        break else
        TSQLRestStorageInMemory(fStaticData[t]).LoadFromJSON(Data,P-Data);
    until false;
  end;
end;

procedure TSQLRestServerFullMemory.LoadFromFile;
var S: THandleStream;
begin
  if (fFileName='') or not FileExists(fFileName) then
    exit;
  DropDatabase;
  S := FileStreamSequentialRead(FileName);
  try
    LoadFromStream(S);
  finally
    S.Free;
  end;
end;

procedure TSQLRestServerFullMemory.UpdateToFile;
const CHARS: array[0..6] of AnsiChar = '[{":,}]';
var S: TFileStream;                //   0123456
    t: integer;
    Modified: boolean;
    timer: TPrecisionTimer;
begin
  if (self=nil) or (FileName='') then
    exit;
  Modified := false;
  for t := 0 to fStaticDataCount-1 do
    if TSQLRestStorageInMemory(fStaticData[t]).Modified then begin
      Modified := true;
      break;
    end;
  if not Modified then
    exit;
  timer.Start;
  S := TFileStream.Create(FileName,fmCreate);
  try
    if fBinaryFile then begin
      WriteStringToStream(S,ToText(ClassType)+'00');
      for t := 0 to fStaticDataCount-1 do
      with TSQLRestStorageInMemory(fStaticData[t]) do begin
        WriteStringToStream(S,fStoredClassRecordProps.SQLTableName);
        SaveToBinary(S);
      end;
    end else begin
      S.WriteBuffer(CHARS[0],1);
      for t := 0 to fStaticDataCount-1 do
      with TSQLRestStorageInMemory(fStaticData[t]) do begin
        S.WriteBuffer(CHARS[1],2);
        with fStoredClassRecordProps do
          S.WriteBuffer(pointer(SQLTableName)^,length(SQLTableName));
        S.WriteBuffer(CHARS[2],2);
        SaveToJSON(S,true);
        S.WriteBuffer(CHARS[5],1);
        if t<integer(fStaticDataCount-1) then
          S.WriteBuffer(CHARS[4],1);
      end;
      S.WriteBuffer(CHARS[6],1);
    end;
  finally
    S.Free;
  end;
  InternalLog('UpdateToFile done in %',[timer.Stop],sllDB);
end;

function TSQLRestServerFullMemory.EngineExecute(const aSQL: RawUTF8): boolean;
begin
  result := false; // not implemented in this basic REST server class
end;

procedure TSQLRestServerFullMemory.Flush(Ctxt: TSQLRestServerURIContext);
begin
  if Ctxt.Method=mPUT then begin
    UpdateToFile;
    Ctxt.Success;
  end;
end;

function TSQLRestServerFullMemory.GetStorage(aTable: TSQLRecordClass): TSQLRestStorageInMemory;
var i: cardinal;
begin
  i := fModel.GetTableIndex(aTable);
  if i>=cardinal(length(fStorage)) then
    result := nil else
    result := fStorage[i];
end;

// Engine*() methods will have direct access to static fStorage[])

function TSQLRestServerFullMemory.EngineAdd(TableModelIndex: integer;
  const SentData: RawUTF8): TID;
begin
  result := fStorage[TableModelIndex].EngineAdd(TableModelIndex,SentData);
  inc(InternalState);
end;

function TSQLRestServerFullMemory.EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8;
begin
 result := fStorage[TableModelIndex].EngineRetrieve(TableModelIndex,ID);
end;

function TSQLRestServerFullMemory.EngineUpdate(TableModelIndex: integer; ID: TID;
  const SentData: RawUTF8): boolean;
begin
  result := fStorage[TableModelIndex].EngineUpdate(TableModelIndex,ID,SentData);
end;

function TSQLRestServerFullMemory.EngineDelete(TableModelIndex: integer; ID: TID): boolean;
begin
  result := fStorage[TableModelIndex].EngineDelete(TableModelIndex,ID);
end;

function TSQLRestServerFullMemory.EngineDeleteWhere(TableModelIndex: integer;
  const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean;
begin
  result := fStorage[TableModelIndex].EngineDeleteWhere(TableModelIndex,SQLWhere,IDs);
end;

function TSQLRestServerFullMemory.EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean;
begin
  result := fStorage[TableModelIndex].EngineRetrieveBlob(TableModelIndex,aID,BlobField,BlobData);
end;

function TSQLRestServerFullMemory.EngineUpdateBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean;
begin
  result := fStorage[TableModelIndex].EngineUpdateBlob(TableModelIndex,aID,BlobField,BlobData);
end;

function TSQLRestServerFullMemory.EngineUpdateField(TableModelIndex: integer;
  const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean;
begin
  result := fStorage[TableModelIndex].EngineUpdateField(TableModelIndex,
    SetFieldName,SetValue,WhereFieldName,WhereValue);
end;

function TSQLRestServerFullMemory.EngineUpdateFieldIncrement(TableModelIndex: integer;
  ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean;
begin
  result := fStorage[TableModelIndex].EngineUpdateFieldIncrement(TableModelIndex,
    ID,FieldName,Increment);
end;

// MainEngine*() methods should return error (only access via static fStorage[])

function TSQLRestServerFullMemory.MainEngineAdd(TableModelIndex: integer;
  const SentData: RawUTF8): TID;
begin
  result := 0;
end;

function TSQLRestServerFullMemory.MainEngineRetrieve(TableModelIndex: integer;
  ID: TID): RawUTF8;
begin
  result := '';
end;

function TSQLRestServerFullMemory.MainEngineList(const SQL: RawUTF8;
  ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8;
begin
  result := '';
end;

function TSQLRestServerFullMemory.MainEngineUpdate(TableModelIndex: integer; aID: TID;
  const SentData: RawUTF8): boolean;
begin
  result := false;
end;

function TSQLRestServerFullMemory.MainEngineDelete(TableModelIndex: integer; ID: TID): boolean;
begin
  result := false;
end;

function TSQLRestServerFullMemory.MainEngineDeleteWhere(TableModelIndex: integer;
  const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean;
begin
  result := false;
end;

function TSQLRestServerFullMemory.MainEngineRetrieveBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean;
begin
  result := false;
end;

function TSQLRestServerFullMemory.MainEngineUpdateBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean;
begin
  result := false;
end;

function TSQLRestServerFullMemory.MainEngineUpdateField(TableModelIndex: integer;
  const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean;
begin
  result := false;
end;

function TSQLRestServerFullMemory.MainEngineUpdateFieldIncrement(
  TableModelIndex: integer; ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean;
begin
  result := false;
end;


{ TSQLRestServerRemoteDB }

constructor TSQLRestServerRemoteDB.Create(aRemoteRest: TSQLRest;
  aHandleUserAuthentication: boolean);
var i: integer;
begin
  if aRemoteRest=nil then
    raise EORMException.CreateUTF8('%.Create(nil)',[self]);
  inherited Create(aRemoteRest.Model,aHandleUserAuthentication);
  SetLength(fRemoteTableIndex,Model.TablesMax+1);
  for i := 0 to Model.TablesMax do
    fRemoteTableIndex[i] := aRemoteRest.Model.GetTableIndexExisting(Model.Tables[i]);
  fRemoteRest := aRemoteRest;
end;

function TSQLRestServerRemoteDB.EngineAdd(TableModelIndex: integer;
  const SentData: RawUTF8): TID;
begin
  result := fRemoteRest.EngineAdd(fRemoteTableIndex[TableModelIndex],SentData);
end;

function TSQLRestServerRemoteDB.EngineDelete(TableModelIndex: integer; ID: TID): boolean;
begin
  result := fRemoteRest.EngineDelete(fRemoteTableIndex[TableModelIndex],ID);
end;

function TSQLRestServerRemoteDB.EngineDeleteWhere(TableModelIndex: Integer;
  const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean;
begin
  result := fRemoteRest.EngineDeleteWhere(fRemoteTableIndex[TableModelIndex],SQLWhere,IDs);
end;

function TSQLRestServerRemoteDB.EngineExecute(const aSQL: RawUTF8): boolean;
begin
  result := fRemoteRest.EngineExecute(aSQL);
end;

function TSQLRestServerRemoteDB.EngineList(const SQL: RawUTF8;
  ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8;
begin
  result := fRemoteRest.EngineList(SQL,ForceAJAX,ReturnedRowCount);
end;

function TSQLRestServerRemoteDB.EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8;
begin
  result := fRemoteRest.EngineRetrieve(fRemoteTableIndex[TableModelIndex],ID);
end;

function TSQLRestServerRemoteDB.EngineRetrieveBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean;
begin
  if (self=nil) or (BlobField=nil) then
    result := false else
    result := fRemoteRest.EngineRetrieveBlob(fRemoteTableIndex[TableModelIndex],aID,BlobField,BlobData);
end;

function TSQLRestServerRemoteDB.EngineUpdate(TableModelIndex: integer;
  ID: TID; const SentData: RawUTF8): boolean;
begin
  result := fRemoteRest.EngineUpdate(fRemoteTableIndex[TableModelIndex],ID,SentData);
end;

function TSQLRestServerRemoteDB.EngineUpdateBlob(TableModelIndex: integer; aID: TID;
  BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean;
begin
  if (self=nil) or (BlobField=nil) then
    result := false else
    result := fRemoteRest.EngineUpdateBlob(fRemoteTableIndex[TableModelIndex],aID,BlobField,BlobData);
end;

function TSQLRestServerRemoteDB.EngineUpdateField(TableModelIndex: integer;
  const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean;
begin
  result := fRemoteRest.EngineUpdateField(fRemoteTableIndex[TableModelIndex],SetFieldName,SetValue,WhereFieldName,WhereValue);
end;

function TSQLRestServerRemoteDB.EngineUpdateFieldIncrement(TableModelIndex: integer;
  ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean;
begin
  result := fRemoteRest.EngineUpdateFieldIncrement(fRemoteTableIndex[TableModelIndex],
    ID,FieldName,Increment);
end;

function TSQLRestServerRemoteDB.AfterDeleteForceCoherency(TableIndex: integer;
  aID: TID): boolean;
begin
  result := true; // coherency will be performed on the server side
end;


{ TSQLRestClient }

function TSQLRestClient.GetForceBlobTransfert: Boolean;
var i: integer;
begin
  result := false;
  if fForceBlobTransfert=nil then
    exit;
  for i := 0 to fModel.fTablesMax do
    if not fForceBlobTransfert[i] then
      exit;
  result := true; // all Tables have BLOB transfert set
end;

procedure TSQLRestClient.SetForceBlobTransfert(Value: boolean);
var i: integer;
begin
  Finalize(fForceBlobTransfert);
  if Value then begin
    SetLength(fForceBlobTransfert,fModel.fTablesMax+1);
    for i := 0 to fModel.fTablesMax do
      fForceBlobTransfert[i] := true;
  end;
end;

function TSQLRestClient.GetForceBlobTransfertTable(aTable: TSQLRecordClass): Boolean;
begin
  if fForceBlobTransfert=nil then
    result := false else
    result := fForceBlobTransfert[fModel.GetTableIndexExisting(aTable)];
end;

procedure TSQLRestClient.SetForceBlobTransfertTable(aTable: TSQLRecordClass; aValue: Boolean);
var i: integer;
begin
  i := fModel.GetTableIndexExisting(aTable);
  if fForceBlobTransfert=nil then
    if aValue then
      SetLength(fForceBlobTransfert,fModel.fTablesMax+1) else
      exit; // nothing to set
  fForceBlobTransfert[i] := aValue;
end;

function TSQLRestClient.InternalAdd(Value: TSQLRecord; SendData: boolean;
  CustomFields: PSQLFieldBits; ForceID, DoNotAutoComputeFields: boolean): TID;
begin
  result := inherited InternalAdd(Value,SendData,CustomFields,ForceID,DoNotAutoComputeFields);
  if (result>0) and (fForceBlobTransfert<>nil) and
     fForceBlobTransfert[fModel.GetTableIndexExisting(PSQLRecordClass(Value)^)] then
     UpdateBlobFields(Value);
end;

function TSQLRestClient.EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8;
var dummy: cardinal;
begin
  if not ClientRetrieve(TableModelIndex,ID,false,dummy,result) then
    result := '';
end;

function TSQLRestClient.Retrieve(aID: TID; Value: TSQLRecord;
  ForUpdate: boolean=false): boolean;
var Resp: RawUTF8;
    TableIndex: integer;
begin
  result := false;
  if (self=nil) or (aID<=0) or (Value=nil) then
    exit;
  TableIndex := Model.GetTableIndexExisting(PSQLRecordClass(Value)^);
  if ForUpdate then begin
    if not Model.Lock(TableIndex,aID) then
      exit; // error marking as locked by the client
  end else begin
    Resp := fCache.Retrieve(TableIndex,aID);
    if Resp<>'' then begin
      Value.FillFrom(Resp);
      Value.fID := aID; // JSON object may not contain the ID
      result := true;
      exit; // fast retrieved from internal Client cache (BLOBs ignored)
  end;
  end;
  try
    if ClientRetrieve(TableIndex,aID,ForUpdate,Value.fInternalState,Resp) then begin
      if not ForUpdate then
        fCache.Notify(TableIndex,aID,Resp,soSelect);
      Value.FillFrom(Resp);
      Value.fID := aID; // JSON object may not contain the ID
      if (fForceBlobTransfert<>nil) and fForceBlobTransfert[TableIndex] then
        result := RetrieveBlobFields(Value) else
        result := true;
      ForUpdate := false; // any exception shall unlock the record
    end;
  finally
    if ForUpdate then
      Model.UnLock(TableIndex,aID);
  end;
end;

function TSQLRestClient.Update(Value: TSQLRecord; const CustomFields: TSQLFieldBits;
  DoNotAutoComputeFields: boolean): boolean;
begin
  result := BeforeUpdateEvent(Value) and
    inherited Update(Value,CustomFields,DoNotAutoComputeFields);
  if result then begin
    if (fForceBlobTransfert<>nil) and IsZero(CustomFields) and
       fForceBlobTransfert[Model.GetTableIndexExisting(PSQLRecordClass(Value)^)] then
      result := UpdateBlobFields(Value);
    if result and assigned(OnRecordUpdate) then
      OnRecordUpdate(Value);
  end;
end;

function TSQLRestClient.BeforeUpdateEvent(Value: TSQLRecord): Boolean;
begin
  Result := true; // by default, just allow the update to proceed
end;

function TSQLRestClient.Refresh(aID: TID; Value: TSQLRecord;
  var Refreshed: boolean): boolean;
var Resp, Original: RawUTF8;
begin
  result := false;
  if (aID>0) and (self<>nil) and (Value<>nil) then
    if ClientRetrieve(Model.GetTableIndexExisting(PSQLRecordClass(Value)^),aID,False,
       Value.fInternalState,Resp) then begin
      Original := Value.GetJSONValues(IsNotAjaxJSON(pointer(Resp)),true,soSelect);
      Resp := trim(Resp);
      if (Resp<>'') and (Resp[1]='[') then // '[{....}]' -> '{...}'
        Resp := copy(Resp,2,length(Resp)-2);
      if Original<>Resp then begin // did the content really change?
        Refreshed := true;
        Value.FillFrom(Resp);
      end;
      result := true;
    end;
end;

procedure TSQLRestClient.Commit(SessionID: cardinal; RaiseException: boolean);
begin
  inherited Commit(SessionID,RaiseException);
end;

function TSQLRestClient.TransactionBegin(aTable: TSQLRecordClass;
  SessionID: cardinal): boolean;
begin
  result := inherited TransactionBegin(aTable,SessionID);
end;

procedure TSQLRestClient.RollBack(SessionID: cardinal);
begin
  inherited;
end;

function TSQLRestClient.ListFmt(const Tables: array of TSQLRecordClass; const SQLSelect: RawUTF8;
  const SQLWhereFormat: RawUTF8; const Args: array of const): TSQLTableJSON;
begin
  result := List(Tables,SQLSelect,FormatUTF8(SQLWhereFormat,Args));
end;

function TSQLRestClient.ListFmt(const Tables: array of TSQLRecordClass;
  const SQLSelect: RawUTF8; const SQLWhereFormat: RawUTF8;
  const Args, Bounds: array of const): TSQLTableJSON;
begin
  result := List(Tables,SQLSelect,FormatUTF8(SQLWhereFormat,Args,Bounds));
end;

function TSQLRestClient.ServiceContainer: TServiceContainer;
begin
  if fServices=nil then
    fServices := TServiceContainerClient.Create(self);
  result := fServices;
end;


{ TSQLRecordLog }

destructor TSQLRecordLog.Destroy;
begin
  fLogTableWriter.Free;
  fLogTableStorage.Free;
  inherited;
end;

constructor TSQLRecordLog.CreateFrom(OneLog: TSQLRecord; const aJSON: RawUTF8);
var L,FieldCount: integer;
    P: PUTF8Char;
begin
  inherited Create;
  L := length(aJSON);
  if (L<10) or (Copy(aJSON,L-1,2)<>']}') then
    exit;
  fLogTableStorage := THeapMemoryStream.Create;
  fLogTableWriter := OneLog.RecordProps.CreateJSONWriter(
    fLogTableStorage,false,true,ALL_FIELDS,{knownrows=}0);
  fLogTableWriter.FlushToStream;
  P := pointer(aJSON);
  if not CompareMem(fLogTableStorage.Memory,P,fLogTableStorage.Position) or
     not IsNotExpandedBuffer(P,P+length(aJSON),FieldCount,fLogTableRowCount) or
     (fLogTableRowCount<0) then begin
    // field format changed or invalid
    FreeAndNil(fLogTableWriter);
    FreeAndNil(fLogTableStorage);
    exit;
  end;
  fLogTableStorage.Seek(0,soFromBeginning);
  fLogTableStorage.WriteBuffer(Pointer(aJSON)^,L-2);
end;

procedure TSQLRecordLog.Log(OneLog: TSQLRecord);
begin
  if OneLog=nil then
    exit;
  // simulate adding a row: compute new ID
  inc(OneLog.fID);
  // adding a row, in not-expanded format
  if not Assigned(fLogTableStorage) then begin
    fLogTableStorage := THeapMemoryStream.Create;
    fLogTableWriter := OneLog.RecordProps.CreateJSONWriter(
      fLogTableStorage,false,true,ALL_FIELDS,{knownrows=}0);
    fLogTableRowCount := 1;
  end else begin
    fLogTableWriter.Add(',');
    if (fMaxLogTableRowCount<>0) and (fLogTableRowCount>=fMaxLogTableRowCount) then
      fLogTableWriter.TrimFirstRow else
      inc(fLogTableRowCount);
  end;
  OneLog.GetJSONValues(fLogTableWriter)
end;

function TSQLRecordLog.LogCurrentPosition: integer;
begin
  if not Assigned(fLogTableStorage) then
    result := 0 else begin
    fLogTableWriter.FlushToStream;
    result := fLogTableStorage.Position;
  end;
end;

function TSQLRecordLog.LogTableJSON: RawUTF8;
begin
  result := LogTableJSONFrom(0);
end;

function TSQLRecordLog.LogTableJSONFrom(StartPosition: integer): RawUTF8;
var JSONStart: RawUTF8;
    Data: PAnsiChar;
begin
  if not Assigned(fLogTableStorage) or (StartPosition<0) then
    result := '' else begin
    fLogTableWriter.FlushToStream;
    Data := fLogTableStorage.Memory;
    FastSetString(result,Data+StartPosition,fLogTableStorage.Position-StartPosition);
    // format as valid not expanded JSON table content:
    if StartPosition<>0 then begin
      FastSetString(JSONStart,Data,fLogTableWriter.StartDataPosition);
      result := JSONStart+result;
    end;
    result := result+']}';
  end;
end;


{ RecordRef }

function RecordReference(Model: TSQLModel; aTable: TSQLRecordClass; aID: TID): TRecordReference;
begin
  if aID=0 then
    result := 0 else begin
    result := Model.GetTableIndexExisting(aTable);
    if result>63 then // TRecordReference handle up to 64=1 shl 6 tables
      result := 0 else
      inc(result,aID shl 6); // 64=1 shl 6
  end;
end;

function RecordReference(aTableIndex: cardinal; aID: TID): TRecordReference;
begin
  if (aID=0) or (aTableIndex>63) then
    result := 0 else
    result := aTableIndex+aID shl 6;
end;

procedure RecordRefToID(var aArray: TInt64DynArray);
var i: Integer;
begin
  for i := 0 to high(aArray) do
    aArray[i] := aArray[i] shr 6;
end;

procedure RecordRef.From(Model: TSQLModel; aTable: TSQLRecordClass; aID: TID);
begin
  Value := Model.GetTableIndexExisting(aTable);
  if Value>63 then // TRecordReference handle up to 64=1 shl 6 tables
    Value := 0 else
    inc(Value,aID shl 6); // 64=1 shl 6
end;

function RecordRef.ID: TID;
begin
  result := Value shr 6;  // 64=1 shl 6
end;

function RecordRef.Table(Model: TSQLModel): TSQLRecordClass;
var V: integer;
begin
  if (Model=nil) or (Value=0) then
    result := nil else begin
    V := Value and 63;
    if V>Model.TablesMax then
      result := nil else
      result := Model.Tables[V];
  end;
end;

function RecordRef.TableIndex: integer;
begin
  result := Value and 63;
end;

function RecordRef.Text(Model: TSQLModel): RawUTF8;
var aTable: TSQLRecordClass;
begin
  if ((Value shr 6)=0) then
    // Value=0 or no valid ID
    result := '' else begin
    aTable := Table(Model);
    if aTable=nil then
      result := '' else
      result := Model.TableProps[Value and 63].Props.SQLTableName+
        ' '+Int64ToUtf8(Value shr 6);
  end;
end;

function RecordRef.Text(Rest: TSQLRest): RawUTF8;
var T: TSQLRecordClass;
    aID: TID;
begin
  result := '';
  if ((Value shr 6)=0) or (Rest=nil) then
    exit;
  T := Table(Rest.Model);
  if T=nil then
    exit;
  aID := ID;
  with Rest.Model.TableProps[Value and 63].Props do
  if aID<=0 then
    result := SQLTableName else begin
    result := Rest.MainFieldValue(T,aID,true);
    if result='' then
      FormatUTF8('% %',[SQLTableName,aID],result) else
      result := FormatUTF8('% "%"',[SQLTableName,result]);
  end;
end;


{ TSQLLocks }

function TSQLLocks.isLocked(aID: TID): boolean;
begin
  result := (@self<>nil) and (Count<>0) and (aID<>0) and
    Int64ScanExists(pointer(IDs),Count,aID);
end;

function TSQLLocks.Lock(aID: TID): boolean;
var P: PInt64;
begin
  if (@self=nil) or (aID=0) then
    // void or full
    result := false else begin
    P := Int64Scan(pointer(IDs),Count,aID);
    if P<>nil then
      // already locked
      result := false else begin
      // add to ID[] and Ticks[]
      P := Int64Scan(pointer(IDs),Count,0);
      if P=nil then begin
        // no free entry -> add at the end
        if Count>=length(IDs) then begin
          SetLength(IDs,Count+512);
          SetLength(Ticks64s,Count+512);
        end;
        IDs[Count] := aID;
        Ticks64s[Count] := GetTickCount64;
        inc(Count);
      end else begin
        // store at free entry
        P^ := aID;
        Ticks64s[(PtrUInt(P)-PtrUInt(IDs))shr 3] := GetTickCount64;
      end;
      result := true;
    end;
  end;
end;

procedure TSQLLocks.PurgeOlderThan(MinutesFromNow: cardinal);
var LastOK64: Int64;
    i, LastEntry: integer;
begin
  if (@self=nil) or (Count=0) then
    exit; // nothing to purge
  LastOK64 := GetTickCount64-MinutesFromNow*(1000*60); // GetTickCount64() unit is ms
  LastEntry := -1;
  for i := 0 to Count-1 do
    if IDs[i]<>0 then
    if Ticks64s[i]<LastOK64 then // too old?
      IDs[i] := 0 else // 0 frees entry
      LastEntry := i; // refresh last existing entry
  Count := LastEntry+1; // update count (may decrease list length)
end;

function TSQLLocks.UnLock(aID: TID): boolean;
var P: PInt64;
begin
  if (@self=nil) or (Count=0) or (aID=0) then
    result := false else begin
    P := Int64Scan(pointer(IDs),Count,aID);
    if P=nil then
      result := false else begin
      P^ := 0; // 0 marks free entry
      if ((PtrUInt(P)-PtrUInt(IDs))shr 3>=PtrUInt(Count-1)) then
        dec(Count); // freed last entry -> decrease list length
      result := true;
    end;
  end;
end;


procedure CopyObject(aFrom, aTo: TObject);
var P,P2: PPropInfo;
    i: integer;
    Cfrom,Cto,C: TClass;
begin
  if (aFrom=nil) or (aTo=nil) then
    exit;
  {$ifndef LVCL}
  if aFrom.InheritsFrom(TCollection) then begin
    CopyCollection(TCollection(aFrom),TCollection(aTo));
    exit;
  end;
  {$endif}
  if aFrom.InheritsFrom(TStrings) then begin
    if aTo.InheritsFrom(TStrings) then
      CopyStrings(TStrings(aFrom),TStrings(aTo));
    exit;
  end;
  Cfrom := aFrom.ClassType;
  Cto := aTo.ClassType;
  if Cto.InheritsFrom(Cfrom) then // C = most common hierarchy level
    C := Cfrom else
  if Cfrom.InheritsFrom(Cto) then
    C := Cto else begin
    repeat // no common inheritance -> slower lookup by property name
      for i := 1 to InternalClassPropInfo(Cfrom,P) do begin
        P2 := ClassFieldPropWithParents(Cto,P^.Name);
        if P2<>nil then
          P^.CopyValue(aFrom,aTo,P2);
        P := P^.Next;
      end;
      Cfrom := GetClassParent(Cfrom);
    until Cfrom=TObject;
    exit;
  end;
  repeat // fast process of inherited PPropInfo
    for i := 1 to InternalClassPropInfo(C,P) do begin
      P^.CopyValue(aFrom,aTo);
      P := P^.Next;
    end;
    C := GetClassParent(C);
  until C=TObject;
end;

function CopyObject(aFrom: TObject): TObject;
var DInst: TClassInstance;
begin
  if aFrom=nil then begin
    result := nil;
    exit;
  end;
  DInst.Init(aFrom.ClassType);
  result := DInst.CreateNew;
  try
    CopyObject(aFrom,result);
  except
    FreeAndNil(result); // avoid memory leak if error during new instance copy
  end;
end;

{$ifndef LVCL}
procedure CopyCollection(Source, Dest: TCollection);
var i: integer;
begin
  if (Source=nil) or (Dest=nil) or (Source.ClassType<>Dest.ClassType) then
    exit;
  Dest.BeginUpdate;
  try
    Dest.Clear;
    for i := 0 to Source.Count-1 do
      CopyObject(Source.Items[i],Dest.Add); // Assign() fails for most objects
  finally
    Dest.EndUpdate;
  end;
end;
{$endif}

procedure CopyStrings(Source, Dest: TStrings);
begin
  if (Source=nil) or (Dest=nil) then
    exit;
  {$ifdef LVCL}
  Dest.Clear;
  Dest.AddStrings(Source);
  {$else}
  Dest.Assign(Source);
  {$endif}
end;

procedure WriteObject(Value: TObject; var IniContent: RawUTF8; const Section: RawUTF8;
  const SubCompName: RawUTF8);
var CT: TClass;
    P: PPropInfo;
    i, V: integer;
    Obj: TObject;
    tmp,field: RawUTF8;
begin
  if Value=nil then
    exit;
  CT := Value.ClassType;
  repeat
    for i := 1 to InternalClassPropInfo(CT,P) do begin
      field := SubCompName+ToUTF8(P^.Name);
      case P^.PropType^.Kind of
        tkInt64{$ifdef FPC}, tkQWord{$endif}:
          UpdateIniEntry(IniContent,Section,field,
            Int64ToUtf8(P^.GetInt64Prop(Value)));
        {$ifdef FPC}tkBool,{$endif} tkEnumeration, tkSet, tkInteger: begin
          V := P^.GetOrdProp(Value);
          //if V<>P^.Default then NO DEFAULT: update INI -> must override previous
          UpdateIniEntry(IniContent,Section,field,
            Int32ToUtf8(V));
        end;
        {$ifdef HASVARUSTRING}tkUString,{$endif} {$ifdef FPC}tkLStringOld,{$endif}
        tkLString, tkWString: begin
          P^.GetLongStrValue(Value,tmp);
          UpdateIniEntry(IniContent,Section,field,tmp);
        end;
        tkClass:
        if Section='' then begin // recursive call works only as plain object
          Obj := P^.GetObjProp(Value);
          if (Obj<>nil) and Obj.InheritsFrom(TPersistent) then
            WriteObject(Value,IniContent,Section,field+'.');
        end;
        // tkString (shortstring) and tkInterface are not handled
      end;
      P := P^.Next;
    end;
    CT := GetClassParent(CT);
  until CT=TObject;
end;

function WriteObject(Value: TObject): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  if Value<>nil then
    with TIniWriter.CreateOwnedStream(temp) do
    try
      WriteObject(Value,'');
      SetText(result);
    finally
      Free;
    end else
    result := '';
end;

function ObjectEquals(Value1,Value2: TObject; ignoreGetterFields: boolean): boolean;
var i: integer;
    C1,C2: TClass;
    P1,P2: PPropInfo;
begin
  if (Value1=nil) or (Value2=nil) or (Value1=Value2) then
    result := Value1=Value2 else
  if Value1.InheritsFrom(TSQLRecord) and Value2.InheritsFrom(TSQLRecord) then
    result := TSQLRecord(Value1).SameValues(TSQLRecord(Value2)) else begin
    result := false;
    C1 := Value1.ClassType;
    C2 := Value2.ClassType;
    repeat
      for i := 1 to InternalClassPropInfo(C1,P1) do begin
        if not ignoreGetterFields or P1^.GetterIsField then
          if C2<>C1 then begin
            P2 := ClassFieldPropWithParents(C2,P1^.Name);
            if (P2=nil) or not P1^.SameValue(Value1,P2,Value2) then
              exit;
          end else
            if not P1^.SameValue(Value1,P1,Value2) then
              exit;
        P1 := P1^.Next;
      end;
      C1 := GetClassParent(C1);
    until C1=TObject;
    result := true;
  end;
end;

function ObjectToJSONDebug(Value: TObject; Options: TTextWriterWriteObjectOptions): RawUTF8;
begin
  if Value=nil then
    result := NULL_STR_VAR else
  if Value.InheritsFrom(Exception) and not Value.InheritsFrom(ESynException) then
    result := FormatUTF8('{"%":?}',[Value],[Exception(Value).Message],True) else
    result := ObjectToJSON(Value,Options);
end;

function ObjectToVariantDebug(Value: TObject): variant;
var json: RawUTF8;
begin
  VarClear(result);
  json := ObjectToJSONDebug(Value);
  PDocVariantData(@result)^.InitJSONInPlace(pointer(json),JSON_OPTIONS_FAST);
end;

procedure _ObjAddProps(Value: TObject; var Obj: variant);
var v: variant;
begin
  ObjectToVariant(Value,v,[woDontStoreDefault]);
  _ObjAddProps(v,Obj);
end;

function ObjectToVariantDebug(Value: TObject;
  const ContextFormat: RawUTF8; const ContextArgs: array of const;
  const ContextName: RawUTF8): variant;
begin
  _Json(ObjectToJSONDebug(Value),result,JSON_OPTIONS_FAST);
  if ContextFormat<>'' then
    if ContextFormat[1]='{' then
      _ObjAddProps([ContextName,_JsonFastFmt(ContextFormat,[],ContextArgs)],result) else
      _ObjAddProps([ContextName,FormatUTF8(ContextFormat,ContextArgs)],result);
end;

type
  TJSONObject =
    (oNone, oObject, oException, oSynException, oList, oObjectList,
     {$ifndef LVCL}oCollection,{$endif}
     oUtfs, oStrings, oSQLRecord, oSQLMany, oPersistent, oSynAutoCreateFields,
     oSynPersistentWithPassword, oSynMonitor, oSQLTable,
     oCustomReaderWriter, oCustomPropName);
  TShort63 = string[63];
  TShort63DynArray = array of TShort63;
  TJSONCustomParser = record
    Reader: TJSONSerializerCustomReader;
    Writer: TJSONSerializerCustomWriter;
    Props: PPropInfoDynArray;
    Fields: TShort63DynArray; // match Props[] order
    Kind: TJSONObject;
  end;
  TJSONCustomParsers = array of TJSONCustomParser;
  PJSONCustomParser = ^TJSONCustomParser;

var
  JSONCustomParsers: TSynDictionary; // store TClass->TJSONCustomParser

function JSONObjectFromClass(aClassType: TClass; out aParser: PJSONCustomParser): TJSONObject;
const
  MAX = {$ifdef LVCL}15{$else}16{$endif};
  TYP: array[0..MAX] of TClass = ( // all classes types gathered in CPU L1 cache
    TObject,Exception,ESynException,TList,TObjectList,TPersistent,TSynAutoCreateFields,
    TSynPersistentWithPassword,TSynPersistent,TInterfacedObjectWithCustomCreate,
    TSynMonitor,TSQLRecordMany,TSQLRecord,TStrings,TRawUTF8List,TSQLTable
    {$ifndef LVCL},TCollection{$endif});
  OBJ: array[0..MAX] of TJSONObject = ( // oPersistent = has published properties
    oObject,oException,oSynException,oList,oObjectList,oPersistent,oSynAutoCreateFields,
    oSynPersistentWithPassword,oPersistent,oPersistent,
    oSynMonitor,oSQLMany,oSQLRecord,oStrings,oUtfs,oSQLTable
    {$ifndef LVCL},oCollection{$endif});
var P: PJSONCustomParser;
    added: boolean;
    i: integer;
begin
  result := oNone;
  if aClassType<>nil then begin
    JSONCustomParsers.Safe.Lock;
    try
      aParser := JSONCustomParsers.FindValueOrAdd(aClassType,added);
      if not added then begin
        result := aParser^.Kind;
        if result<>oNone then // fast retrieval from cache
          exit; // =oNone if has been unsubscribed
      end;
      repeat // search from RTTI and parent custom registration
        i := PtrUIntScanIndex(@TYP,MAX+1,PtrUInt(aClassType));
        if i>=0 then begin
          result := OBJ[i];
          aParser^.Kind := result; // default serialization from RTTI
          exit;
        end;
        aClassType := GetClassParent(aClassType);
        P := JSONCustomParsers.FindValue(aClassType);
        if (P<>nil) and (P^.Kind in [oCustomReaderWriter,oCustomPropName]) then begin
          aParser^ := P^; // copy from parent
          result := P^.Kind;
          exit;
        end;
      until aClassType=nil; // should never happen, since TObject exists in TYP[]
    finally
      JSONCustomParsers.Safe.UnLock;
    end;
  end else
    aParser := nil;
end;

class procedure TJSONSerializer.RegisterCustomSerializer(aClass: TClass;
  aReader: TJSONSerializerCustomReader; aWriter: TJSONSerializerCustomWriter);
var added: boolean;
    P: PJSONCustomParser;
begin
  JSONCustomParsers.Safe.Lock;
  try
    P := JSONCustomParsers.FindValueOrAdd(aClass,added);
    P^.Writer := aWriter;
    P^.Reader := aReader;
    P^.Props := nil; // exclusive
    P^.Fields := nil;
    if Assigned(aWriter) or Assigned(aReader) then
      P^.Kind := oCustomReaderWriter else
      P^.Kind := oNone;
  finally
    JSONCustomParsers.Safe.UnLock;
  end;
end;

function JSONCustomParsersFieldProp(ClassType: TClass; Parser: PJSONCustomParser;
  PropName: PUTF8Char; PropNameLen: integer): PPropInfo;
var i: integer;
begin
  if Parser^.Props<>nil then begin // search from RegisterCustomSerializerFieldNames()
    for i := 0 to length(Parser^.Fields)-1 do
      if IdemPropName(Parser^.Fields[i],PropName,PropNameLen) then begin
        result := Parser^.Props[i];
        exit;
      end;
    result := nil;
  end else // a previous RegisterCustomSerializerFieldNames() was unregistered
    result := ClassFieldPropWithParentsFromUTF8(ClassType,PropName,PropNameLen);
end;

class procedure TJSONSerializer.RegisterCustomSerializerFieldNames(aClass: TClass;
  const aClassFields, aJsonFields: array of ShortString);
var prop: PPropInfoDynArray;
    field: TShort63DynArray;
    n,p,f: integer;
    found: boolean;
    parser: PJSONCustomParser;
begin
  if high(aClassFields)<>high(aJsonFields) then
    raise EParsingException.CreateUTF8('RegisterCustomSerializerFieldNames(%,%,%)'+
      ' fields count mismatch', [aClass,high(aClassFields),high(aJsonFields)]);
  if aClass.InheritsFrom(TSQLRecord) then
    raise EParsingException.CreateUTF8('RegisterCustomSerializerFieldNames(%)'+
      ' not allowed on ORM class', [aClass]);
  prop := ClassFieldAllProps(aClass,[low(TTypeKind)..high(TTypeKind)]);
  SetLength(field,length(prop));
  n := 0;
  for p := 0 to high(prop) do begin
    found := false;
    for f := 0 to high(aClassFields) do // check customized field name
      if IdemPropName(prop[p].Name,aClassFields[f]) then begin
        if aJsonFields[f]<>'' then begin // '' to ignore this property
          field[n] := aJsonFields[f];
          prop[n] := prop[p];
          inc(n);
        end;
        found := true;
        break;
      end;
    if not found then begin // default serialization of published property
      field[n] := prop[p].Name;
      prop[n] := prop[p];
      inc(n);
    end;
  end;
  SetLength(prop,n);
  SetLength(field,n);
  JSONCustomParsers.Safe.Lock;
  try
    parser := JSONCustomParsers.FindValueOrAdd(aClass,found);
    @parser^.Writer := nil; // exclusive
    @parser^.Reader := nil;
    parser^.Props := prop;
    parser^.Fields := field;
    if Assigned(prop) then
      parser^.Kind := oCustomPropName else
      parser^.Kind := oNone;
  finally
    JSONCustomParsers.Safe.UnLock;
  end;
end;

constructor TJSONSerializerRegisteredClassAbstract.Create;
begin
  inherited Create;
  fSafe.Init;
end;

destructor TJSONSerializerRegisteredClassAbstract.Destroy;
begin
  inherited;
  fSafe.Done;
end;

function TJSONSerializerRegisteredClass.Find(JSON: PUTF8Char;
  AndRegisterClass: boolean): TClass;
var token: shortstring;
    ClassNameValue: PUTF8Char;
    ClassNameLen: integer;
begin // at input, JSON^='{'
  result := nil;
  if self=nil then
    exit;
  inc(JSON);
  GetJSONPropName(JSON,token);
  if (JSON=nil) or not IdemPropName('ClassName',token) then
    exit; // we expect woStoreClassName option to have been used
  if JSONRetrieveStringField(JSON,ClassNameValue,ClassNameLen,false)=nil then
    exit; //invalid JSON string value
  fSafe.Lock;
  try
    if (fLastClass<>nil) and
       IdemPropName(PShortString(PPointer(PtrInt(PtrUInt(fLastClass))+vmtClassName)^)^,
        ClassNameValue,ClassNameLen) then begin
      result := fLastClass; // for speed-up e.g. within a loop
      exit;
    end;
    result := Find(ClassNameValue,ClassNameLen);
    if result=nil then begin // not registered here -> try from Classes.pas
      {$ifndef LVCL}
      if AndRegisterClass then
        result := FindClass(UTF8DecodeToString(ClassNameValue,ClassNameLen));
      if result=nil then
      {$endif}
        exit; // unknown type
    end;
    fLastClass  := result;
  finally
    fSafe.UnLock;
  end;
end;

procedure TJSONSerializerRegisteredClass.AddOnce(aItemClass: TClass);
begin
  fSafe.Lock;
  try
    if not PtrUIntScanExists(pointer(List),Count,PtrUInt(aItemClass)) then
      Add(aItemClass);
  finally
    fSafe.UnLock;
  end;
end;

function TJSONSerializerRegisteredClass.Find(aClassName: PUTF8Char;
  aClassNameLen: integer): TClass;
var i: integer;
begin
  result := nil;
  fSafe.Lock;
  try
    for i := 0 to Count-1 do
      // new TObject.ClassName is UnicodeString (since Delphi 20009) -> inline code
      // with vmtClassName = UTF-8 encoded text stored in a shortstring = -44
      if IdemPropName(PShortString(PPointer(PtrInt(PtrUInt(List[i]))+vmtClassName)^)^,
          aClassName,aClassNameLen) then begin
        result := List[i];
        exit;
      end;
  finally
    fSafe.UnLock;
  end;
end;


{$ifndef LVCL}
type
  TJSONSerializerRegisteredCollection = class(TJSONSerializerRegisteredClassAbstract)
  protected
  public
    procedure AddOnce(aCollection: TCollectionClass; aItem: TCollectionItemClass);
    function Find(aCollClassName: PUTF8Char; aCollClassNameLen: integer): TCollectionItemClass; overload;
    function Find(aCollection: TCollectionClass): TCollectionItemClass; overload;
  end;

function TJSONSerializerRegisteredCollection.Find(aCollection: TCollectionClass): TCollectionItemClass;
var i: integer;
begin
  result := nil;
  if self=nil then
    exit;
  fSafe.Lock;
  try
    for i := 0 to (Count shr 1)-1 do
      if TClass(List[i*2])=aCollection then begin
        result := List[i*2+1];
        exit;
      end;
  finally
    fSafe.UnLock;
  end;
end;

procedure TJSONSerializerRegisteredCollection.AddOnce(aCollection: TCollectionClass; aItem: TCollectionItemClass);
begin
  if (self=nil) or (Find(aCollection)<>nil) then
    exit;
  fSafe.Lock;
  try
    Add(aCollection);
    Add(aItem);
  finally
    fSafe.UnLock;
  end;
end;

function TJSONSerializerRegisteredCollection.Find(aCollClassName: PUTF8Char;
  aCollClassNameLen: integer): TCollectionItemClass;
var i: integer;
begin
  result := nil;
  fSafe.Lock;
  try
    for i := 0 to (Count shr 1)-1 do
      // new TObject.ClassName is UnicodeString (since Delphi 20009) -> inline code
      // with vmtClassName = UTF-8 encoded text stored in a shortstring = -44
      if IdemPropName(PShortString(PPointer(PtrInt(PtrUInt(List[i*2]))+vmtClassName)^)^,
          aCollClassName,aCollClassNameLen) then begin
        result := List[i*2+1];
        exit;
      end;
  finally
    fSafe.UnLock;
  end;
end;

var
  JSONSerializerRegisteredCollection: TJSONSerializerRegisteredCollection=nil;

class procedure TJSONSerializer.RegisterCollectionForJSON(aCollection: TCollectionClass;
  aItem: TCollectionItemClass);
begin
  if JSONSerializerRegisteredCollection=nil then
    GarbageCollectorFreeAndNil(JSONSerializerRegisteredCollection,
      TJSONSerializerRegisteredCollection.Create);
  JSONSerializerRegisteredCollection.AddOnce(aCollection,aItem);
  RegisterClassForJSON([aCollection,aItem]);
end;

{$endif LVCL}

class procedure TJSONSerializer.RegisterClassForJSON(aItemClass: TClass);
begin
  if JSONSerializerRegisteredClass=nil then
    GarbageCollectorFreeAndNil(JSONSerializerRegisteredClass,
      TJSONSerializerRegisteredClass.Create);
  JSONSerializerRegisteredClass.AddOnce(aItemClass);
end;

class procedure TJSONSerializer.RegisterClassForJSON(const aItemClass: array of TClass);
var i: integer;
begin
  for i := 0 to high(aItemClass) do
    RegisterClassForJSON(aItemClass[i]);
end;

class procedure TJSONSerializer.RegisterObjArrayForJSON(aDynArray: PTypeInfo;
  aItem: TClass; aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
var serializer: ^TObjArraySerializer;
begin
  if (aItem=nil) or (aDynArray^.DynArrayItemSize<>SizeOf(TObject)) then
    raise EModelException.CreateUTF8(
      'Invalid %.RegisterObjArrayForJSON(TypeInfo(%),%)',[self,aDynArray^.Name,aItem]);
  if ObjArraySerializers=nil then
    GarbageCollectorFreeAndNil(ObjArraySerializers,TPointerClassHash.Create);
  serializer := pointer(ObjArraySerializers.TryAdd(aDynArray));
  if serializer=nil then
    exit; // avoid duplicate
  serializer^ := TObjArraySerializer.Create(aDynArray,aItem,aReader,aWriter);
  TTextWriter.RegisterCustomJSONSerializer(
    aDynArray,serializer^.CustomReader,serializer^.CustomWriter);
end;

class function TJSONSerializer.RegisterObjArrayFindType(aDynArray: PTypeInfo): PClassInstance;
var serializer: TPointerClassHashed;
begin
  serializer := ObjArraySerializers.Find(aDynArray);
  if serializer=nil then
    result := nil else
    result := @TObjArraySerializer(serializer).Instance;
end;

class function TJSONSerializer.RegisterObjArrayFindTypeInfo(aClass: TClass): PTypeInfo;
var i: integer;
    item: ^TObjArraySerializer;
begin
  item := pointer(ObjArraySerializers.List);
  for i := 1 to ObjArraySerializers.Count do
    if item^.Instance.ItemClass=aClass then begin
      result := item^.fInfo;
      exit;
    end else
    inc(item);
  result := nil;
end;

class procedure TJSONSerializer.RegisterObjArrayForJSON(
  const aDynArrayClassPairs: array of const);
var n,i: integer;
begin
  n := length(aDynArrayClassPairs);
  if (n=0) or (n and 1=1) then
    exit;
  n := n shr 1;
  if n=0 then
    exit;
  for i := 0 to n-1 do
    if (aDynArrayClassPairs[i*2].VType<>vtPointer) or
       (aDynArrayClassPairs[i*2+1].VType<>vtClass) then
      raise EParsingException.Create('RegisterObjArrayForJSON[?]') else
      RegisterObjArrayForJSON(
        aDynArrayClassPairs[i*2].VPointer,aDynArrayClassPairs[i*2+1].VClass);
end;

function JSONToNewObject(var From: PUTF8Char; var Valid: boolean;
  Options: TJSONToObjectOptions): TObject;
var ItemClass: TClass;
    ItemInstance: TClassInstance;
begin
  Valid := false;
  result := nil;
  if From=nil then
    exit;
  while From^ in [#1..' '] do inc(From);
  if PInteger(From)^=NULL_LOW then begin
    Valid := true;
    exit;
  end;
  if From^<>'{' then
    exit; // input should be either null, either {"ClassName":"TMyClass",...}
  ItemClass := JSONSerializerRegisteredClass.Find(From,true);
  if ItemClass=nil then
    exit; // unknown type
  ItemInstance.Init(ItemClass);
  result := ItemInstance.CreateNew;
  From := JSONToObject(result,From,Valid,nil,Options);
  if not Valid then
    FreeAndNil(result); // avoid memory leak
end;

function PropIsIDTypeCastedField(Prop: PPropInfo; IsObj: TJSONObject;
  Value: TObject): boolean;
begin // see [22ce911c715]
  if (Value<>nil) and (Prop^.PropType^.ClassSQLFieldType=sftID) then
    case IsObj of
    oSQLMany:
      if IdemPropName(Prop^.Name,'source') or IdemPropName(Prop^.Name,'dest') then
        result := true else
        result := not TSQLRecord(Value).fFill.JoinedFields;
    oSQLRecord:
      result := not TSQLRecord(Value).fFill.JoinedFields;
    else result := false; // real instance for regular classes
    end else
    result := false; // assume real instance by default
end;

type
  /// wrapper object to ease JSONToObject() maintainability
  TJSONToObject = object
  public
    // input parameters
    From: PUTF8Char;
    Value: TObject;
    Options: TJSONToObjectOptions;
    TObjectListItemClass: TClass;
    // output parameters
    Dest: PUTF8Char;
    Valid: boolean;
    procedure Parse;
  private
    ValueClass: TClass;
    parser: PJSONCustomParser;
    PropName, PropValue: PUTF8Char;
    PropNameLen, PropValueLen: integer;
    P: PPropInfo;
    IsObj: TJSONObject;
    Kind: TTypeKind;
    EndOfObject: AnsiChar;
    NestedValid, wasString: boolean;
    {$ifndef NOVARIANTS}
    procedure HandleVariant;
    {$endif}
    procedure HandleObjectList(Lst: TObjectList);
    {$ifndef LVCL}
    procedure HandleCollection(Coll: TCollection);
    {$endif}
    procedure HandleStrings(Str: TStrings);
    procedure HandleUtfs(utf: TRawUTF8List);
    procedure HandleProperty(var tmp: RawUTF8);
  end;

function JSONToObject(var ObjectInstance; From: PUTF8Char; out Valid: boolean;
  TObjectListItemClass: TClass; Options: TJSONToObjectOptions): PUTF8Char;
var parser: TJSONToObject;
begin
  parser.From := From;
  parser.Options := Options;
  parser.TObjectListItemClass := TObjectListItemClass;
  parser.Value := TObject(ObjectInstance);
  parser.Parse;
  Valid := parser.Valid;
  TObject(ObjectInstance) := parser.Value; // e.g. 'null' -> FreeAndNil()
  result := parser.Dest;
end;

function JSONSettingsToObject(var InitialJsonContent: RawUTF8; Instance: TObject): boolean;
var tmp: TSynTempBuffer;
begin
  result := false;
  if InitialJsonContent='' then
    exit;
  tmp.Init(InitialJsonContent);
  try
    RemoveCommentsFromJSON(tmp.buf);
    JSONToObject(Instance,tmp.buf,result,nil,JSONTOOBJECT_TOLERANTOPTIONS);
    if not result then
      InitialJsonContent := '';
  finally
    tmp.Done;
  end;
end;

function ObjectLoadJSON(var ObjectInstance; const JSON: RawUTF8;
  TObjectListItemClass: TClass; Options: TJSONToObjectOptions): boolean;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  if tmp.len<>0 then
    try
      JSONToObject(ObjectInstance,tmp.buf,result,TObjectListItemClass,Options);
    finally
      tmp.Done;
    end else
    result := false;
end;

procedure TJSONToObject.HandleObjectList(Lst: TObjectList);
var Item: TObject;
    ItemClass: TClass;
    ItemInstance: TClassInstance;
begin
  Lst.Clear;
  ItemInstance.ItemClass := nil;
  repeat
    while From^ in [#1..' '] do inc(From);
    case From^ of
    #0: exit;
    ']': begin
      inc(From);
      break;
    end;
    ',':
      inc(From); // valid delimiter between objects
    '{': begin
      Dest := From;
      if TObjectListItemClass=nil then begin // recognize "ClassName":...
        ItemClass := JSONSerializerRegisteredClass.Find(From,true);
        if ItemClass=nil then
          exit; // unknown "ClassName":.. type
      end else
        ItemClass := TObjectListItemClass;
      if ItemInstance.ItemClass<>ItemClass then
        ItemInstance.Init(ItemClass);
      Item := ItemInstance.CreateNew;
      From := JSONToObject(Item,From,NestedValid,nil,Options);
      if not NestedValid then begin
        Dest := From;
        exit;
      end else
      if From=nil then
        exit;
      Lst.Add(Item);
    end;
    else exit;
    end;
  until false;
  // only way of being here is to have an ending ] at expected place
  Valid := true;
end;

{$ifndef LVCL}
procedure TJSONToObject.HandleCollection(Coll: TCollection);
var CollItem: TObject;
begin
  Coll.BeginUpdate;
  try
    Coll.Clear;
    repeat
      while From^ in [#1..' '] do inc(From);
      case From^ of
      #0: exit;
      ']': begin
        inc(From);
        break;
      end;
      ',':
        inc(From); // valid delimiter between objects
      '{': begin
        Dest := From;
        CollItem := Coll.Add;
        From := JSONToObject(CollItem,From,NestedValid,nil,Options);
        if not NestedValid then begin
          Dest := From;
          exit;
        end else
        if From=nil then
          exit;
      end;
      else exit;
      end;
    until false;
    // only way of being here is to have an ending ] at expected place
    Valid := true;
  finally
    Coll.EndUpdate;
  end;
end;
{$endif}

procedure TJSONToObject.HandleStrings(Str: TStrings);
var s: string;
begin
  {$ifndef LVCL}
  Str.BeginUpdate; // Str: TStrings absolute Value
  try
  {$endif}
    Str.Clear;
    repeat
      while From^ in [#1..' '] do inc(From);
      case From^ of
      #0: exit;
      ']': begin
        inc(From);
        break;
      end;
      '"': begin
        Dest := From;
        PropValue := GetJSONField(From,From,@wasString,@EndOfObject,@PropValueLen);
        if (PropValue=nil) or not wasString then
          exit;
        UTF8DecodeToString(PropValue,PropValueLen,s);
        Str.Add(s);
        case EndOfObject of
          ']': break;
          ',': continue;
          else exit;
        end;
      end;
      else exit;
      end;
    until false;
    Valid := true;
  {$ifndef LVCL}
  finally
    Str.EndUpdate;
  end;
  {$endif}
end;

procedure TJSONToObject.HandleUtfs(utf: TRawUTF8List);
var U: RawUTF8;
begin
  utf.BeginUpdate;
  try
    utf.Clear;
    repeat
      while From^ in [#1..' '] do inc(From);
      case From^ of
      #0: exit;
      ']': begin
        inc(From);
        break;
      end;
      '"': begin
        Dest := From;
        PropValue := GetJSONField(From,From,@wasString,@EndOfObject,@PropValueLen);
        if (PropValue=nil) or not wasString then
          exit;
        FastSetString(U,PropValue,PropValueLen);
        utf.Add(U);
        case EndOfObject of
          ']': break;
          ',': if From=nil then exit else continue;
          else exit;
        end;
      end;
      else exit;
      end;
    until false;
    Valid := true;
  finally
    utf.EndUpdate;
  end;
end;

{$ifndef NOVARIANTS}
procedure TJSONToObject.HandleVariant;
var temp: variant;
    opt: TDocVariantOptions;
begin
  if j2oHandleCustomVariants in Options then begin
    if j2oHandleCustomVariantsWithinString in Options then
      opt := [dvoValueCopiedByReference,dvoAllowDoubleValue,dvoJSONObjectParseWithinString] else
      opt := [dvoValueCopiedByReference,dvoAllowDoubleValue];
    GetVariantFromJSON(PropValue,wasString,temp,@opt,false);
  end else
    GetVariantFromJSON(PropValue,wasString,temp,nil,false);
  P^.SetVariantProp(Value,temp);
end;
{$endif NOVARIANTS}

procedure TJSONToObject.HandleProperty(var tmp: RawUTF8);
var V: PtrInt;
    V64: Int64;
    D: double;
    err: integer;
begin
  PropValue := GetJSONFieldOrObjectOrArray(From,@wasString,@EndOfObject,
    {$ifdef NOVARIANTS}false{$else}Kind=tkVariant{$endif},true,@PropValueLen);
  if (PropValue=nil) or not (EndOfObject in ['}',',']) then
    exit; // invalid JSON content (null has been handled above)
  case Kind of
  tkInt64{$ifdef FPC}, tkQWord{$endif}:
    if wasString then begin
      if PropValue^=#0 then
        V64 := 0 else
        if not (j2oAllowInt64Hex in Options) or
           not HexDisplayToBin(PAnsiChar(PropValue),@V64,SizeOf(V64)) then
          exit;
      P^.SetInt64Prop(Value,V64);
    end else begin
      if P^.PropType^.IsQWord then
        V64 := GetQWord(PropValue,err) else
        V64 := GetInt64(PropValue,err);
      if err<>0 then
        exit;
      P^.SetInt64Prop(Value,V64);
    end;
  tkClass: begin
    if wasString or (P^.PropType^.ClassSQLFieldType<>sftID) then
      exit; // should have been handled above
    V := GetInteger(PropValue,err);
    if err<>0 then
      exit; // invalid value
    P^.SetOrdProp(Value,V);
  end;
  tkEnumeration: begin
    if wasString then begin // in case enum stored as string
      V := P^.PropType^.EnumBaseType^.GetEnumNameValue(PropValue,PropValueLen);
      if V<0 then
        if j2oIgnoreUnknownEnum in Options then
          V := 0 else
          exit;
    end else begin
      V := GetInteger(PropValue,err);
      if err<>0 then
        if j2oIgnoreUnknownEnum in Options then
          V := 0 else
          exit; // invalid value
    end;
    P^.SetOrdProp(Value,V);
  end;
  {$ifdef FPC} tkBool, {$endif}
  tkInteger, tkSet:
    if wasString then
      exit else begin
      // From='true' or From='false' were converted into '1 or '0'
      V := GetInteger(PropValue,err);
      if err<>0 then
        exit; // invalid value
      P^.SetOrdProp(Value,V);
    end;
  {$ifdef FPC}tkLStringOld,{$endif}{$ifdef HASVARUSTRING}tkUString,{$endif}
  tkLString,tkWString: // handle all string types from temporary RawUTF8
    if wasString or (j2oIgnoreStringType in Options) then begin
      FastSetString(tmp,PropValue,PropValueLen);
      P^.SetLongStrValue(Value,tmp);
    end else
      exit;
  {$ifdef PUBLISHRECORD}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    RecordLoadJSON(P^.GetFieldAddr(Value)^,PropValue,P^.TypeInfo);
  {$endif}
  {$ifndef NOVARIANTS}
  tkVariant:
    HandleVariant; // dedicated method for a local temporary variant
  {$endif}
  tkFloat:
    if P^.TypeInfo=TypeInfo(TDateTime) then
      if wasString then begin
        if PInteger(PropValue)^ and $ffffff=JSON_SQLDATE_MAGIC then
          inc(PropValue,3); // ignore U+FFF1 pattern
        P^.SetDoubleProp(Value,Iso8601ToDateTimePUTF8Char(PropValue,PropValueLen));
      end else
        exit else
    if wasString then
      exit else
    if P^.PropType^.FloatType=ftCurr then
      P^.SetCurrencyProp(Value,StrToCurrency(pointer(PropValue))) else begin
      D := GetExtended(pointer(PropValue),err);
      if err<>0 then
        exit else // invalid JSON content
        P^.SetFloatProp(Value,D);
    end;
    else
      exit; // unhandled type
  end;
  Dest := nil; // if we reached here, no error occured with this property
end;

procedure TJSONToObject.Parse;
var V: PtrInt;
    DynArray: TDynArray;
    U: RawUTF8;
    Beg: PAnsiChar;
begin
  Valid := false;
  Dest := From;
  if Value=nil then
    exit;
  ValueClass := PClass(Value)^;
  IsObj := JSONObjectFromClass(ValueClass,parser);
  if From=nil then begin
    case IsObj of // handle '' as Clear for arrays
    {$ifndef LVCL}
    oCollection: TCollection(Value).Clear;
    {$endif}
    oStrings:    TStrings(Value).Clear;
    oUtfs:       TRawUTF8List(Value).Clear;
    oObjectList: TObjectList(Value).Clear;
    end;
    exit;
  end;
  if PInteger(From)^=NULL_LOW then begin
    if (IsObj=oCustomReaderWriter) and Assigned(parser^.Reader) then
      // custom JSON reader expects to be executed even if value is null
      Dest := parser^.Reader(Value,From,Valid,Options) else begin
      FreeAndNil(Value);
      Dest := From+4;
      Valid := true; // null is a valid JSON object
    end;
    exit;
  end;
  while From^ in [#1..' '] do inc(From);
  if IsObj=oCustomReaderWriter then begin // may be from [array] or {object}
    if Assigned(parser^.Reader) then // leave Valid=false if Reader=nil
      Dest := parser^.Reader(Value,From,Valid,Options);
    exit;
  end;
  if From^='[' then begin
    // nested array = TObjectList, TCollection, TRawUTF8List or TStrings
    inc(From);
    case IsObj of
    oObjectList: // TList leaks memory, but TObjectList uses "ClassName":..
      HandleObjectList(TObjectList(Value));
    {$ifndef LVCL}
    oCollection:
      HandleCollection(TCollection(Value));
    {$endif}
    oStrings:
      HandleStrings(TStrings(Value));
    oUtfs:
      HandleUtfs(TRawUTF8List(Value));
    end; // case IsObj of
    // Valid=false if not TCollection, TRawUTF8List nor TStrings
    if Valid and (From<>nil) then begin
      while From^ in [#1..' '] do inc(From);
      if From^=#0 then
        From := nil;
    end;
    Dest := From;
    exit; // a JSON array begin with [
  end;
  if From^<>'{' then begin
    Dest := From;
    exit; // a JSON object MUST begin with {
  end;
  repeat inc(From) until (From^=#0) or (From^>' ');
  EndOfObject := #0;
  if From^='}' then begin
    // empty JSON object like {} (e.g. all properties having default values)
    EndOfObject := '}';
    Inc(From);
  end else
  // for each fields
  repeat
    wasString := false;
    Dest := From;
    PropName := GetJSONPropName(From,@PropNameLen);  // get property name
    if (From=nil) or (PropName=nil) then
      exit; // invalid JSON content
    if IdemPropName('ClassName',PropName,PropNameLen) then begin
      // WriteObject() was called with woStoreClassName option -> ignore it
      PropValue := GetJSONField(From,From,@wasString,@EndOfObject);
      if (PropValue=nil) or not wasString or not (EndOfObject in ['}',',']) then
        exit; // invalid JSON content
      continue;
    end;
    if IsObj in [oSQLRecord,oSQLMany] then
      if IsRowID(PropName) then begin
        // manual handling of TSQLRecord.ID property unserialization
        PropValue := GetJSONField(From,From,@wasString,@EndOfObject);
        if (PropValue=nil) or wasString or not (EndOfObject in ['}',',']) then
          exit; // invalid JSON content
        SetID(PropValue,TSQLRecord(Value).fID);
        continue;
      end;
    if IsObj=oCustomPropName then
      P := JSONCustomParsersFieldProp(ValueClass,parser,PropName,PropNameLen) else
      P := ClassFieldPropWithParentsFromUTF8(ValueClass,PropName,PropNameLen);
    if P=nil then // unknown property
      if j2oIgnoreUnknownProperty in Options then begin
        From := GotoNextJSONItem(From,1,@EndOfObject);
        continue;
      end else
        exit; // by default, abort
    Kind := P^.PropType^.Kind;
    while From^ in [#1..' '] do inc(From);
    Dest := From;
    if PInteger(From)^=NULL_LOW then begin
      // null value should set the default value, or free nested object
      if (Kind=tkClass) and (IsObj in [oSQLRecord,oSQLMany]) then
        exit; // null expects a plain TSynPersistent/TPersistent
      P^.SetDefaultValue(Value); // will set 0,'' or FreeAndNil(NestedObject)
      inc(From,4);
      while From^ in [#1..' '] do inc(From);
      EndOfObject := From^;
      if From^ in EndOfJSONField then
        inc(From);
    end else
    if (From^ in ['[','{']) {$ifndef NOVARIANTS}and (Kind<>tkVariant){$endif} then begin
      if Kind=tkDynArray then begin
        P^.GetDynArray(Value,DynArray);
        From := DynArray.LoadFromJSON(From);
        if From=nil then
          exit; // invalid '[dynamic array]' content
      end else
      if P^.TypeInfo=TypeInfo(RawJSON) then begin
        Beg := pointer(From);
        From := GotoNextJSONObjectOrArray(From);
        if From=nil then
          exit;
        FastSetString(U,Beg,From-Beg);
        P^.SetLongStrProp(Value,U);
      end else
      if (Kind=tkSet) and (From^='[') then begin // set as string array
        V := GetSetNameValue(P^.TypeInfo,From,EndOfObject);
        if From=nil then
          exit; // invalid '["setone","settwo"]' content
          P^.SetOrdProp(Value,V);
        if EndOfObject='}' then
          break else
          continue;
      end else
      if (Kind in tkRecordTypes) and (From^='{') then begin // from Delphi XE5+
        From := RecordLoadJSON(P^.GetFieldAddr(Value)^,From,P^.TypeInfo,@EndOfObject);
        if From=nil then
          exit; // invalid '{record}' content
        if EndOfObject='}' then
          break else
          continue;
      end else begin
        if Kind<>tkClass then
          exit; // true nested object should begin with '[' or '{'
        if PropIsIDTypeCastedField(P,IsObj,Value) then
          exit; // only TSQLRecordMany/joined properties are true instances
        // will handle '[TCollection...' '[TStrings...' '{TObject...'
        From := P^.ClassFromJSON(Value,From,NestedValid,Options);
        if not NestedValid then begin
          Dest := From;
          exit;
        end else
        if From=nil then
          exit; // invalid JSON content: we expect at least a last '}'
      end;
      while From^ in [#1..' '] do inc(From);
      EndOfObject := From^;
      if From^ in EndOfJSONField then
        inc(From);
    end else begin
      HandleProperty(U);
      if Dest<>nil then
        exit; // an error occured
    end;
  until (From=nil) or (EndOfObject='}');
  if IsObj=oSynAutoCreateFields then
    TSynAutoCreateFields(Value).AfterLoad;
  if From<>nil then begin
    while From^ in [#1..' '] do inc(From);
    if From^=#0 then
      From := nil;
  end;
  Valid := (EndOfObject='}'); // mark parsing success
  Dest := From;
end;

function UrlDecodeObject(U: PUTF8Char; Upper: PAnsiChar; var ObjectInstance;
  Next: PPUTF8Char; Options: TJSONToObjectOptions): boolean;
var tmp: RawUTF8;
begin
  result := UrlDecodeValue(U,Upper,tmp,Next);
  if result then
    JSONToObject(ObjectInstance,Pointer(tmp),result,nil,Options);
end;

function JSONFileToObject(const JSONFile: TFileName; var ObjectInstance;
  TObjectListItemClass: TClass; Options: TJSONToObjectOptions): boolean;
var tmp: RawUTF8;
begin
  tmp := AnyTextFileToRawUTF8(JSONFile,true);
  if tmp='' then
    result := false else begin
    RemoveCommentsFromJSON(pointer(tmp));
    JSONToObject(ObjectInstance,pointer(tmp),result,TObjectListItemClass,Options);
  end;
end;

function ObjectToJSONFile(Value: TObject; const JSONFile: TFileName;
  Options: TTextWriterWriteObjectOptions): boolean;
var humanread: boolean;
    json: RawUTF8;
begin
  humanread := woHumanReadable in Options;
  if humanread and (woHumanReadableEnumSetAsComment in Options) then
    humanread := false else  // JsonReformat() erases comments
    Exclude(Options,woHumanReadable);
  json := ObjectToJSON(Value,Options);
  if humanread then
    // woHumanReadable not working with custom JSON serializers, e.g. T*ObjArray
    result := JSONBufferReformatToFile(pointer(json),JSONFile) else
    result := FileFromString(json,JSONFile);
end;

procedure ReadObject(Value: TObject; From: PUTF8Char; const SubCompName: RawUTF8);
var CT: TClass;
    P: PPropInfo;
    i: integer;
    Obj: TObject;
    U: RawUTF8;
    UpperName: array[byte] of AnsiChar;
begin
  if Value=nil then // allow From=nil -> default values
    exit;
  CT := Value.ClassType;
  repeat
    for i := 1 to InternalClassPropInfo(CT,P) do begin
      PWord(UpperCopyShort(UpperCopy255(UpperName,SubCompName),P^.Name))^ := ord('=');
      U := FindIniNameValue(From,UpperName);
      if P^.PropType^.Kind=tkClass then begin // recursive unserialization
        Obj := P^.GetObjProp(Value);
        if (Obj<>nil) and ClassHasPublishedFields(PPointer(Obj)^)  then
          ReadObject(Obj,From,SubCompName+ToUTF8(P^.Name)+'.');
      end else
        P^.SetFromText(Value,U,@JSON_OPTIONS[true],{allowdouble=}true);
      P := P^.Next;
    end;
    CT := GetClassParent(CT);
  until CT=TObject;
end;

procedure ReadObject(Value: TObject; const FromContent,SubCompName: RawUTF8);
var source: PUTF8Char;
    UpperSection: array[byte] of AnsiChar;
begin
  if Value=nil then
    exit; // avoid GPF
  PWord(UpperCopyShort(UpperSection,ClassNameShort(Value)^))^ := ord(']');
  source := pointer(FromContent);
  if FindSectionFirstLine(source,UpperSection) then
    ReadObject(Value,source,SubCompName);
end;

procedure SetDefaultValuesObject(Value: TObject);
var p: PPropInfo;
    c: TClass;
    i: integer;
begin
  if Value=nil then
    exit;
  c := Value.ClassType;
  repeat
    for i := 1 to InternalClassPropInfo(Value.ClassType,p) do begin
      case p^.PropType^.Kind of
        tkEnumeration,tkSet,tkInteger,tkChar,tkWChar{$ifdef FPC},tkBool{$endif}:
          if p^.Default<>NO_DEFAULT then
            p^.SetOrdProp(Value,p^.Default);
        tkClass:
          SetDefaultValuesObject(p^.GetObjProp(Value));
      end;
      p := p^.Next;
    end;
    c := GetClassParent(c);
  until c=TObject;
end;

function IsObjectDefaultOrVoid(Value: TObject): boolean;
var i: integer;
    C: TClass;
    P: PPropinfo;
begin
  if Value<>nil then begin
    result := false;
    C := Value.ClassType;
    repeat
      for i := 1 to InternalClassPropInfo(C,P) do
        if P^.IsDefaultOrVoid(Value) then
          P := P^.Next else
          exit;
      C := GetClassParent(C);
    until C=TObject;
  end;
  result := true;
end;

procedure ClearObject(Value: TObject; FreeAndNilNestedObjects: boolean=false);
var p: PPropInfo;
    c: TClass;
    i: integer;
begin
  if Value=nil then
    exit;
  c := Value.ClassType;
  repeat
    for i := 1 to InternalClassPropInfo(c,p) do begin
      p^.SetDefaultValue(Value,FreeAndNilNestedObjects);
      p := p^.Next;
    end;
    c := GetClassParent(c);
  until c=TObject;
end;


{ TClassInstance }

procedure TClassInstance.Init(C: TClass);
begin
  ItemClass := C;
  if C<>nil then
  repeat // this unrolled loop is faster than cascaded if C.InheritsFrom()
    if C<>TSQLRecord then
    if C<>TObjectList then
    if C<>TInterfacedObjectWithCustomCreate then
    if C<>TPersistentWithCustomCreate then
    if C<>TSynPersistent then
    if C<>TComponent then
    {$ifndef LVCL}
    if C<>TInterfacedCollection then
    if C<>TCollection then
    if C<>TCollectionItem then
    {$endif LVCL}
    begin
      {$ifdef FPC}
      C := GetClassParent(C);
      {$else}
      C := PPointer(PtrInt(C)+vmtParent)^;
      if C<>nil then
        C := PPointer(C)^;
      {$endif FPC}
      if C<>nil then
        continue else begin
        ItemCreate := cicTObject;
        exit;
      end;
    end else
    {$ifndef LVCL}
    begin
      ItemCreate := cicTCollectionItem;
      exit;
    end else begin // plain TCollection shall have been registered
      CollectionItemClass := JSONSerializerRegisteredCollection.Find(TCollectionClass(ItemClass));
      if CollectionItemClass<>nil then begin
        ItemCreate := cicTCollection;
        exit;
      end else
        raise EParsingException.CreateUTF8('% shall inherit from TInterfacedCollection'+
         ' or call TJSONSerializer.RegisterCollectionForJSON()',[ItemClass]);
    end else begin
      ItemCreate := cicTInterfacedCollection;
      exit;
    end else
    {$endif LVCL}
    begin
      ItemCreate := cicTComponent;
      exit;
    end else begin
      ItemCreate := cicTSynPersistent;
      exit;
    end else begin
      ItemCreate := cicTPersistentWithCustomCreate;
      exit;
    end else begin
      ItemCreate := cicTInterfacedObjectWithCustomCreate;
      exit;
    end else begin
      ItemCreate := cicTObjectList;
      exit;
    end else begin
      ItemCreate := cicTSQLRecord;
      exit;
    end;
  until false;
  ItemCreate := cicUnknown;
end;

function TClassInstance.CreateNew: TObject;
begin
  if @self<>nil then
  case ItemCreate of
    cicUnknown: begin
      result := nil;
      exit;
    end;
    cicTSQLRecord: begin
      result := TSQLRecordClass(ItemClass).Create;
      exit;
    end;
    cicTObjectList: begin
      result := TObjectList.Create;
      exit;
    end;
    cicTPersistentWithCustomCreate: begin
      result := TPersistentWithCustomCreateClass(ItemClass).Create;
      exit;
    end;
    cicTComponent: begin
      result := TComponentClass(ItemClass).Create(nil);
      exit;
    end;
    cicTSynPersistent: begin
      result := TSynPersistentClass(ItemClass).Create;
      exit;
    end;
    cicTInterfacedObjectWithCustomCreate: begin
      result := TInterfacedObjectWithCustomCreateClass(ItemClass).Create;
      exit;
    end;
    {$ifndef LVCL}
    cicTInterfacedCollection: begin
      result := TInterfacedCollectionClass(ItemClass).Create;
      exit;
    end;
    cicTCollection: begin
      result := TCollectionClass(ItemClass).Create(CollectionItemClass);
      exit;
    end;
    cicTCollectionItem: begin
      result := TCollectionItemClass(ItemClass).Create(nil);
      exit;
    end;
    {$endif}
    cicTObject: begin
      result := ItemClass.Create;
      exit;
    end;
    else begin
      result := nil;
      exit;
    end;
  end else begin
    result := nil;
    exit;
  end;
end;

procedure TClassInstance.SetCustomComment(var CustomComment: RawUTF8);
begin
  FormatUTF8('array of {%}',[ClassFieldNamesAllPropsAsText(ItemClass,true)],
    CustomComment);
end;

{$ifdef MSWINDOWS}

{ TSQLRestClientURIMessage }

constructor TSQLRestClientURIMessage.Create(aModel: TSQLModel;
  const ServerWindowName: string; ClientWindow: HWND; TimeOutMS: cardinal);
begin
  inherited Create(aModel);
  fClientWindow := ClientWindow;
  fServerWindowName := ServerWindowName;
  fTimeOutMS := TimeOutMS;
end;

constructor TSQLRestClientURIMessage.Create(aModel: TSQLModel;
  const ServerWindowName, ClientWindowName: string; TimeOutMS: cardinal);
var H: HWND;
begin
  H := CreateInternalWindow(ClientWindowName,self);
  if H=0 then
    raise ECommunicationException.CreateUTF8('%.Create(): CreateInternalWindow("%")',
      [self,ClientWindowName]);
  fClientWindowName := ClientWindowName;
  Create(aModel,ServerWindowName,H,TimeOutMS);
end;

destructor TSQLRestClientURIMessage.Destroy;
begin
  try
    inherited Destroy;
  finally
    ReleaseInternalWindow(fClientWindowName,fClientWindow);
  end;
end;

procedure TSQLRestClientURIMessage.DefinitionTo(Definition: TSynConnectionDefinition);
begin
  if Definition=nil then
    exit;
  inherited DefinitionTo(Definition); // save Kind + User/Password
  Definition.ServerName := StringToUTF8(fServerWindowName);
  Definition.DatabaseName := StringToUTF8(fClientWindowName);
end;

constructor TSQLRestClientURIMessage.RegisteredClassCreateFrom(aModel: TSQLModel;
  aDefinition: TSynConnectionDefinition);
begin
  Create(aModel,UTF8ToString(aDefinition.ServerName),
    UTF8ToString(aDefinition.DatabaseName),10000);
  inherited RegisteredClassCreateFrom(aModel,aDefinition); // call SetUser()
end;

procedure TSQLRestClientURIMessage.InternalURI(var Call: TSQLRestURIParams);
var Msg: RawUTF8;
    Data: TCopyDataStruct;
    Finished64: Int64;
    P: PUTF8Char;
    aMsg: TMsg;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  {$ifdef WITHLOG}
  log := fLogClass.Enter(self, 'InternalURI');
  {$endif}
  if (fClientWindow=0) or not InternalCheckOpen then begin
    Call.OutStatus := HTTP_NOTIMPLEMENTED; // 501
    InternalLog('InternalCheckOpen failure',sllClient);
    exit;
  end;
  // 1. send request
  // #1 is a field delimiter below, since Get*Item() functions return nil for #0
  FastSetString(Msg,@MAGIC_SYN,4);
  Msg := Msg+Call.Url+#1+Call.Method+#1+Call.InHead+#1+Call.InBody;
  Data.dwData := fClientWindow;
  Data.cbData := length(Msg)*SizeOf(Msg[1]);
  Data.lpData := pointer(Msg);
  fSafe.Enter;
  try
    fCurrentResponse := #0; // mark expect some response
    Call.OutStatus := SendMessage(fServerWindow,WM_COPYDATA,fClientWindow,PtrInt(@Data));
    if not StatusCodeIsSuccess(Call.OutStatus) then begin
      fCurrentResponse := '';
      with Call do
        InternalLog('% % status=%',[Method,Url,OutStatus],sllError);
      exit;
    end;
    // 2. expect answer from server
    if fCurrentResponse=#0 then begin
      // in practice, we never reach here since SendMessage() did wait for the
      // message to be processed by the receiver, so the Server should have
      // already answered and fCurrentResponse field should have been set
      Finished64 := GetTickCount64+fTimeOutMS;
      repeat
        // incoming WM_COPYDATA will set fCurrentResponse in WMCopyData() method
        if not DoNotProcessMessages then
          while PeekMessage(aMsg,0,0,0,PM_REMOVE) do begin
            TranslateMessage(aMsg);
            DispatchMessage(aMsg);
          end;
        SleepHiRes(0);
        if GetTickCount64>Finished64 then begin
          Call.OutStatus := HTTP_TIMEOUT; // 408 Request Timeout Error
          exit;
        end;
      until fCurrentResponse<>#0;
    end;
    // 3. return answer to caller
    if length(fCurrentResponse)<=SizeOf(Int64) then
      Call.OutStatus := HTTP_NOTIMPLEMENTED else begin
      P := pointer(fCurrentResponse);
      if PCardinal(P)^<>MAGIC_SYN then // broadcasted WM_COPYDATA message? :(
        Call.OutStatus := 0 else begin
        Call.OutStatus := PIntegerArray(P)[1];
        Call.OutInternalState := PIntegerArray(P)[2];
        inc(P,SizeOf(integer)*3);
      end;
      if Call.OutStatus=0 then
        Call.OutStatus := HTTP_NOTFOUND else begin
        GetNextItem(P,#1,Call.OutHead);
        if P<>nil then
          SetString(Call.OutBody,P,length(fCurrentResponse)-(P-pointer(fCurrentResponse)));
      end;
    end;
  finally
    fSafe.Leave;
  end;
  with Call do
    InternalLog('% % status=% state=%',[Method,Url,OutStatus,OutInternalState],sllClient);
end;

procedure TSQLRestClientURIMessage.WMCopyData(var Msg: TWMCopyData);
begin
  if (self=nil) or (Msg.From<>fServerWindow) or
     (PCopyDataStruct(Msg.CopyDataStruct)^.dwData<>fServerWindow) then
    exit;
  Msg.Result := HTTP_SUCCESS; // Send something back
  if fCurrentResponse=#0 then // expect some response?
    FastSetString(fCurrentResponse,PCopyDataStruct(Msg.CopyDataStruct)^.lpData,
      PCopyDataStruct(Msg.CopyDataStruct)^.cbData);
end;

function TSQLRestClientURIMessage.InternalCheckOpen: boolean;
begin
  fSafe.Enter;
  try
    if fServerWindow<>0 then begin
      result := true;
      exit; // only reconnect if forced by InternalClose call or at first access
    end;
    fServerWindow := FindWindow(pointer(fServerWindowName),nil);
    result := fServerWindow<>0;
  finally
    fSafe.Leave;
  end;
end;

procedure TSQLRestClientURIMessage.InternalClose;
begin
  fServerWindow := 0;
end;


{$endif}


{ TSQLRecordSigned }

function TSQLRecordSigned.ComputeSignature(const UserName,Content: RawByteString): RawUTF8;
var SHA: TSHA256;
    Digest: TSHA256Digest;
begin
  SHA.Init;
  SHA.Update(TTimeLogBits(fSignatureTime).Text(false));
  SHA.Update(ToText(ClassType));
  SHA.Update(UserName);
  SHA.Update(Content);
  SHA.Final(Digest);
  result := SHA256DigestToString(Digest);
end;

function TSQLRecordSigned.CheckSignature(const Content: RawByteString): boolean;
var i: integer;
    sign: RawUTF8;
begin
  result := false;
  if self=nil then
    exit;
  i := PosExChar('/',fSignature);
  if i=0 then
    exit;
  sign := ComputeSignature(copy(fSignature,1,i-1),Content);
  if IdemPropNameU(sign,copy(fSignature,i+1,SizeOf(TSHA256Digest)*2)) then
    result := true;
end;

function TSQLRecordSigned.SetAndSignContent(const UserName: RawUTF8;
  const Content: RawByteString; ForcedSignatureTime: Int64): boolean;
begin
  result := (fSignature='') and (fSignatureTime=0);
  if not result then
    exit; // sign is allowed only once
  if ForcedSignatureTime<>0 then
    fSignatureTime := ForcedSignatureTime else
    fSignatureTime := TimeLogNow;
  fSignature := UserName+'/'+ComputeSignature(UserName,Content);
end;

function TSQLRecordSigned.SignedBy: RawUTF8;
var i: integer;
begin
  if self=nil then
    i := 0 else
    i := PosExChar('/',fSignature);
  if i=0 then
    result := '' else
    result := copy(fSignature,1,i-1);
end;

procedure TSQLRecordSigned.UnSign;
begin
  fSignature := '';
  fSignatureTime := 0;
end;


{ TSQLRecordInterfaced }

class function TSQLRecordInterfaced.NewInstance: TObject;
begin
  result := inherited NewInstance;
  TSQLRecordInterfaced(result).fRefCount := 1;
end;

procedure TSQLRecordInterfaced.AfterConstruction;
{$ifdef PUREPASCAL}
begin
  InterlockedDecrement(fRefCount); // fRefCount=1 in NewInstance
end;
{$else}
{$ifdef FPC} nostackframe; assembler; {$endif} asm
  lock dec [eax].TInterfacedObject.fRefCount
end;
{$endif}

procedure TSQLRecordInterfaced.BeforeDestruction;
begin
  if fRefCount<>0 then
    System.Error(reInvalidPtr);
end;

{$ifdef FPC}
function TSQLRecordInterfaced.QueryInterface(
  {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): longint;
{$else}
function TSQLRecordInterfaced.QueryInterface(const IID: TGUID; out Obj): HResult;
{$endif}
begin
  if GetInterface(IID,Obj) then
    result := 0 else
    result := {$ifdef FPC}longint{$endif}(E_NOINTERFACE);
end;

function TSQLRecordInterfaced._AddRef: {$ifdef FPC}longint{$else}integer{$endif};
begin
  result := InterlockedIncrement(fRefCount);
end;

function TSQLRecordInterfaced._Release: {$ifdef FPC}longint{$else}integer{$endif};
begin
  result := InterlockedDecrement(fRefCount);
  if result=0 then
    Destroy;
end;


{ TSQLRecordFTS3 }

class function TSQLRecordFTS3.OptimizeFTS3Index(Server: TSQLRestServer): boolean;
begin
  if (self=nil) or (Server=nil) then
    Result:= false else
    with RecordProps do
      Result := Server.ExecuteFmt('INSERT INTO %(%) VALUES(''optimize'');',
        [SQLTableName,SQLTableName]);
end;


{ TSQLRecordFTS4 }

class procedure TSQLRecordFTS4.InitializeTable(Server: TSQLRestServer;
  const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
var Props: TSQLModelRecordProperties;
    main,fts,ftsfields: RawUTF8;
begin
  inherited;
  if FieldName<>'' then
    exit;
  Props := Server.Model.Props[self];
  if (Props=nil) or (Props.fFTSWithoutContentFields='') then
    exit;
  main := Server.Model.Tables[Props.fFTSWithoutContentTableIndex].SQLTableName;
  if not Server.IsInternalSQLite3Table(Props.fFTSWithoutContentTableIndex) then begin
    Server.InternalLog('% is an external content FTS4/5 table but source % is not '+
      'a local SQLite3 table: FTS search will be unavailable',[self,main],sllWarning);
    exit;
  end;
  fts := Props.Props.SQLTableName;
  ftsfields := Props.Props.SQLTableSimpleFieldsNoRowID;
  // see http://www.sqlite.org/fts3.html#*fts4content
  if Props.Kind=rFTS5 then begin
    // In fts 5 we can't use docid only rowid, also use insert() values('delete',) to delete record
    Server.ExecuteFmt('CREATE TRIGGER %_bu BEFORE UPDATE ON % '+
      'BEGIN INSERT INTO %(%,rowid,%) VALUES(''delete'',old.rowid%); END;',
      [main,main,fts,fts,ftsfields, StringReplaceAll(Props.fFTSWithoutContentFields, 'new.', 'old.')]);
    Server.ExecuteFmt('CREATE TRIGGER %_bd BEFORE DELETE ON % '+
      'BEGIN INSERT INTO %(%,rowid,%) VALUES(''delete'',old.rowid%); END;',
      [main,main,fts,fts,ftsfields, StringReplaceAll(Props.fFTSWithoutContentFields, 'new.', 'old.')]);
    Server.ExecuteFmt('CREATE TRIGGER %_au AFTER UPDATE ON % '+
      'BEGIN INSERT INTO %(rowid,%) VALUES(new.rowid%); END;',
      [main,main,fts,ftsfields,Props.fFTSWithoutContentFields]);
    Server.ExecuteFmt('CREATE TRIGGER %_ai AFTER INSERT ON % '+
      'BEGIN INSERT INTO %(rowid,%) VALUES(new.rowid%); END;',
      [main,main,fts,ftsfields,Props.fFTSWithoutContentFields]);
  end else begin
    Server.ExecuteFmt('CREATE TRIGGER %_bu BEFORE UPDATE ON % '+
      'BEGIN DELETE FROM % WHERE docid=old.rowid; END;',
      [main,main,fts]);
    Server.ExecuteFmt('CREATE TRIGGER %_bd BEFORE DELETE ON % '+
      'BEGIN DELETE FROM % WHERE docid=old.rowid; END;',
      [main,main,fts]);
    Server.ExecuteFmt('CREATE TRIGGER %_au AFTER UPDATE ON % '+
      'BEGIN INSERT INTO %(docid,%) VALUES(new.rowid%); END;',
      [main,main,fts,ftsfields,Props.fFTSWithoutContentFields]);
    Server.ExecuteFmt('CREATE TRIGGER %_ai AFTER INSERT ON % '+
      'BEGIN INSERT INTO %(docid,%) VALUES(new.rowid%); END;',
      [main,main,fts,ftsfields,Props.fFTSWithoutContentFields]);
  end;
end;


{ TSQLRecordRTreeAbstract }

class function TSQLRecordRTreeAbstract.RTreeSQLFunctionName: RawUTF8;
begin
  result := RecordProps.SQLTableName+'_in';
end;

{ TSQLRecordRTree }

class procedure TSQLRecordRTree.BlobToCoord(const InBlob;
  var OutCoord: TSQLRecordTreeCoords);
begin // direct memory copy with no memory check
  MoveFast(InBlob,OutCoord,(RecordProps.RTreeCoordBoundaryFields shr 1)*SizeOf(double));
end;

class function TSQLRecordRTree.ContainedIn(const BlobA,BlobB): boolean;
var A, B: TSQLRecordTreeCoords;
    i: integer;
begin
  BlobToCoord(BlobA,A);
  BlobToCoord(BlobB,B);
  result := false;
  for i := 0 to (RecordProps.RTreeCoordBoundaryFields shr 1)-1 do
    if (A[i].max<B[i].min) or (A[i].min>B[i].max) then
      exit; // no match
  result := true; // box match
end;

{ TSQLRecordRTreeInteger }

class procedure TSQLRecordRTreeInteger.BlobToCoord(const InBlob;
  var OutCoord: TSQLRecordTreeCoordsInteger);
begin // direct memory copy with no memory check
  MoveFast(InBlob,OutCoord,(RecordProps.RTreeCoordBoundaryFields shr 1)*SizeOf(integer));
end;

class function TSQLRecordRTreeInteger.ContainedIn(const BlobA,BlobB): boolean;
var A,B: TSQLRecordTreeCoordsInteger;
    i: integer;
begin
  BlobToCoord(BlobA,A);
  BlobToCoord(BlobB,B);
  result := false;
  for i := 0 to (RecordProps.RTreeCoordBoundaryFields shr 1)-1 do
    if (A[i].max<B[i].min) or (A[i].min>B[i].max) then
      exit; // no match
  result := true; // box match
end;


{ TSQLRecordMany }

constructor TSQLRecordMany.Create;
begin
  inherited Create;
  with RecordProps do
    if (fRecordManySourceProp<>nil) and (fRecordManyDestProp<>nil) then begin
      fSourceID := fRecordManySourceProp.GetFieldAddr(Self);
      fDestID := fRecordManyDestProp.GetFieldAddr(Self);
    end;
end;

function TSQLRecordMany.ManyAdd(aClient: TSQLRest; aSourceID, aDestID: TID;
  NoDuplicates: boolean; aUseBatch: TSQLRestBatch): boolean;
begin
  result := false;
  if (self=nil) or (aClient=nil) or (aSourceID=0) or (aDestID=0) or
     (fSourceID=nil) or (fDestID=nil) then
    exit; // invalid parameters
  if NoDuplicates and
     (InternalIDFromSourceDest(aClient,aSourceID,aDestID)<>0) then
      exit; // this TRecordReference pair already exists
  fSourceID^ := aSourceID;
  fDestID^ := aDestID;
  if aUseBatch<>nil then
    result := aUseBatch.Add(self,true)>=0 else
    result := aClient.Add(self,true)<>0;
end;

function TSQLRecordMany.ManyAdd(aClient: TSQLRest; aDestID: TID;
  NoDuplicates: boolean): boolean;
begin
  if (self=nil) or (fSourceID=nil) then
    result := false else // avoid GPF
    result := ManyAdd(aClient,fSourceID^,aDestID,NoDuplicates);
end;

function TSQLRecordMany.DestGet(aClient: TSQLRest; aSourceID: TID;
  out DestIDs: TIDDynArray): Boolean;
var Where: RawUTF8;
begin
  Where := IDWhereSQL(aClient,aSourceID,False);
  if Where='' then
    result := False else
    result := aClient.OneFieldValues(RecordClass,'Dest',Where,TInt64DynArray(DestIDs));
end;

function TSQLRecordMany.DestGetJoined(aClient: TSQLRest;
  const aDestWhereSQL: RawUTF8; aSourceID: TID;
  out DestIDs: TIDDynArray): boolean;
var aTable: TSQLTable;
begin
  aTable := DestGetJoinedTable(aClient,aDestWhereSQL,aSourceID,jkDestID);
  if aTable=nil then
    Result := False else
    try
      aTable.GetRowValues(0,TInt64DynArray(DestIDs));
      Result := true;
    finally
      aTable.Free;
    end;
end;

function TSQLRecordMany.DestGetJoined(aClient: TSQLRest;
  const aDestWhereSQL: RawUTF8; aSourceID: TID): TSQLRecord;
var aTable: TSQLTable;
begin
  aTable := DestGetJoinedTable(aClient,aDestWhereSQL,aSourceID,jkDestFields);
  if aTable=nil then
    Result := nil else begin
    Result := TSQLRecordClass(RecordProps.fRecordManyDestProp.ObjectClass).Create;
    aTable.OwnerMustFree := true;
    Result.FillPrepare(aTable,ctnTrimExisting);
  end;
end;

function TSQLRecordMany.DestGetJoinedTable(aClient: TSQLRest;
  const aDestWhereSQL: RawUTF8; aSourceID: TID; JoinKind: TSQLRecordManyJoinKind;
  const aCustomFieldsCSV: RawUTF8): TSQLTable;
var Select, SQL: RawUTF8;
    SelfProps, DestProps: TSQLModelRecordProperties;
procedure SelectFields(const Classes: array of TSQLModelRecordProperties);
var i: integer;
begin
  for i := 0 to high(Classes) do begin
    Select := Select+Classes[i].SQL.TableSimpleFields[True,True];
    if i<high(Classes) then
      Select := Select+',';
  end;
end;
begin
  result := nil;
  if (Self=nil) or (fSourceID=nil) or (fDestID=nil) or (aClient=nil) then
    exit;
  if aSourceID=0 then
    if fSourceID<>nil then
      aSourceID := fSourceID^;
  if aSourceID=0 then
    exit;
  SelfProps := aClient.Model.Props[PSQLRecordClass(self)^];
  DestProps := aClient.Model.Props[TSQLRecordClass(SelfProps.Props.fRecordManyDestProp.ObjectClass)];
  case JoinKind of
    jkDestID:
      Select := DestProps.Props.SQLTableName+'.RowID';
    jkPivotID:
      Select := SelfProps.Props.SQLTableName+'.RowID';
    jkDestFields:
      if aCustomFieldsCSV='' then
        SelectFields([DestProps]) else
        Select := AddPrefixToCSV(pointer(aCustomFieldsCSV),DestProps.Props.SQLTableName+'.');
    jkPivotFields:
      if aCustomFieldsCSV='' then
        SelectFields([SelfProps]) else
        Select := AddPrefixToCSV(pointer(aCustomFieldsCSV),SelfProps.Props.SQLTableName+'.');
    jkPivotAndDestFields:
      if aCustomFieldsCSV='' then
        SelectFields([SelfProps,DestProps]) else
        Select := aCustomFieldsCSV;
  end;
  if aDestWhereSQL='' then
    // fast inlined prepared statement
    SQL := 'SELECT % FROM %,% WHERE %.Source=:(%): AND %.Dest=%.RowID' else
    if PosEx(RawUTF8(':('),aDestWhereSQL,1)>0 then
      // statement is globaly inlined -> cache prepared statement
      SQL := 'SELECT % FROM %,% WHERE %.Source=:(%): AND %.Dest=%.RowID AND %' else
      // statement is not globaly inlined -> no caching of prepared statement
      SQL := 'SELECT % FROM %,% WHERE %.Source=% AND %.Dest=%.RowID AND %';
  result := aClient.ExecuteList([PSQLRecordClass(Self)^,
      TSQLRecordClass(SelfProps.Props.fRecordManyDestProp.ObjectClass)],
    FormatUTF8(SQL,
      [Select, DestProps.Props.SQLTableName,SelfProps.Props.SQLTableName,
       SelfProps.Props.SQLTableName,aSourceID, SelfProps.Props.SQLTableName,
       DestProps.Props.SQLTableName, aDestWhereSQL]));
end;

function TSQLRecordMany.DestGet(aClient: TSQLRest;
  out DestIDs: TIDDynArray): boolean;
begin
  if fSourceID=nil then
    result := false else // avoid GPF
    result := DestGet(aClient,fSourceID^,DestIDs);
   // fSourceID has been set by TSQLRecord.Create
end;

function TSQLRecordMany.ManyDelete(aClient: TSQLRest; aSourceID, aDestID: TID;
  aUseBatch: TSQLRestBatch): boolean;
var aID: TID;
begin
  result := false;
  if (self=nil) or (aClient=nil) or (aSourceID=0) or (aDestID=0) then
    exit;
  aID := InternalIDFromSourceDest(aClient,aSourceID,aDestID);
  if aID<>0 then
    if aUseBatch<>nil then
      result := aUseBatch.Delete(RecordClass,aID)>=0 else
      result := aClient.Delete(RecordClass,aID);
end;

function TSQLRecordMany.ManyDelete(aClient: TSQLRest; aDestID: TID): boolean;
begin
  if fSourceID=nil then
    result := false else // avoid GPF
    result := ManyDelete(aClient,fSourceID^,aDestID,nil);
end;

function TSQLRecordMany.ManySelect(aClient: TSQLRest; aSourceID, aDestID: TID): boolean;
begin
  if (self=nil) or (aClient=nil) or (aSourceID=0) or (aDestID=0) then
    result := false else // invalid parameters
    result := aClient.Retrieve(FormatUTF8('Source=:(%): AND Dest=:(%):',
      [aSourceID,aDestID]),Self);
end;

function TSQLRecordMany.ManySelect(aClient: TSQLRest; aDestID: TID): boolean;
begin
  if (self=nil) or (fSourceID=nil) then
    result := false else // avoid GPF
    result := ManySelect(aClient,fSourceID^,aDestID);
end;

function TSQLRecordMany.InternalFillMany(aClient: TSQLRest;
  aID: TID; const aAndWhereSQL: RawUTF8; isDest: boolean): integer;
var aTable: TSQLTable;
    Where: RawUTF8;
begin
  result := 0;
  if self=nil then
    exit;
  if not isDest and (aID=0)then
    if fSourceID<>nil then
      aID := fSourceID^; // has been set by TSQLRecord.Create
  Where := IDWhereSQL(aClient,aID,isDest,aAndWhereSQL);
  if Where='' then
    exit;
  aTable := aClient.MultiFieldValues(RecordClass,'',Where);
  if aTable=nil then
    exit;
  aTable.OwnerMustFree := true;
  FillPrepare(aTable); // temporary storage for FillRow, FillOne and FillRewind
  result := aTable.fRowCount;
end;

function TSQLRecordMany.FillMany(aClient: TSQLRest; aSourceID: TID;
  const aAndWhereSQL: RawUTF8): integer;
begin
  result := InternalFillMany(aclient,aSourceID,aAndWhereSQL,false);
end;

function TSQLRecordMany.FillManyFromDest(aClient: TSQLRest; aDestID: TID;
  const aAndWhereSQL: RawUTF8): integer;
begin
  result := InternalFillMany(aclient,aDestID,aAndWhereSQL,true);
end;

function TSQLRecordMany.IDWhereSQL(aClient: TSQLRest; aID: TID; isDest: boolean;
  const aAndWhereSQL: RawUTF8): RawUTF8;
const FieldName: array[boolean] of RawUTF8 = ('Source=','Dest=');
begin
  if (self=nil) or (aID=0) or (fSourceID=nil) or (fDestID=nil) or
     (aClient=nil) then
    Result := '' else begin
    if aAndWhereSQL<>'' then
      if PosEx(RawUTF8(':('),aAndWhereSQL,1)>0 then
        Result := '%:(%): AND %' else // inlined parameters
        Result := '%% AND %' else // no inlined parameters -> not cached
      Result := '%:(%):'; // no additional where clause -> inline ID
    Result := FormatUTF8(result,[FieldName[isDest],aID,aAndWhereSQL]);
  end;
end;

function TSQLRecordMany.SourceGet(aClient: TSQLRest; aDestID: TID;
  out SourceIDs: TIDDynArray): boolean;
var Where: RawUTF8;
begin
  Where := IDWhereSQL(aClient,aDestID,True);
  if Where='' then
    Result := false else
    Result := aClient.OneFieldValues(RecordClass,'Source',Where,TInt64DynArray(SourceIDs));
end;

function TSQLRecordMany.InternalIDFromSourceDest(aClient: TSQLRest;
  aSourceID, aDestID: TID): TID;
begin
  SetID(aClient.OneFieldValue(RecordClass,'RowID',
    FormatUTF8('Source=:(%): AND Dest=:(%):',[aSourceID,aDestID])),result);
end;


{ TSQLRestTempStorage }

constructor TSQLRestTempStorage.Create(aClass: TSQLRecordClass);
begin
  inherited Create;
  fStoredClass := aClass;
  fStoredClassRecordProps := aClass.RecordProps;
  fItems.InitSpecific(
    TypeInfo(TSQLRestTempStorageItemDynArray),fItem,djInt64,@fCount);
  fItems.Sorted := true;
  // space for 524287 fake items (our sorted array will not like bigger extent)
  fLastFakeID := $100000000000;
end;

destructor TSQLRestTempStorage.Destroy;
var i: integer;
begin
  for i := 0 to fCount-1 do
    fItem[i].Value.Free;
  inherited;
end;

procedure TSQLRestTempStorage.InternalAddItem(const item: TSQLRestTempStorageItem);
begin
  fItems.Add(item);
  if (fCount>1) and (fItem[fCount-2].ID>item.ID) then
    fItems.Sort else // ensure IDs are in increasing order
    fItems.Sorted := true; // pessimistic fItems.Add() did reset to false
end;

function TSQLRestTempStorage.InternalSetFields(const FieldNames: RawUTF8;
  out Fields: TSQLFieldBits): Boolean;
begin
  if FieldNames='' then
    Fields := fStoredClassRecordProps.SimpleFieldsBits[soUpdate] else
  if FieldNames='*' then
    FillCharFast(Fields,SizeOf(Fields),255) else
    if not fStoredClassRecordProps.FieldBitsFromCSV(FieldNames,Fields) then begin
      result := false; // invalid FieldNames content
      exit;
    end;
  result := True;
end;

function TSQLRestTempStorage.AddCopy(Value: TSQLRecord;
  ForceID: boolean; const FieldNames: RawUTF8): TID;
begin
  if (self=nil) or (Value=nil) then
    result := 0 else
    result := AddOwned(Value.CreateCopy,ForceID,FieldNames);
end;

function TSQLRestTempStorage.AddOwned(Value: TSQLRecord; ForceID: boolean;
  const Fields: TSQLFieldBits): TID;
var item: TSQLRestTempStorageItem;
begin
  result := 0;
  if (self=nil) or (Value=nil) or
     (ForceID and (Value.IDValue=0)) or
     IsZero(Fields) then
    exit;
  item.ValueFields := Fields;
  fSafe.Lock;
  try
    if ForceID then begin
      item.ID := Value.IDValue;
      if fItems.Find(item)>=0 then begin
        Value.Free; // avoid memory leak
        exit; // this forced ID is already existing!
      end;
      item.Kind := [itemInsert];
    end else begin
      inc(fLastFakeID);
      item.ID := fLastFakeID;
      Value.IDValue := fLastFakeID;
      item.Kind := [itemInsert,itemFakeID];
    end;
    item.Value := Value; // instance will be owned by the list
    InternalAddItem(item);
  finally
    Safe.UnLock;
  end;
  result := item.ID;
end;

function TSQLRestTempStorage.AddOwned(Value: TSQLRecord;
  ForceID: boolean; const FieldNames: RawUTF8): TID;
var fields: TSQLFieldBits;
begin
  if (self=nil) or not InternalSetFields(FieldNames,fields) then
    result := 0 else
    result := AddOwned(Value,ForceID,fields);
end;

procedure TSQLRestTempStorage.Delete(const ID: TID);
var i: integer;
    item: TSQLRestTempStorageItem;
begin
  if (self=nil) or (ID=0) then
    exit;
  fSafe.Lock;
  try
    i := fItems.Find(ID);
    if i>=0 then
    with fItem[i] do begin
      FreeAndNil(Value); // Value=nil indicates deleted reord
      if itemInsert in Kind then
        fItems.Delete(i); // Add + Delete in place -> ignore this entry
      exit;
    end;
    item.ID := ID;
    item.Value := nil;  // Value=nil indicates deleted record
    FillZero(item.ValueFields);
    InternalAddItem(item);
  finally
    Safe.UnLock;
  end;
end;

function TSQLRestTempStorage.Update(Value: TSQLRecord;
  const Fields: TSQLFieldBits): boolean;
var i,f: integer;
    item: TSQLRestTempStorageItem;
    existing: ^TSQLRestTempStorageItem;
begin
  result := false;
  if (self=nil) or (Value=nil) or (Value.IDValue=0) or
     IsZero(fields) then
    exit;
  item.ID := Value.IDValue;
  item.ValueFields := Fields;
  fSafe.Lock;
  try
    i := fItems.Find(item);
    if i>=0 then begin
      existing := @fItem[i];
      if existing.Value=nil then
        exit; // impossible to update a deleted record
      existing^.ValueFields := existing^.ValueFields+item.ValueFields;
      for f := 0 to fStoredClassRecordProps.Fields.Count-1 do
        if f in item.ValueFields then
          fStoredClassRecordProps.Fields.List[f].CopyValue(Value,existing^.Value);
    end else begin
      item.Value := Value.CreateCopy;
      FillZero(item.ValueFields);
      InternalAddItem(item);
    end;
    result := true;
  finally
    Safe.UnLock;
  end;
end;

function TSQLRestTempStorage.Update(Value: TSQLRecord;
  const FieldNames: RawUTF8): boolean;
var fields: TSQLFieldBits;
begin
  if (self<>nil) and InternalSetFields(FieldNames,fields) then
    result := Update(Value,fields) else
    result := false;
end;

function TSQLRestTempStorage.FlushAsBatch(Rest: TSQLRest;
  AutomaticTransactionPerRow: cardinal): TSQLRestBatch;
var i: integer;
begin
  if (self=nil) or (fCount=0) then begin
    result := nil;
    exit;
  end;
  result := TSQLRestBatch.Create(Rest,fStoredClass,AutomaticTransactionPerRow,[]);
  fSafe.Lock;
  try
    for i := 0 to fCount-1 do
    with fItem[i] do
      if Value=nil then
        result.Delete(ID) else begin
        if itemInsert in Kind then
          result.Add(Value,true,not(itemFakeID in Kind),ValueFields) else
          result.Update(Value,ValueFields);
        FreeAndNil(Value);
      end;
    fItems.Clear;
  finally
    Safe.UnLock;
  end;
end;

function TSQLRestTempStorage.FromEvent(Event: TSQLEvent; ID: TID;
  const JSON: RawUTF8): boolean;
var Value: TSQLRecord;
    fields: TSQLFieldBits;
begin
  if (self=nil) or (ID=0) then begin
    result := false;
    exit;
  end;
  if Event=seDelete then begin
    Delete(ID);
    result := true;
    exit;
  end;
  Value := fStoredClass.Create;
  try
    Value.FillFrom(JSON,@fields);
    Value.IDValue := ID;
    case Event of
    seAdd: begin
      result := AddOwned(Value,True,fields)<>0;
      Value := nil; // owned by the list
    end;
    seUpdate,seUpdateBlob:
      result := Update(Value,fields);
    else result := false;
    end;
  finally
    Value.Free;
  end;
end;


{ TSQLRecordProperties }

procedure TSQLRecordProperties.InternalRegisterModel(aModel: TSQLModel;
  aTableIndex: integer; aProperties: TSQLModelRecordProperties);
var i: integer;
begin
  //assert(aTableIndex>=0);
  EnterCriticalSection(fLock); // may be called from several threads at once
  try
    for i := 0 to fModelMax do
      if fModel[i].Model=aModel then
        exit; // already registered
    inc(fModelMax);
    if fModelMax>=length(fModel) then
      SetLength(fModel,fModelMax+4);
    with fModel[fModelMax] do begin
      Model := aModel;
      Properties := aProperties;
      TableIndex := aTableIndex;
    end;
  finally
    LeaveCriticalSection(fLock);
  end;
end;

const // the most ambigous keywords - others may be used as column names
  SQLITE3_KEYWORDS = ' from where group in as ';

constructor TSQLRecordProperties.Create(aTable: TSQLRecordClass);
var i,j, nProps: integer;
    nMany, nSQLRecord, nSimple, nDynArray, nBlob, nBlobCustom,
    nCopiableFields: integer;
    isTSQLRecordMany: boolean;
    F: TSQLPropInfo;
label Simple, Small, Copiabl;
begin
  InitializeCriticalSection(fLock);
  if aTable=nil then
    raise EModelException.Create('TSQLRecordProperties.Create(nil)');
  // register for JSONToObject() and for TSQLPropInfoRTTITID.Create()
  // (should have been done before in TSQLModel.Create/AddTable)
  TJSONSerializer.RegisterClassForJSON(aTable);
  // initialize internal structures
  fModelMax := -1;
  fTable := aTable;
  fSQLTableName := GetDisplayNameFromClass(aTable);
  fSQLTableNameUpperWithDot := SynCommons.UpperCase(SQLTableName)+'.';
  isTSQLRecordMany := aTable.InheritsFrom(TSQLRecordMany);
  // add properties to internal Fields list
  fClassType := PTypeInfo(aTable.ClassInfo)^.ClassType;
  fClassProp := InternalClassProp(aTable);
  nProps := ClassFieldCountWithParents(aTable);
  if nProps>MAX_SQLFIELDS_INCLUDINGID then
    raise EModelException.CreateUTF8('% has too many fields: %>=%',
      [Table,nProps,MAX_SQLFIELDS]);
  fFields := TSQLPropInfoList.Create(aTable,[pilRaiseEORMExceptionIfNotHandled]);
  aTable.InternalRegisterCustomProperties(self);
  if Fields.Count>MAX_SQLFIELDS_INCLUDINGID then
    raise EModelException.CreateUTF8(
      '% has too many fields after InternalRegisterCustomProperties(%): %>=%',
      [Table,self,Fields.Count,MAX_SQLFIELDS]);
  SetLength(Fields.fList,Fields.Count);
  // generate some internal lookup information
  fSQLTableRetrieveAllFields := 'ID';
  SetLength(fManyFields,MAX_SQLFIELDS);
  SetLength(fSimpleFields,MAX_SQLFIELDS);
  SetLength(fJoinedFields,MAX_SQLFIELDS);
  SetLength(fCopiableFields,MAX_SQLFIELDS);
  SetLength(fDynArrayFields,MAX_SQLFIELDS);
  SetLength(fBlobCustomFields,MAX_SQLFIELDS);
  SetLength(fBlobFields,MAX_SQLFIELDS);
  MainField[false] := -1;
  MainField[true] := -1;
  nMany := 0;
  nSimple := 0;
  nSQLRecord := 0;
  nCopiableFields := 0;
  nDynArray := 0;
  nBlob := 0;
  nBlobCustom := 0;
  for i := 0 to Fields.Count-1  do begin
    F := Fields.List[i];
    // check field name
    if IsRowID(pointer(F.Name)) then
      raise EModelException.CreateUTF8('ID is already defined in TSQLRecord: '+
        '%.% field name is not allowed as published property',[Table,F.Name]);
    if PosEx(' '+LowerCase(F.Name)+' ',SQLITE3_KEYWORDS)>0 then
      raise EModelException.CreateUTF8('%.% field name conflicts with a SQL keyword',[Table,F.Name]);
    //  handle unique fields, i.e. if marked as "stored false"
    if aIsUnique in F.Attributes then begin
      include(IsUniqueFieldsBits,i);
      // must trim() text value before storage, and validate for unicity
      if F.SQLFieldType in [sftUTF8Text,sftAnsiText] then
        AddFilterOrValidate(i,TSynFilterTrim.Create);
      AddFilterOrValidate(i,TSynValidateUniqueField.Create);
    end;
    // get corresponding properties content
    include(fHasTypeFields,F.SQLFieldType);
    include(FieldBits[F.SQLFieldType],i);
    case F.SQLFieldType of
      sftUnknown: ;
      sftUTF8Text: begin
        if aIsUnique in F.Attributes then
          if MainField[false]<0 then
            MainField[false] := i;
        if MainField[true]<0 then
          MainField[true] := i;
        goto Small;
      end;
      sftBlob: begin
        BlobFields[nBlob] := F as TSQLPropInfoRTTI;
        inc(nBlob);
        fSQLTableUpdateBlobFields := fSQLTableUpdateBlobFields+F.Name+'=?,';
        fSQLTableRetrieveBlobFields := fSQLTableRetrieveBlobFields+F.Name+',';
        fSQLTableRetrieveAllFields := fSQLTableRetrieveAllFields+','+F.Name;
        goto Copiabl;
      end;
      sftID: // = TSQLRecord(aID)
        if isTSQLRecordMany and
           (IdemPropNameU(F.Name,'Source') or IdemPropNameU(F.Name,'Dest')) then
          goto Small else begin
          JoinedFields[nSQLRecord] := F as TSQLPropInfoRTTIID;
          inc(nSQLRecord);
          goto Small;
        end;
      sftMany: begin
        ManyFields[nMany] := F as TSQLPropInfoRTTIMany;
        inc(nMany);
      end;
      sftBlobDynArray:
      with F as TSQLPropInfoRTTIDynArray do begin
        if DynArrayIndex>0 then
          for j := 0 to nDynArray-1 do
          if DynArrayFields[j].DynArrayIndex=DynArrayIndex then
            raise EModelException.CreateUTF8('dup index % for %.% and %.% properties',
              [DynArrayIndex,Table,Name,Table,DynArrayFields[j].Name]);
        DynArrayFields[nDynArray] := TSQLPropInfoRTTIDynArray(F);
        if TSQLPropInfoRTTIDynArray(F).ObjArray<>nil then
          fDynArrayFieldsHasObjArray := true;
        inc(nDynArray);
        goto Simple;
      end;
      sftBlobCustom, sftUTF8Custom: begin
        BlobCustomFields[nBlobCustom] := F;
        inc(nBlobCustom);
        goto Simple;
      end;
      sftCreateTime: begin
        include(ComputeBeforeAddFieldsBits,i);
        goto Small;
      end;
      sftModTime, sftSessionUserID: begin
        include(ComputeBeforeAddFieldsBits,i);
        include(ComputeBeforeUpdateFieldsBits,i);
        goto Small;
      end;
      sftRecordVersion: begin
        if fRecordVersionField<>nil then
          raise EModelException.CreateUTF8('%: only a single TRecordVersion '+
           'field is allowed per class',[Table]);
        fRecordVersionField := F as TSQLPropInfoRTTIRecordVersion;
        fSQLTableRetrieveAllFields := fSQLTableRetrieveAllFields+','+F.Name;
        goto Copiabl;
      end; // TRecordVersion is a copiable but not a simple field!
      sftVariant: // sftNullable are included in SmallfieldsBits
        goto Simple;
      else begin
Small:  include(SmallFieldsBits,i);
        // this code follows NOT_SIMPLE_FIELDS/COPIABLE_FIELDS constants
Simple: SimpleFields[nSimple] := F;
        inc(nSimple);
        include(SimpleFieldsBits[soSelect],i);
        fSQLTableSimpleFieldsNoRowID := fSQLTableSimpleFieldsNoRowID+F.Name+',';
        fSQLTableRetrieveAllFields := fSQLTableRetrieveAllFields+','+F.Name;
Copiabl:include(CopiableFieldsBits,i);
        CopiableFields[nCopiableFields] := F;
        inc(nCopiableFields);
      end;
    end;
  end;
  if fSQLTableSimpleFieldsNoRowID<>'' then
    SetLength(fSQLTableSimpleFieldsNoRowID,length(fSQLTableSimpleFieldsNoRowID)-1);
  if fSQLTableUpdateBlobFields<>'' then
    SetLength(fSQLTableUpdateBlobFields,length(fSQLTableUpdateBlobFields)-1);
  if fSQLTableRetrieveBlobFields<>'' then
    SetLength(fSQLTableRetrieveBlobFields,length(fSQLTableRetrieveBlobFields)-1);
  SetLength(fManyFields,nMany);
  SetLength(fSimpleFields,nSimple);
  SetLength(fJoinedFields,nSQLRecord);
  if nSQLRecord>0 then begin
    SetLength(fJoinedFieldsTable,nSQLRecord+1);
    fJoinedFieldsTable[0] := aTable;
    for i := 0 to nSQLRecord-1 do
      fJoinedFieldsTable[i+1] := TSQLRecordClass(JoinedFields[i].ObjectClass);
  end;
  SetLength(fCopiableFields,nCopiableFields);
  SetLength(fDynArrayFields,nDynArray);
  SetLength(fBlobCustomFields,nBlobCustom);
  SetLength(fBlobFields,nBlob);
  SimpleFieldsBits[soInsert] := SimpleFieldsBits[soSelect];
  SimpleFieldsBits[soUpdate] := SimpleFieldsBits[soSelect];
  SimpleFieldsBits[soDelete] := SimpleFieldsBits[soSelect];
  SimpleFieldsCount[soInsert] := nSimple;
  SimpleFieldsCount[soUpdate] := nSimple;
  SimpleFieldsCount[soDelete] := nSimple;
  fHasNotSimpleFields := nSimple<>Fields.Count;
  for i := 0 to Fields.Count-1 do
    if Fields.List[i].SQLFieldType=sftCreateTime then begin
      exclude(SimpleFieldsBits[soUpdate],i);
      dec(SimpleFieldsCount[soUpdate]);
    end;
  if SmallFieldsBits<>SimpleFieldsBits[soSelect]-FieldBits[sftVariant]-
    FieldBits[sftBlobDynArray]-FieldBits[sftBlobCustom]-FieldBits[sftUTF8Custom] then
    raise EModelException.CreateUTF8('TSQLRecordProperties.Create(%) Bits?',[Table]);
  if isTSQLRecordMany then begin
    fRecordManySourceProp := Fields.ByRawUTF8Name('Source') as TSQLPropInfoRTTIInstance;
    if fRecordManySourceProp=nil then
      raise EModelException.CreateUTF8('% expects a SOURCE field',[Table]) else
    fRecordManyDestProp := Fields.ByRawUTF8Name('Dest') as TSQLPropInfoRTTIInstance;
    if fRecordManyDestProp=nil then
      raise EModelException.CreateUTF8('% expects a DEST field',[Table]);
  end;
end;

function TSQLRecordProperties.BlobFieldPropFromRawUTF8(const PropName: RawUTF8): PPropInfo;
var i: integer;
begin
  if (self<>nil) and (PropName<>'') then
  for i := 0 to high(BlobFields) do
    if IdemPropNameU(BlobFields[i].Name,PropName) then begin
      result := BlobFields[i].PropInfo;
      exit;
    end;
  result := nil;
end;

function TSQLRecordProperties.BlobFieldPropFromUTF8(PropName: PUTF8Char; PropNameLen: integer): PPropInfo;
var i: integer;
begin
  if (self<>nil) and (PropName<>'') then
  for i := 0 to high(BlobFields) do
    if IdemPropName(BlobFields[i].PropInfo^.Name,PropName,PropNameLen) then begin
      result := BlobFields[i].PropInfo;
      exit;
    end;
  result := nil;
end;

function TSQLRecordProperties.SQLFieldTypeToSQL(FieldIndex: integer): RawUTF8;
const
  /// simple wrapper from each SQL used type into SQLite3 field datatype
  // - set to '' for fields with no column created in the database
  DEFAULT_SQLFIELDTYPETOSQL: array[TSQLFieldType] of RawUTF8 =
   ('',                              // sftUnknown
    ' TEXT COLLATE NOCASE, ',        // sftAnsiText
    ' TEXT COLLATE SYSTEMNOCASE, ',  // sftUTF8Text
    ' INTEGER, ',                    // sftEnumerate
    ' INTEGER, ',                    // sftSet
    ' INTEGER, ',                    // sftInteger
    ' INTEGER, ',                    // sftID = TSQLRecord(aID)
    ' INTEGER, ',                    // sftRecord = TRecordReference
    ' INTEGER, ',                    // sftBoolean
    ' FLOAT, ',                      // sftFloat
    ' TEXT COLLATE ISO8601, ',       // sftDateTime
    ' INTEGER, ',                    // sftTimeLog
    ' FLOAT, ',                      // sftCurrency
    ' TEXT COLLATE BINARY, ',        // sftObject
    {$ifndef NOVARIANTS}
    ' TEXT COLLATE BINARY, ',        // sftVariant
    ' TEXT COLLATE NOCASE, ',        // sftNullable (from SQLFieldTypeStored)
    {$endif NOVARIANTS}
    ' BLOB, ',                       // sftBlob
    ' BLOB, ',                       // sftBlobDynArray
    ' BLOB, ',                       // sftBlobCustom
    ' TEXT COLLATE NOCASE, ',        // sftUTF8Custom
    '',                              // sftMany
    ' INTEGER, ',                    // sftModTime
    ' INTEGER, ',                    // sftCreateTime
    ' INTEGER, ',                    // sftTID
    ' INTEGER, ',                    // sftRecordVersion
    ' INTEGER, ',                    // sftSessionUserID
    ' TEXT COLLATE ISO8601, ',       // sftDateTimeMS
    ' INTEGER, ',                    // sftUnixTime
    ' INTEGER, ');                   // sftUnixMSTime
begin
  if (self=nil) or (cardinal(FieldIndex)>=cardinal(Fields.Count)) then
    result := '' else
  if (FieldIndex<length(fCustomCollation)) and (fCustomCollation[FieldIndex]<>'') then
    result := ' TEXT COLLATE '+fCustomCollation[FieldIndex]+', ' else
    result := DEFAULT_SQLFIELDTYPETOSQL[Fields.List[FieldIndex].SQLFieldTypeStored];
end;

function TSQLRecordProperties.SetCustomCollation(FieldIndex: integer; const aCollationName: RawUTF8): boolean;
begin
  result := (self<>nil) and (cardinal(FieldIndex)<cardinal(Fields.Count));
  if result then begin
    if Fields.Count>length(fCustomCollation) then
      SetLength(fCustomCollation,Fields.Count);
    fCustomCollation[FieldIndex] := aCollationName;
    with Fields.List[FieldIndex] do
      if IdemPropNameU(aCollationName,'BINARY') then
        include(fAttributes,aBinaryCollation) else
        exclude(fAttributes,aBinaryCollation);
  end;
end;

function TSQLRecordProperties.SetCustomCollation(const aFieldName, aCollationName: RawUTF8): boolean;
begin
  result := SetCustomCollation(Fields.IndexByNameOrExcept(aFieldName),aCollationName);
end;

procedure TSQLRecordProperties.SetCustomCollationForAll(aFieldType: TSQLFieldType;
  const aCollationName: RawUTF8);
var i: integer;
begin
  if (self<>nil) and not(aFieldType in [sftUnknown,sftMany]) then
    for i := 0 to Fields.Count-1 do
      if Fields.List[i].SQLFieldTypeStored=aFieldType then
        SetCustomCollation(i,aCollationName);
end;

procedure TSQLRecordProperties.SetMaxLengthValidatorForTextFields(IndexIsUTF8Length: boolean);
var i: integer;
begin
  if self<>nil then
  for i := 0 to Fields.Count-1 do
    with Fields.List[i] do
    if (SQLDBFieldType in TEXT_DBFIELDS) and (cardinal(FieldWidth-1)<262144) then
      AddFilterOrValidate(i,TSynValidateText.CreateUTF8('{maxLength:%,UTF8Length:%}',
        [FieldWidth,IndexIsUTF8Length],[]));
end;

procedure TSQLRecordProperties.SetMaxLengthFilterForTextFields(IndexIsUTF8Length: boolean);
var i: integer;
begin
  if self<>nil then
  for i := 0 to Fields.Count-1 do
    with Fields.List[i] do
    if (SQLDBFieldType in TEXT_DBFIELDS) and (cardinal(FieldWidth-1)<262144) then
      AddFilterOrValidate(i,TSynFilterTruncate.CreateUTF8('{maxLength:%,UTF8Length:%}',
        [FieldWidth,IndexIsUTF8Length],[]));
end;

{$ifndef NOVARIANTS}
procedure TSQLRecordProperties.SetVariantFieldsDocVariantOptions(const Options: TDocVariantOptions);
var i: integer;
begin
  if self<>nil then
  for i := 0 to Fields.Count-1 do
    if (Fields.List[i].SQLFieldType=sftVariant) and
       Fields.List[i].InheritsFrom(TSQLPropInfoRTTIVariant) then
      TSQLPropInfoRTTIVariant(Fields.List[i]).DocVariantOptions := Options;
end;
{$endif}

function TSQLRecordProperties.SQLAddField(FieldIndex: integer): RawUTF8;
begin
  result := SQLFieldTypeToSQL(FieldIndex);
  if result='' then
    exit; // some fields won't have any column created in the database
  result := FormatUTF8('ALTER TABLE % ADD COLUMN %%',
    [SQLTableName,Fields.List[FieldIndex].Name,result]);
  if FieldIndex in IsUniqueFieldsBits then
    insert(' UNIQUE',result,length(result)-1);
  result[length(result)-1] := ';' // SQLFieldTypeToSQL[] ends with ','
end;

procedure TSQLRecordProperties.SetJSONWriterColumnNames(W: TJSONSerializer;
  KnownRowsCount: integer);
var i,n,nf: integer;
begin
  // get col count overhead
  if W.withID then
    n := 1 else
    n := 0;
  // set col names
  nf := Length(W.Fields);
  SetLength(W.ColNames,nf+n);
  if W.withID then
    W.ColNames[0] := 'RowID'; // works for both normal and FTS3 records
  for i := 0 to nf-1 do begin
    W.ColNames[n] := Fields.List[W.Fields[i]].Name;
    inc(n);
  end;
  // write or init field names for appropriate JSON Expand
  W.AddColumns(KnownRowsCount);
end;

function TSQLRecordProperties.CreateJSONWriter(JSON: TStream; Expand,
  withID: boolean; const aFields: TSQLFieldBits; KnownRowsCount,aBufSize: integer): TJSONSerializer;
begin
  result := CreateJSONWriter(JSON,Expand,withID,
    FieldBitsToIndex(aFields,Fields.Count),KnownRowsCount,aBufSize);
end;

function TSQLRecordProperties.CreateJSONWriter(JSON: TStream; Expand,
  withID: boolean; const aFields: TSQLFieldIndexDynArray; KnownRowsCount,aBufSize: integer): TJSONSerializer;
begin
  if (self=nil) or ((Fields=nil) and not withID) then  // no data
    result := nil else begin
    result := TJSONSerializer.Create(JSON,Expand,withID,aFields,aBufSize);
    SetJSONWriterColumnNames(result,KnownRowsCount);
  end;
end;

function TSQLRecordProperties.CreateJSONWriter(JSON: TStream; Expand: boolean;
   const aFieldsCSV: RawUTF8; KnownRowsCount,aBufSize: integer): TJSONSerializer;
var withID: boolean;
    bits: TSQLFieldBits;
begin
  FieldBitsFromCSV(aFieldsCSV,bits,withID);
  result := CreateJSONWriter(JSON,Expand,withID,bits,KnownRowsCount,aBufSize);
end;

function TSQLRecordProperties.SaveSimpleFieldsFromJsonArray(var P: PUTF8Char;
  var EndOfObject: AnsiChar; ExtendedJSON: boolean): RawUTF8;
var i: integer;
    W: TJSONSerializer;
    Start: PUTF8Char;
    temp: TTextWriterStackBuffer;
begin
  result := '';
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^<>'[' then
    exit;
  repeat inc(P) until (P^>' ') or (P^=#0);
  W := TJSONSerializer.CreateOwnedStream(temp);
  try
    W.Add('{');
    for i := 0 to length(SimpleFields)-1 do begin
      if ExtendedJSON then begin
        W.AddString(SimpleFields[i].Name);
        W.Add(':');
      end else
        W.AddFieldName(SimpleFields[i].Name);
      Start := P;
      P := GotoEndJSONItem(P);
      if (P=nil) or not(P^ in [',',']']) then
        exit;
      W.AddNoJSONEscape(Start,P-Start);
      W.Add(',');
      repeat inc(P) until (P^>' ') or (P^=#0);
    end;
    W.CancelLastComma;
    W.Add('}');
    W.SetText(result);
  finally
    W.Free;
  end;
  EndOfObject := P^;
  if P^<>#0 then
    repeat inc(P) until (P^>' ') or (P^=#0);
end;

procedure TSQLRecordProperties.SaveBinaryHeader(W: TFileBufferWriter);
var i: integer;
    FieldNames: TRawUTF8DynArray;
begin
  W.Write(SQLTableName);
  SetLength(FieldNames,Fields.Count);
  for i := 0 to Fields.Count-1 do
    FieldNames[i] := Fields.List[i].Name;
  W.WriteRawUTF8DynArray(FieldNames,Fields.Count);
  for i := 0 to Fields.Count-1 do
    W.Write(@Fields.List[i].fSQLFieldType,SizeOf(TSQLFieldType));
end;

function TSQLRecordProperties.CheckBinaryHeader(var R: TFileBufferReader): boolean;
var n,i: integer;
    FieldNames: TRawUTF8DynArray;
    FieldTypes: array[0..MAX_SQLFIELDS-1] of TSQLFieldType;
begin
  result := false;
  if (R.ReadRawUTF8<>SQLTableName) or
     (R.ReadVarRawUTF8DynArray(FieldNames)<>Fields.Count) then
    exit;
  n := SizeOf(TSQLFieldType)*Fields.Count;
  if R.Read(@FieldTypes,n)<>n then
    exit;
  for i := 0 to Fields.Count-1 do
    with Fields.List[i] do
    if (Name<>FieldNames[i]) or (SQLFieldType<>FieldTypes[i]) then
      exit;
  result := true;
end;

function TSQLRecordProperties.IsFieldName(const PropName: RawUTF8): boolean;
begin
  result := (PropName<>'') and
    (isRowID(pointer(PropName)) or (Fields.IndexByName(PropName)>=0));
end;

function TSQLRecordProperties.IsFieldNameOrFunction(const PropName: RawUTF8): boolean;
var L: integer;
begin
  L := length(PropName);
  if (L=0) or (self=nil) then
    result := false else
    if PropName[L]=')' then
      case IdemPCharArray(pointer(PropName),['MAX(','MIN(','AVG(','SUM(',
         'JSONGET(','JSONHAS(']) of
      0..3:
        result := IsFieldName(copy(PropName,5,L-5));
      4..5:
        result := IsFieldName(copy(PropName,9,PosExChar(',',PropName)-9));
      else
        result := IsFieldName(PropName);
      end else
      result := IsFieldName(PropName);
end;

function TSQLRecordProperties.AddFilterOrValidate(aFieldIndex: integer;
  aFilter: TSynFilterOrValidate): boolean;
begin
  if (self=nil) or (cardinal(aFieldIndex)>=cardinal(Fields.Count)) or
    (aFilter=nil) then
    result := false else begin
    if Filters=nil then
      SetLength(fFilters,Fields.Count);
    aFilter.AddOnce(Filters[aFieldIndex]);
    result := true;
  end;
end;

procedure TSQLRecordProperties.AddFilterOrValidate(const aFieldName: RawUTF8;
  aFilter: TSynFilterOrValidate);
begin
  AddFilterOrValidate(Fields.IndexByNameOrExcept(aFieldName),aFilter);
end;

destructor TSQLRecordProperties.Destroy;
var f: integer;
begin
  for f := 0 to high(Filters) do
    ObjArrayClear(Filters[f]); // will free any created TSynFilter instances
  inherited;
  DeleteCriticalSection(fLock);
  Fields.Free;
end;

function TSQLRecordProperties.FieldBitsFromBlobField(aBlobField: PPropInfo;
  var Bits: TSQLFieldBits): boolean;
var f: integer;
begin
  FillZero(Bits);
  if self<>nil then
  for f := 0 to high(BlobFields) do
    if BlobFields[f].fPropInfo=aBlobField then begin
      Include(Bits,BlobFields[f].PropertyIndex);
      result := true;
      exit;
    end;
  result := false;
end;

function TSQLRecordProperties.FieldBitsFromCSV(const aFieldsCSV: RawUTF8;
  var Bits: TSQLFieldBits): boolean;
var ndx: integer;
    P: PUTF8Char;
    FieldName: ShortString;
begin
  FillZero(Bits);
  result := false;
  if self=nil then
    exit;
  P := pointer(aFieldsCSV);
  while P<>nil do begin
    GetNextItemShortString(P,FieldName);
    FieldName[ord(FieldName[0])+1] := #0; // make PUTF8Char
    ndx := Fields.IndexByName(@FieldName[1]);
    if ndx<0 then
      exit; // invalid field name
    include(Bits,ndx);
  end;
  result := true;
end;

function TSQLRecordProperties.FieldBitsFromCSV(const aFieldsCSV: RawUTF8;
  var Bits: TSQLFieldBits; out withID: boolean): boolean;
var ndx: integer;
    P: PUTF8Char;
    FieldName: ShortString;
begin
  if (aFieldsCSV='*') and (self<>nil) then begin
    Bits := SimpleFieldsBits[soSelect];
    withID := true;
    result := true;
    exit;
  end;
  FillZero(Bits);
  withID := false;
  result := false;
  if self=nil then
    exit;
  P := pointer(aFieldsCSV);
  while P<>nil do begin
    GetNextItemShortString(P,FieldName);
    if IsRowIDShort(FieldName) then begin
      withID := true;
      continue;
    end;
    FieldName[ord(FieldName[0])+1] := #0; // make PUTF8Char
    ndx := Fields.IndexByName(@FieldName[1]);
    if ndx<0 then
      exit; // invalid field name
    include(Bits,ndx);
  end;
  result := true;
end;

function TSQLRecordProperties.FieldBitsFromCSV(const aFieldsCSV: RawUTF8): TSQLFieldBits;
begin
  if not FieldBitsFromCSV(aFieldsCSV,Result) then
    FillZero(result);
end;

function TSQLRecordProperties.FieldBitsFromExcludingCSV(
  const aFieldsCSV: RawUTF8; aOccasion: TSQLOccasion): TSQLFieldBits;
var excluded: TSQLFieldBits;
begin
  result := SimpleFieldsBits[aOccasion];
  if FieldBitsFromCSV(aFieldsCSV,excluded) then
    result := result-excluded;
end;

function TSQLRecordProperties.FieldBitsFromRawUTF8(const aFields: array of RawUTF8;
  var Bits: TSQLFieldBits): boolean;
var f,ndx: integer;
begin
  FillZero(Bits);
  result := false;
  if self=nil then
    exit;
  for f := 0 to high(aFields) do begin
    ndx := Fields.IndexByName(aFields[f]);
    if ndx<0 then
      exit; // invalid field name
    include(Bits,ndx);
  end;
  result := true;
end;

function TSQLRecordProperties.FieldBitsFromRawUTF8(const aFields: array of RawUTF8): TSQLFieldBits;
begin
  if not FieldBitsFromRawUTF8(aFields,Result) then
    FillZero(result);
end;

function TSQLRecordProperties.CSVFromFieldBits(const Bits: TSQLFieldBits): RawUTF8;
var f: integer;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    for f := 0 to Fields.Count-1 do
      if f in Bits then begin
        W.AddString(Fields.List[f].Name);
        W.Add(',');
      end;
    W.CancelLastComma;
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TSQLRecordProperties.FieldIndexDynArrayFromRawUTF8(
  const aFields: array of RawUTF8; var Indexes: TSQLFieldIndexDynArray): boolean;
var f,ndx: integer;
begin
  result := false;
  if self=nil then
    exit;
  for f := 0 to high(aFields) do begin
    ndx := Fields.IndexByName(aFields[f]);
    if ndx<0 then
      exit; // invalid field name
    AddFieldIndex(Indexes,ndx);
  end;
  result := true;
end;

function TSQLRecordProperties.FieldIndexDynArrayFromRawUTF8(const aFields: array of RawUTF8): TSQLFieldIndexDynArray;
begin
  if not FieldIndexDynArrayFromRawUTF8(aFields,result) then
    result := nil;
end;

function TSQLRecordProperties.FieldIndexDynArrayFromCSV(const aFieldsCSV: RawUTF8;
  var Indexes: TSQLFieldIndexDynArray): boolean;
var ndx: integer;
    P: PUTF8Char;
    FieldName: ShortString;
begin
  result := false;
  if self=nil then
    exit;
  P := pointer(aFieldsCSV);
  while P<>nil do begin
    GetNextItemShortString(P,FieldName);
    FieldName[ord(FieldName[0])+1] := #0; // make PUTF8Char
    ndx := Fields.IndexByName(@FieldName[1]);
    if ndx<0 then
      exit; // invalid field name
    AddFieldIndex(Indexes,ndx);
  end;
  result := true;
end;

function TSQLRecordProperties.FieldIndexDynArrayFromCSV(const aFieldsCSV: RawUTF8): TSQLFieldIndexDynArray;
begin
  if not FieldIndexDynArrayFromCSV(aFieldsCSV,result) then
    result := nil;
end;

function TSQLRecordProperties.FieldIndexDynArrayFromBlobField(aBlobField: PPropInfo;
  var Indexes: TSQLFieldIndexDynArray): boolean;
var f: integer;
begin
  if self<>nil then
  for f := 0 to high(BlobFields) do
    if BlobFields[f].fPropInfo=aBlobField then begin
      AddFieldIndex(Indexes,BlobFields[f].PropertyIndex);
      result := true;
      exit;
    end;
  result := false;
end;

function TSQLRecordProperties.AppendFieldName(FieldIndex: Integer;
  var Text: RawUTF8; ForceNoRowID: boolean): boolean;
begin
  result := false; // success
  if FieldIndex=VIRTUAL_TABLE_ROWID_COLUMN then
    if ForceNoRowID then
      Text := Text+'ID' else
      Text := Text+'RowID' else
  if (self=nil) or (cardinal(FieldIndex)>=cardinal(Fields.Count)) then
    result := true else
    Text := Text+Fields.List[FieldIndex].Name;
end;

function TSQLRecordProperties.MainFieldName(ReturnFirstIfNoUnique: boolean=false): RawUTF8;
begin
  if (self=nil) or (Table=nil) or (MainField[ReturnFirstIfNoUnique]<0) then
    result := '' else
    result := Fields.List[MainField[ReturnFirstIfNoUnique]].Name;
end;

procedure TSQLRecordProperties.RegisterCustomFixedSizeRecordProperty(
  aTable: TClass; aRecordSize: cardinal; const aName: RawUTF8;
  aPropertyPointer: pointer; aAttributes: TSQLPropInfoAttributes;
  aFieldWidth: integer; aData2Text: TOnSQLPropInfoRecord2Text;
  aText2Data: TOnSQLPropInfoRecord2Data);
begin
  Fields.Add(TSQLPropInfoRecordFixedSize.Create(aRecordSize,aName,Fields.Count,
    aPropertyPointer,aAttributes,aFieldWidth,aData2Text,aText2Data));
end;

procedure TSQLRecordProperties.RegisterCustomRTTIRecordProperty(aTable: TClass;
  aRecordInfo: PTypeInfo; const aName: RawUTF8;  aPropertyPointer: pointer;
  aAttributes: TSQLPropInfoAttributes; aFieldWidth: integer;
  aData2Text: TOnSQLPropInfoRecord2Text; aText2Data: TOnSQLPropInfoRecord2Data);
begin
  Fields.Add(TSQLPropInfoRecordRTTI.Create(aRecordInfo,aName,Fields.Count,
    aPropertyPointer,aAttributes,aFieldWidth,aData2Text,aText2Data));
end;

procedure TSQLRecordProperties.RegisterCustomPropertyFromRTTI(aTable: TClass;
  aTypeInfo: PTypeInfo; const aName: RawUTF8; aPropertyPointer: pointer;
  aAttributes: TSQLPropInfoAttributes; aFieldWidth: integer);
begin
  Fields.Add(TSQLPropInfoCustomJSON.Create(aTypeInfo,aName,Fields.Count,
    aPropertyPointer,aAttributes,aFieldWidth));
end;

procedure TSQLRecordProperties.RegisterCustomPropertyFromTypeName(aTable: TClass;
  const aTypeName, aName: RawUTF8; aPropertyPointer: pointer;
  aAttributes: TSQLPropInfoAttributes; aFieldWidth: integer);
begin
  Fields.Add(TSQLPropInfoCustomJSON.Create(aTypeName,aName,Fields.Count,
    aPropertyPointer,aAttributes,aFieldWidth));
end;

{ TSynValidateRest }

function TSynValidateRest.Process(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string): boolean;
begin
  Result := DoValidate(aFieldIndex, Value, ErrorMsg, fProcessRest, fProcessRec);
end;

function TSynValidateRest.Validate(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string; aProcessRest: TSQLRest; aProcessRec: TSQLRecord): boolean;
begin
  try
    fProcessRest := aProcessRest;
    fProcessRec := aProcessRec;
    result := DoValidate(aFieldIndex,Value,ErrorMsg,aProcessRest,aProcessRec);
  finally
    fProcessRest := nil;
    fProcessRec := nil;
  end;
end;

{ TSynValidateUniqueField }

function TSynValidateUniqueField.DoValidate(aFieldIndex: integer; const Value: RawUTF8;
  var ErrorMsg: string; aProcessRest: TSQLRest; aProcessRec: TSQLRecord): boolean;
var aID: TID;
begin
  result := false;
  if Value='' then
    ErrorMsg := sValidationFieldVoid else
  if (aProcessRest=nil) or (aProcessRec=nil) then
    result := true else
  with aProcessRec.RecordProps do
    if cardinal(aFieldIndex)>=cardinal(Fields.Count) then
      result := true else begin
      SetID(aProcessRest.OneFieldValue(Table,'RowID',
        Fields.List[aFieldIndex].Name+'=:('+QuotedStr(Value,'''')+'):'),aID);
      if (aID>0) and (aID<>aProcessRec.fID) then
        ErrorMsg := sValidationFieldDuplicate else
        result := true;
    end;
end;

{ TSynValidateUniqueFields }

procedure TSynValidateUniqueFields.SetParameters(const Value: RawUTF8);
var V: array[0..0] of TValuePUTF8Char;
    tmp: TSynTempBuffer;
begin
  tmp.Init(Value);
  try
    JSONDecode(tmp.buf,['FieldNames'],@V,True);
    CSVToRawUTF8DynArray(V[0].Value,fFieldNames);
  finally
    tmp.Done;
  end;
end;

function TSynValidateUniqueFields.DoValidate(aFieldIndex: integer;
  const Value: RawUTF8; var ErrorMsg: string; aProcessRest: TSQLRest; aProcessRec: TSQLRecord): boolean;
var where: RawUTF8;
    i: integer;
    aID: TID;
begin
  if (aProcessRest=nil) or (aProcessRec=nil) or (fFieldNames=nil) then
    result := true else begin
    for i := 0 to high(fFieldNames) do begin
      if where<>'' then
        where := where+' AND ';
      where := where+fFieldNames[i]+'=:('+
        QuotedStr(aProcessRec.GetFieldValue(fFieldNames[i]),'''')+'):';
    end;
    SetID(aProcessRest.OneFieldValue(aProcessRec.RecordClass,'ID',where),aID);
    if (aID>0) and (aID<>aProcessRec.fID) then begin
      ErrorMsg := sValidationFieldDuplicate;
      result := false;
    end else
      result := true;
  end;
end;


{ TJSONSerializer }

procedure TJSONSerializer.WriteObject(Value: TObject; Options: TTextWriterWriteObjectOptions);
var Added: boolean;
    CustomComment: RawUTF8;
    CustomPropName: PShortString;
    IsObj: TJSONObject;
    WS: WideString;
    {$ifdef HASVARUSTRING} US: UnicodeString; {$endif}
    tmp: RawByteString;
    {$ifndef NOVARIANTS} VV: variant; {$endif}

  procedure HR(P: PPropInfo=nil);
  begin
    if woHumanReadable in Options then begin
      if CustomComment<>'' then begin
        AddShort(' // ');
        AddString(CustomComment);
        CustomComment := '';
      end;
      AddCRAndIndent;
    end;
    if P=nil then
      exit;
    if CustomPropName<>nil then
      AddPropName(CustomPropName^) else
      AddPropName(P^.Name); // handle twoForceJSONExtended in CustomOptions
    if woHumanReadable in Options then
      Add(' ');
    Added := true;
  end;
  procedure WriteProp(P: PPropInfo);
  var D64: double;
      V64: Int64;
      Obj: TObject;
      V, c, codepage: integer;
      po: PObject;
      Kind: TTypeKind;
      PS: PShortString;
      dyn: TDynArray;
      dynObjArray: PClassInstance;
  begin
    if Assigned(OnWriteObject) and OnWriteObject(self,Value,P,Options) then
      exit;
    if IsObj in [oSQLRecord,oSQLMany] then begin // ignore "stored AS_UNIQUE"
      if IsRowIDShort(P^.Name) then
        exit; // should not happen
    end else
      if not (woStoreStoredFalse in Options) and
         not P^.IsStored(Value) then
        exit; // ignore regular "stored false" attribute
    Added := false;  // HR(P) will write field name and set Added := true
    Kind := P^.PropType^.Kind;
    case Kind of
      tkInt64{$ifdef FPC}, tkQWord{$endif}: begin
        V64 := P^.GetInt64Prop(Value);
        if not ((woDontStoreDefault in Options) and (V64=Int64(P^.Default))) and
           not ((V64=0) and (woDontStore0 in Options)) then begin
          HR(P);
          if woTimeLogAsText in Options then
            case P^.PropType^.GetSQLFieldType of
            sftTimeLog,sftModTime,sftCreateTime: begin
              Add('"');
              AddTimeLog(@V64);
              Add('"',',');
              exit;
            end;
            sftUnixTime: begin
              Add('"');
              AddUnixTime(@V64);
              Add('"',',');
              exit;
            end;
            sftUnixMSTime: begin
              Add('"');
              AddUnixMSTime(@V64);
              Add('"',',');
              exit;
            end;
            end;
          if woInt64AsHex in Options then begin
            Add('"');
            if V64 <> 0 then
              AddBinToHexDisplay(@V64,SizeOf(V64));
            Add('"');
          end else
          if {$ifdef FPC}Kind=tkQWord{$else}P^.PropType^.IsQWord{$endif} then
            AddQ(V64) else
            Add(V64);
        end;
      end;
      {$ifdef FPC} tkBool, {$endif}
      tkEnumeration, tkInteger, tkSet: begin
        V := P^.GetOrdProp(Value);
        if not ((woDontStoreDefault in Options) and (V=P^.Default)) and
           not ((V=0) and (woDontStore0 in Options)) then begin
          HR(P);
          if {$ifdef FPC}(Kind=tkBool) or{$endif}
             ((Kind=tkEnumeration) and (P^.TypeInfo=TypeInfo(boolean))) then
            Add(boolean(V)) else
            if (woFullExpand in Options) or (woHumanReadable in Options) or
               (woEnumSetsAsText in Options) or
               (twoEnumSetsAsTextInRecord in CustomOptions) then
            case Kind of
            tkEnumeration:
            with P^.PropType^.EnumBaseType^ do begin
              Add('"');
              PS := GetEnumNameOrd(V);
              if twoTrimLeftEnumSets in CustomOptions then
                AddTrimLeftLowerCase(PS) else
                AddShort(PS^);
              Add('"');
              if woHumanReadableEnumSetAsComment in Options then
                GetEnumNameAll(CustomComment,'',true);
            end;
            tkSet:
            with P^.PropType^.SetEnumType^ do begin
              GetSetNameCSV(self,V,',',woHumanReadableFullSetsAsStar in Options);
              if woHumanReadableEnumSetAsComment in Options then
                GetEnumNameAll(CustomComment,'"*" or a set of ',true);
            end;
            else
              Add(V);
            end else
              Add(V); // typecast enums and sets as plain integer by default
        end;
      end;
      {$ifdef FPC}tkSString{$else}tkString{$endif}: begin
        P^.GetShortStrProp(Value,tmp);
        if (tmp<>'') or not (woDontStoreEmptyString in Options) then begin
          HR(P);
          Add('"');
          AddJSONEscape(pointer(tmp));
          Add('"');
        end;
      end; // no shortstring deserialization by now
      {$ifdef FPC}tkLStringOld,{$endif} tkLString:
      if P^.TypeInfo=TypeInfo(RawJSON) then begin
        P^.GetLongStrProp(Value,tmp); // assume shortstring field is UTF-8 encoded
        if tmp<>'' then begin
          HR(P);
          AddString(tmp);
        end;
      end else begin
        codepage := P^.PropType^.AnsiStringCodePage;
        if (codepage=CP_SQLRAWBLOB) and not (woSQLRawBlobAsBase64 in Options) then begin
          if not (woDontStoreEmptyString in Options) then begin
            HR(P);
            AddShort('""');
          end;
        end else begin
          P^.GetLongStrProp(Value,tmp);
          if (tmp<>'') or not (woDontStoreEmptyString in Options) then begin
            HR(P);
            Add('"');
            if (IsObj=oSynPersistentWithPassword) and (codepage=CP_UTF8) and
               ((woHideSynPersistentPassword in Options) or (woFullExpand in Options)) and
               P^.GetterIsField and (P^.GetterAddr(Value)=
                 TSynPersistentWithPassword(Value).GetPasswordFieldAddress) then begin
              if tmp<>'' then
                AddShort('***');
            end else
              AddAnyAnsiString(tmp,twJSONEscape,codepage);
            Add('"');
          end;
        end;
      end;
      tkFloat: begin
        if (P^.TypeInfo=TypeInfo(Currency)) and P^.GetterIsField then begin
          V64 := PInt64(P^.GetterAddr(Value))^;
          if not ((V64=0) and (woDontStore0 in Options)) then begin
            HR(P);
            AddCurr64(V64);
          end;
        end else
        if P^.TypeInfo=TypeInfo(TDateTime) then begin
          D64 := P^.GetDoubleProp(Value);
          if not ((D64=0) and (woDontStore0 in Options)) then begin
            HR(P);
            if woDateTimeWithMagic in Options then
              AddNoJSONEscape(@JSON_SQLDATE_MAGIC_QUOTE_VAR,4) else
              Add('"');
            AddDateTime(D64);
            if woDateTimeWithZSuffix in Options then
              if frac(D64)=0 then // FireFox can't decode short form "2017-01-01Z"
                AddShort('T00:00Z') else
                Add('Z');
            Add('"');
          end;
        end else begin
          D64 := P^.GetFloatProp(Value);
          if not ((woDontStore0 in Options) and (D64=0)) then begin
            HR(P);
            AddDouble(D64);
          end;
        end;
      end;
      {$ifdef HASVARUSTRING}
      tkUString: begin // write converted to UTF-8
        P^.GetUnicodeStrProp(Value,US);
        if (US<>'') or not (woDontStoreEmptyString in Options) then begin
          HR(P);
          Add('"');
          AddJSONEscapeW(pointer(US));
          Add('"');
        end;
      end;
      {$endif}
      tkWString: begin // write converted to UTF-8
        P^.GetWideStrProp(Value,WS);
        if (WS<>'') or not (woDontStoreEmptyString in Options) then begin
          HR(P);
          Add('"');
          AddJSONEscapeW(pointer(WS));
          Add('"');
        end;
      end;
      tkDynArray: begin
        P^.GetDynArray(Value,dyn);
        if not ((woDontStore0 in Options) and (dyn.Count=0)) then begin
          HR(P);
          dynObjArray := P^.DynArrayIsObjArrayInstance;
          if (dynObjArray<>nil) and HasDefaultObjArrayWriter(dyn) then begin
            if dyn.Count=0 then begin
              if woHumanReadableEnumSetAsComment in Options then
                dynObjArray^.SetCustomComment(CustomComment);
              Add('[',']');
            end else begin // do not use AddDynArrayJSON to support HR
              inc(fHumanReadableLevel);
              Add('[');
              po := dyn.Value^;
              for c := 1 to dyn.Count do begin
                WriteObject(po^,Options);
                Add(',');
                inc(po);
              end;
              CancelLastComma;
              dec(fHumanReadableLevel);
              HR;
              Add(']');
              end;
            end else
            AddDynArrayJSON(dyn); // not an ObjArray: record-based serialization
        end;
      end;
      {$ifdef PUBLISHRECORD}
      tkRecord{$ifdef FPC},tkObject{$endif}: begin
        HR(P);
        AddRecordJSON(P^.GetFieldAddr(Value)^,P^.PropType^);
      end;
      {$endif}
      {$ifndef NOVARIANTS}
      tkVariant: begin
        P^.GetVariantProp(Value,VV);
        if not ((TVarData(VV).VType<=varNull) and (woDontStore0 in Options)) then begin
          HR(P);
          AddVariant(VV,twJSONEscape); // stored as JSON, e.g. '1.234' or '"text"'
        end;
      end;
      {$endif NOVARIANTS}
      tkClass: begin
        Obj := P^.GetObjProp(Value);
        if not(woDontStore0 in Options) or not IsObjectDefaultOrVoid(Obj) then
          if PropIsIDTypeCastedField(P,IsObj,Value) then begin
            HR(P);
            Add(PtrInt(Obj)); // not true instances, but ID
          end else if Obj<>nil then begin
            HR(P); // TPersistent or any class defined with $M+
            WriteObject(Obj,Options);
          end;
      end;
      // tkString (shortstring) and tkInterface is not handled
    end;
    if Added then
      Add(',');
  end;
  procedure WritePropsFromRTTI(aClassType: TClass);
  var i: integer;
      P: PPropInfo;
  begin
    repeat
      for i := 1 to InternalClassPropInfo(aClassType,P) do begin
        WriteProp(P);
        P := P^.Next;
      end;
      if woDontStoreInherited in Options then
        break;
      aClassType := GetClassParent(aClassType);
    until aClassType=TObject;
  end;

var i, c: integer;
    List: TList absolute Value;
    {$ifndef LVCL}
    Coll: TCollection absolute Value;
    {$endif}
    Str: TStrings absolute Value;
    Utf: TRawUTF8List absolute Value;
    Table: TSQLTable absolute Value;
    parser: PJSONCustomParser;
    aClassType: TClass;
    UtfP: PPUtf8CharArray;
begin
  if not (woHumanReadable in Options) or (fHumanReadableLevel<0) then
    fHumanReadableLevel := 0;
  if (self=nil) or (Value=nil) then begin
    AddShort('null'); // return void object
    exit;
  end;
  CustomPropName := nil;
  aClassType := PClass(Value)^;
  IsObj := JSONObjectFromClass(aClassType,parser);
  if woFullExpand in Options then
    if IsObj=oSynMonitor then begin // nested values do not need extended info
      exclude(Options,woFullExpand);
      include(Options,woEnumSetsAsText); // only needed info is textual enums
     end else begin
      Add('{');
      AddInstanceName(Value,':');
    end;
  case IsObj of
  // handle custom class serialization
  oCustomReaderWriter: begin
    if Assigned(parser^.Writer) then
      parser^.Writer(self,Value,Options);
    exit;
  end;
  // handle JSON arrays
  oSQLTable:
    Table.GetJSONValues(Stream,true);
  oList, oObjectList, {$ifndef LVCL}oCollection,{$endif} oUtfs, oStrings: begin
    HR;
    Add('['); // write as JSON array of JSON objects
    inc(fHumanReadableLevel);
    case IsObj of
    oList: // TList
      for c := 0 to List.Count-1 do begin
        WriteObject(List.List[c],Options);
        Add(',');
      end;
    oObjectList: begin
      if not (woObjectListWontStoreClassName in Options) then
        // TObjectList will include "ClassName":"TMyObject" field
        Options := Options+[woStoreClassName];
      for c := 0 to List.Count-1 do begin
        WriteObject(List.List[c],Options);
        Add(',');
      end;
    end;
{$ifndef LVCL}
    oCollection:
      for c := 0 to Coll.Count-1 do begin
        WriteObject(Coll.Items[c],Options);
        Add(',');
      end;
{$endif}
    oUtfs: begin
      UtfP := Utf.TextPtr;
      for c := 0 to Utf.Count-1 do begin
        HR;
        Add('"');
        AddJSONEscape(UtfP^[c]);
        Add('"',',');
      end;
    end;
    oStrings:
      for c := 0 to Str.Count-1 do begin
        HR;
        Add('"');
        AddJSONEscapeString(Str[c]);
        Add('"',',');
      end;
    end;
    CancelLastComma;
    dec(fHumanReadableLevel);
    HR;
    Add(']');
    if woFullExpand in Options then
      Add('}');
    exit;
  end;
  end;
  // handle JSON object
  Add('{');
  inc(fHumanReadableLevel);
  if woStoreClassName in Options then begin // optional "ClassName":"TObjectClass"
    HR;
    AddPropName('ClassName');
    Add('"');
    AddShort(PShortString(PPointer(PPtrInt(Value)^+vmtClassName)^)^);
    Add('"',',');
  end;
  if IsObj in [oSQLRecord,oSQLMany] then begin // add TSQLRecord.ID property
    HR;
    AddPropName('ID');
    if woHumanReadable in Options then
      Add(' ');
    Add(TSQLRecord(Value).fID);
    Add(',');
    if woIDAsIDstr in Options then begin
      AddPropName('ID_str');
      Add('"');
      Add(TSQLRecord(Value).fID);
      Add('"',',');
    end;
  end else begin
    if woStorePointer in Options then begin
      HR;
      AddPropName('Address'); // "Address":"0431298a" field
      Add('"');
      if (IsObj=oSynException) and (ESynException(Value).RaisedAt<>nil) then
        TSynMapFile.Log(self,PtrUInt(ESynException(Value).RaisedAt),false) else
        AddPointer(PtrUInt(Value));
      Add('"',',');
    end;
    case IsObj of
    oException: begin
      HR;
      AddPropName('Message'); // not published property -> manual serialization
      Add('"');
      AddJSONEscapeString(Exception(Value).Message);
      Add('"',',');
    end;
    end;
  end;
  if IsObj=oCustomPropName then begin
    if parser^.Props=nil then // has been unregistered
      WritePropsFromRTTI(aClassType) else
      if woDontStoreInherited in Options then
        raise EParsingException.CreateUTF8('%.WriteObject woDontStoreInherited '+
          'after RegisterCustomSerializerFieldNames(%)', [self,aClassType]) else
        for i := 0 to length(parser^.Props)-1 do begin
          CustomPropName := @parser^.Fields[i];
          WriteProp(parser^.Props[i]);
        end;
  end else
    WritePropsFromRTTI(aClassType);
  CancelLastComma;
  dec(fHumanReadableLevel);
  HR;
  Add('}');
  if woFullExpand in Options then
    Add('}');
end;

procedure TJSONSerializer.SetSQLRecordOptions(Value: TJSONSerializerSQLRecordOptions);
begin
  fSQLRecordOptions := Value;
  if Value*[jwoAsJsonNotAsString,jwoID_str]<>[] then
    if (ColNames<>nil) and (ColNames[0]='"RowID":') then
      ColNames[0] := '"ID":'; // as expected by AJAX
end;


{ TSQLVirtualTableModule }

constructor TSQLVirtualTableModule.Create(aTableClass: TSQLVirtualTableClass;
  aServer: TSQLRestServer);
begin
  fTableClass := aTableClass;
  fServer := aServer;
  fTableClass.GetTableModuleProperties(fFeatures);
  fModuleName := fTableClass.ModuleName;
  if fFeatures.FileExtension='' then // default extension is the module name
    fFeatures.FileExtension := UTF8ToString(LowerCase(fModuleName));
end;

function TSQLVirtualTableModule.FileName(const aTableName: RawUTF8): TFileName;
begin
  result := UTF8ToString(aTableName)+'.'+FileExtension;;
  if fFilePath='' then
    result := ExeVersion.ProgramFilePath+result else
    result := IncludeTrailingPathDelimiter(fFilePath)+result;
end;


{ TSQLVirtualTable }

constructor TSQLVirtualTable.Create(aModule: TSQLVirtualTableModule;
  const aTableName: RawUTF8; FieldCount: integer; Fields: PPUTF8CharArray);
var aClass: TSQLRestStorageClass;
    aServer: TSQLRestServer;
begin
  if (aModule=nil) or (aTableName='') then
    raise EModelException.CreateUTF8('Invalid %.Create(%,"%")',[self,aModule,aTableName]);
  fModule := aModule;
  fTableName := aTableName;
  if fModule.fFeatures.StaticClass<>nil then begin
    // create new fStatic instance e.g. for TSQLVirtualTableLog
    aServer := fModule.Server;
    if aServer=nil then
      raise EModelException.CreateUTF8('%.Server=nil for %.Create',[Module,self]) else
    fStaticTableIndex := aServer.Model.GetTableIndex(aTableName);
    if fStaticTableIndex>=0 then begin
      fStaticTable := aServer.Model.Tables[fStaticTableIndex];
      aClass := fModule.fFeatures.StaticClass;
      if aClass.InheritsFrom(TSQLRestStorageInMemory) then
        fStatic := TSQLRestStorageInMemoryClass(aClass).Create(fStaticTable,
          fModule.Server,fModule.FileName(aTableName),
          self.InheritsFrom(TSQLVirtualTableBinary)) else
        fStatic := aClass.Create(fStaticTable,fModule.Server);
      if length(aServer.fStaticVirtualTable)<>length(aServer.Model.Tables) then
        SetLength(aServer.fStaticVirtualTable,length(aServer.Model.Tables));
      aServer.fStaticVirtualTable[fStaticTableIndex] := fStatic;
      fStaticStorage := TSQLRestStorage(fStatic);
      fStaticStorage.fStorageVirtual := self;
    end;
  end;
end;

destructor TSQLVirtualTable.Destroy;
var t,n: cardinal;
begin
  if fStatic<>nil then begin
    if (Module<>nil) and (Module.Server<>nil) then
      with Module.Server do begin // temporary release (e.g. backup)
        t := Model.GetTableIndex(TableName);
        n := length(fStaticVirtualTable);
        if t<n then begin
          fStaticVirtualTable[t] := nil;
          if IsZero(pointer(fStaticVirtualTable),n*SizeOf(pointer)) then
            fStaticVirtualTable := nil;
        end;
      end;
    fStatic.Free;
  end;
  inherited;
end;

function TSQLVirtualTable.Prepare(var Prepared: TSQLVirtualTablePrepared): boolean;
begin
  result := Self<>nil;
  if result then
    if (vtWhereIDPrepared in fModule.Features) and
       Prepared.IsWhereIDEquals(true) then
    with Prepared.Where[0] do begin // check ID=?
      Value.VType := ftNull; // mark TSQLVirtualTableCursorJSON expects it
      OmitCheck := true;
      Prepared.EstimatedCost := costPrimaryIndex;
      Prepared.EstimatedRows := 1;
    end else begin
      Prepared.EstimatedCost := costFullScan;
      Prepared.EstimatedRows := 1000000;
    end;
end;

function TSQLVirtualTable.Drop: boolean;
begin
  result := false;  // no DROP TABLE to be implemented here
end;

function TSQLVirtualTable.Delete(aRowID: Int64): boolean;
begin
  result := false;  // no DELETE to be implemented here
end;

function TSQLVirtualTable.Insert(aRowID: Int64;
  var Values: TSQLVarDynArray; out insertedRowID: Int64): boolean;
begin
  result := false;  // no INSERT to be implemented here
end;

function TSQLVirtualTable.Update(oldRowID, newRowID: Int64;
  var Values: TSQLVarDynArray): boolean;
begin
  result := false;  // no UPDATE to be implemented here
end;

function TSQLVirtualTable.Transaction(aState: TSQLVirtualTableTransaction;
  aSavePoint: integer): boolean;
begin
  result := (Module<>nil) and (vtWrite in Module.Features) and
    (aState in [vttBegin, vttSync, vttCommit, vttSavePoint, vttRelease]);
end;

function TSQLVirtualTable.Rename(const NewName: RawUTF8): boolean;
begin
  result := false;
end;

class function TSQLVirtualTable.ModuleName: RawUTF8;
const LEN: array[-1..2] of byte = (1,16,11,4);
begin
  if self=nil then
    result := '' else begin
    ToText(self,result);
    system.delete(result,1,LEN[IdemPCharArray(pointer(result),
      ['TSQLVIRTUALTABLE','TSQLVIRTUAL','TSQL'])]);
  end;
end;

class function TSQLVirtualTable.StructureFromClass(aClass: TSQLRecordClass;
  const aTableName: RawUTF8): RawUTF8;
begin
  FormatUTF8('CREATE TABLE % (%',[aTableName,
    GetVirtualTableSQLCreate(aClass.RecordProps)],result);
end;

function TSQLVirtualTable.Structure: RawUTF8;
begin
  result := '';
  if Self<>nil then
    if (Static<>nil) then
      // e.g. for TSQLVirtualTableJSON or TSQLVirtualTableExternal
      Result := StructureFromClass(StaticTable,TableName) else
    if (Module<>nil) and (Module.RecordClass<>nil) then
      // e.g. for TSQLVirtualTableLog
      Result := StructureFromClass(Module.RecordClass,TableName);
end;


{ TSQLVirtualTableCursor }

constructor TSQLVirtualTableCursor.Create(aTable: TSQLVirtualTable);
begin
  fTable := aTable;
end;

procedure TSQLVirtualTableCursor.SetColumn(var aResult: TSQLVar; aValue: Int64);
begin
  aResult.Options := [];
  aResult.VType := ftInt64;
  aResult.VInt64 := aValue;
end;

procedure TSQLVirtualTableCursor.SetColumn(var aResult: TSQLVar; const aValue: double);
begin
  aResult.Options := [];
  aResult.VType := ftDouble;
  aResult.VDouble := aValue;
end;

procedure TSQLVirtualTableCursor.SetColumn(var aResult: TSQLVar; const aValue: RawUTF8);
begin
  aResult.Options := [];
  aResult.VType := ftUTF8;
  fColumnTemp := aValue; // temporary copy available until next Column() call
  aResult.VText := pointer(fColumnTemp);
end;

procedure TSQLVirtualTableCursor.SetColumn(var aResult: TSQLVar;
  aValue: PUTF8Char; aValueLength: integer);
begin
  aResult.Options := [];
  aResult.VType := ftUTF8;
  FastSetString(RawUTF8(fColumnTemp),aValue,aValueLength); // temporary copy
  aResult.VText := pointer(fColumnTemp);
end;

procedure TSQLVirtualTableCursor.SetColumnBlob(var aResult: TSQLVar;
  aValue: pointer; aValueLength: integer);
begin
  aResult.Options := [];
  aResult.VType := ftBlob;
  SetString(fColumnTemp,PAnsiChar(aValue),aValueLength); // temporary copy
  aResult.VBlob := pointer(fColumnTemp);
  aResult.VBlobLen := aValueLength;
end;

procedure TSQLVirtualTableCursor.SetColumnDate(var aResult: TSQLVar; const aValue: TDateTime;
  aWithMS: boolean);
begin
  if aWithMS then
    aResult.Options := [svoDateWithMS] else
    aResult.Options := [];
  aResult.VType := ftDate;
  aResult.VDateTime := aValue;
end;

procedure TSQLVirtualTableCursor.SetColumnCurr64(var aResult: TSQLVar; aValue64: PInt64);
begin
  aResult.Options := [];
  aResult.VType := ftCurrency;
  PInt64(@aResult.VCurrency)^ := aValue64^;
end;



{ TSQLVirtualTableCursorIndex }

function TSQLVirtualTableCursorIndex.HasData: boolean;
begin
  result := (self<>nil) and (fCurrent<=fMax);
end;

function TSQLVirtualTableCursorIndex.Next: boolean;
begin
  if self=nil then
    result := false else begin
    if fCurrent<=fMax then
      inc(fCurrent);
    result := true;
  end;
end;

function TSQLVirtualTableCursorIndex.Search(const Prepared: TSQLVirtualTablePrepared): boolean;
begin
  fCurrent := 0; // mark EOF by default
  fMax := -1;
  result := true;
end;


{ TSQLVirtualTablePrepared }

function TSQLVirtualTablePrepared.IsWhereIDEquals(CalledFromPrepare: Boolean): boolean;
begin
  result := (WhereCount=1) and (Where[0].Column=VIRTUAL_TABLE_ROWID_COLUMN) and
     (CalledFromPrepare or (Where[0].Value.VType=ftInt64)) and
     (Where[0].Operation=soEqualTo);
end;

function TSQLVirtualTablePrepared.IsWhereOneFieldEquals: boolean;
begin
  result := (WhereCount=1) and (Where[0].Column>=0) and
     (Where[0].Operation=soEqualTo);
end;


{ TSQLVirtualTableJSON }

constructor TSQLVirtualTableJSON.Create(aModule: TSQLVirtualTableModule;
  const aTableName: RawUTF8; FieldCount: integer; Fields: PPUTF8CharArray);
begin
  inherited Create(aModule,aTableName,FieldCount,Fields);
  fStaticInMemory := fStatic as TSQLRestStorageInMemory;
end;

function TSQLVirtualTableJSON.Delete(aRowID: Int64): boolean;
begin
  result := (Static<>nil) and Static.Delete(StaticTable,aRowID);
  if result and (StaticStorage<>nil) and (StaticStorage.Owner<>nil) then
    StaticStorage.Owner.fCache.NotifyDeletion(StaticTable,aRowID);
end;

function TSQLVirtualTableJSON.Drop: boolean;
begin
  if (self<>nil) and (Static<>nil) then begin
    fStaticInMemory.RollBack(0); // close any pending transaction
    fStaticInMemory.DropValues({andupdatefile=}true);
    result := true;
  end else
    result := false;
end;

class procedure TSQLVirtualTableJSON.GetTableModuleProperties(
  var aProperties: TVirtualTableModuleProperties);
begin
  aProperties.Features := [vtWrite,vtWhereIDPrepared];
  aProperties.CursorClass := TSQLVirtualTableCursorJSON;
  aProperties.StaticClass := TSQLRestStorageInMemoryExternal; // will flush Cache
  if InheritsFrom(TSQLVirtualTableBinary) then
    aProperties.FileExtension := 'data';
  // default will follow the class name, e.g. '.json' for TSQLVirtualTableJSON
end;

function TSQLVirtualTableJSON.Insert(aRowID: Int64;
  var Values: TSQLVarDynArray; out insertedRowID: Int64): boolean;
var aRecord: TSQLRecord;
begin
  result := false;
  if (self=nil) or (Static=nil) then
    exit;
  aRecord := StaticTable.Create;
  try
    if aRecord.SetFieldSQLVars(Values) then begin
      if aRowID>0 then
        aRecord.fID := aRowID;
      insertedRowID := fStaticInMemory.AddOne(aRecord,aRowID>0,
        aRecord.GetJSONValues(true,false,soInsert));
      if insertedRowID>0 then begin
        if fStaticInMemory.Owner<>nil then
          fStaticInMemory.Owner.fCache.Notify(aRecord,soInsert);
        result := true;
      end;
    end;
  finally
    if not result then
      aRecord.Free; // on success, aRecord will stay in Values[]
  end;
end;

function TSQLVirtualTableJSON.Prepare(var Prepared: TSQLVirtualTablePrepared): boolean;
begin
  result := inherited Prepare(Prepared); // optimize ID=? WHERE clause
  if result and (Static<>nil) then begin
    if Prepared.IsWhereOneFieldEquals then
    with Prepared.Where[0] do
    if (Column>=0) and (Column in fStaticInMemory.fIsUnique) then begin
      Value.VType := ftNull; // mark TSQLVirtualTableCursorJSON expects it
      OmitCheck := true;
      Prepared.EstimatedCost := costSecondaryIndex;
      Prepared.EstimatedRows := 10;
    end else
      if Prepared.EstimatedCost in [costFullScan,costScanWhere] then
        Prepared.EstimatedRows := fStaticInMemory.Count;
  end;
end;

function TSQLVirtualTableJSON.Update(oldRowID, newRowID: Int64;
  var Values: TSQLVarDynArray): boolean;
var i: PtrInt;
begin
  result := false;
  if (self=nil) or (Static=nil) or
     (oldRowID<>newRowID) or (newRowID<=0) then // don't allow ID change
    exit;
    if fStaticInMemory.UpdateOne(newRowID,Values) then begin
      if (fStaticInMemory.Owner<>nil) then begin
        i := fStaticInMemory.IDToIndex(newRowID);
        if i>=0 then
          fStaticInMemory.Owner.fCache.Notify(fStaticInMemory.fValue[i],soUpdate);
      end;
      result := true;
    end;
end;


{ TSQLVirtualTableCursorJSON }

function TSQLVirtualTableCursorJSON.Column(aColumn: integer;
  var aResult: TSQLVar): boolean;
var store: TSQLRestStorageInMemory;
begin
  if (self=nil) or (fCurrent>fMax) or
     (TSQLVirtualTableJSON(Table).Static=nil) then begin
    result := false;
    exit;
  end;
  store := TSQLVirtualTableJSON(Table).fStaticInMemory;
  if Cardinal(fCurrent)>=Cardinal(store.fCount) then
    result := false else begin
    if aColumn=VIRTUAL_TABLE_ROWID_COLUMN then begin
      aResult.VType := ftInt64;
      aResult.VInt64 := store.fValue[fCurrent].fID;
    end else
    with store.fStoredClassRecordProps.Fields do
      if cardinal(aColumn)>=cardinal(Count) then
        aResult.VType := ftNull else
        List[aColumn].GetFieldSQLVar(store.fValue[fCurrent],aResult,fColumnTemp);
    result := true;
  end;
end;

function TSQLVirtualTableCursorJSON.Search(const Prepared: TSQLVirtualTablePrepared): boolean;
var store: TSQLRestStorageInMemory;
begin
  result := false;
  inherited Search(Prepared); // mark EOF by default
  if not Table.InheritsFrom(TSQLVirtualTableJSON) then
    exit;
  store := TSQLVirtualTableJSON(Table).fStaticInMemory;
  if store=nil then
    exit;
  if store.fCount>0 then
    // if something to search in
    if Prepared.IsWhereIDEquals(false) then begin // ID=?
      fMax := store.IDToIndex(Prepared.Where[0].Value.VInt64); // binary search
      if fMax>=0 then
        fCurrent := fMax; // ID found
    end else begin
      fMax := store.fCount-1; // loop all records in ID order by default
      if Prepared.IsWhereOneFieldEquals then
      with Prepared.Where[0] do
        if Column in store.fIsUnique then begin
          store.fStoredClassRecordProps.Fields.List[Column].
            SetFieldSQLVar(store.fSearchRec,Value);
          fMax := store.fUnique[Column].Find(store.fSearchRec);
          if fMax>=0 then
            fCurrent := fMax; // value found with O(1) search
      end;
    end;
  result := true; // no DB error
end;


{ TSQLVirtualTableLog }

type
  /// Record associated to Virtual Table implemented in Delphi, for Read/Only
  // access to a .log file, as created by TSynLog
  // - not used as real instances, but only used by the TSQLVirtualTableLog module
  // to provide the field layout needed to create the column layout for the
  // CREATE TABLE statement
  TSQLRecordLogFile = class(TSQLRecordVirtualTableAutoID)
  protected
    fContent: RawUTF8;
    fDateTime: TDateTime;
    fLevel: TSynLogInfo;
  published
    /// the log event time stamp
    property DateTime: TDateTime read fDateTime;
    /// the log event level
    property Level: TSynLogInfo read fLevel;
    /// the textual message associated to the log event
    property Content: RawUTF8 read fContent;
  end;


constructor TSQLVirtualTableLog.Create(aModule: TSQLVirtualTableModule;
  const aTableName: RawUTF8; FieldCount: integer; Fields: PPUTF8CharArray);
var aFileName: TFileName;
begin
  inherited Create(aModule,aTableName,Fieldcount,Fields);
  if (FieldCount=1) then
    aFileName := UTF8ToString(Fields[0]) else
    aFileName := aModule.FileName(aTableName);
  fLogFile := TSynLogFile.Create(aFileName);
end;

destructor TSQLVirtualTableLog.Destroy;
begin
  fLogFile.Free;
  inherited;
end;

class procedure TSQLVirtualTableLog.GetTableModuleProperties(
  var aProperties: TVirtualTableModuleProperties);
begin
  aProperties.Features := [vtWhereIDPrepared];
  aProperties.CursorClass := TSQLVirtualTableCursorLog;
  aProperties.RecordClass := TSQLRecordLogFile;
end;


{ TSQLVirtualTableCursorLog }

function TSQLVirtualTableCursorLog.Column(aColumn: integer;
  var aResult: TSQLVar): boolean;
var LogFile: TSynLogFile;
begin
  result := false;
  if (self=nil) or (fCurrent>fMax) then
    exit;
  LogFile := TSQLVirtualTableLog(Table).fLogFile;
  if LogFile=nil then
    exit;
  case aColumn of
   -1: SetColumn(aResult,fCurrent+1); // ID = row index + 1
    0: SetColumnDate(aResult,LogFile.EventDateTime(fCurrent),true);
    1: SetColumn(aResult,ord(LogFile.EventLevel[fCurrent]));
    2: SetColumn(aResult,LogFile.LinePointers[fCurrent],LogFile.LineSize(fCurrent));
    else exit;
  end;
  result := true;
end;

function TSQLVirtualTableCursorLog.Search(
  const Prepared: TSQLVirtualTablePrepared): boolean;
begin
  result := inherited Search(Prepared); // mark EOF by default
  if result then begin
    fMax := TSQLVirtualTableLog(Table).fLogFile.Count-1; // search all range
    if Prepared.IsWhereIDEquals(false) then begin
      fCurrent := Prepared.Where[0].Value.VInt64-1; // ID=? -> index := ID-1
      if cardinal(fCurrent)<=cardinal(fMax) then
        fMax := fCurrent else // found one
        fMax := fCurrent-1;   // out of range ID
    end;
  end;
end;


{ TAuthSession }

procedure TAuthSession.ComputeProtectedValues;
begin // here User.GroupRights and fPrivateKey should have been set
  fTimeOutShr10 := (QWord(User.GroupRights.SessionTimeout)*(1000*60))shr 10;
  fTimeOutTix := GetTickCount64 shr 10+fTimeOutShr10;
  fAccessRights := User.GroupRights.SQLAccessRights;
  fPrivateSalt := fID+'+'+fPrivateKey;
  fPrivateSaltHash :=
    crc32(crc32(0,pointer(fPrivateSalt),length(fPrivateSalt)),
      pointer(User.PasswordHashHexa),length(User.PasswordHashHexa));
end;

constructor TAuthSession.Create(aCtxt: TSQLRestServerURIContext; aUser: TSQLAuthUser);
var GID: TSQLAuthGroup;
    rnd: THash256;
begin
  fUser := aUser;
  if (aCtxt<>nil) and (User<>nil) and (User.fID<>0) then begin
    GID := User.GroupRights; // save pseudo TSQLAuthGroup = ID
    User.GroupRights := aCtxt.Server.fSQLAuthGroupClass.Create(aCtxt.Server,GID);
    if User.GroupRights.fID<>0 then begin
      // compute the next Session ID
      with aCtxt.Server do begin
        if fSessionCounter>=cardinal(maxInt) then
          fSessionCounter := 10 else
          if fSessionCounter=75 then // avoid IDCardinal=0 (77) or 1 (76)
            fSessionCounter := 78 else
            inc(fSessionCounter);
          fIDCardinal := fSessionCounter xor 77;
          UInt32ToUtf8(fIDCardinal,fID);
      end;
      // set session parameters
      TAESPRNG.Main.Fill(@rnd,SizeOf(rnd));
      fPrivateKey := BinToHex(@rnd,SizeOf(rnd));
      if not (rsoGetUserRetrieveNoBlobData in aCtxt.Server.Options) then
        aCtxt.Server.RetrieveBlob(aCtxt.Server.fSQLAuthUserClass,User.fID,'Data',User.fData);
      if (aCtxt.Call<>nil) and (aCtxt.Call.InHead<>'') then
        fSentHeaders := aCtxt.Call.InHead;
      ComputeProtectedValues;
      fRemoteIP := aCtxt.RemoteIP;
      {$ifdef WITHLOG}
      aCtxt.Log.Log(sllUserAuth,
        'New [%] session %/% created at %/% running %',
        [User.GroupRights.Ident,User.LogonName,fIDCardinal,fRemoteIP,
         aCtxt.Call^.LowLevelConnectionID,aCtxt.GetUserAgent],self);
      {$endif}
      exit; // create successfull
    end;
    // on error: set GroupRights back to a pseudo TSQLAuthGroup = ID
    User.GroupRights.Free;
    User.GroupRights := GID;
  end;
  raise ESecurityException.CreateUTF8('Invalid %.Create(%,%)',[self,aCtxt,aUser]);
end;

destructor TAuthSession.Destroy;
begin
  if User<>nil then begin
    User.GroupRights.Free;
    fUser.Free;
  end;
  ObjArrayClear(fMethods);
  ObjArrayClear(fInterfaces);
  inherited;
end;

function TAuthSession.GetUserName: RawUTF8;
begin
  if User=nil then
    result := '' else
    result := User.LogonName;
end;

function TAuthSession.GetUserID: TID;
begin
  if User=nil then
    result := 0 else
    result := User.fID;
end;

function TAuthSession.GetGroupID: TID;
begin
  if User=nil then
    result := 0 else
    result := User.GroupRights.ID;
end;

const TAUTHSESSION_MAGIC = 1;

procedure TAuthSession.SaveTo(W: TFileBufferWriter);
begin
  W.Write1(TAUTHSESSION_MAGIC);
  W.WriteVarUInt32(IDCardinal);
  W.WriteVarUInt32(fUser.fID);
  fUser.GetBinaryValues(W); // User.fGroup is a pointer, but will be overriden
  W.WriteVarUInt32(fUser.GroupRights.fID);
  fUser.GroupRights.GetBinaryValues(W);
  W.Write(fPrivateKey);
  W.Write(fSentHeaders);
end; // TODO: persist ORM/SOA stats? -> rather integrate them before saving

constructor TAuthSession.CreateFrom(var P: PAnsiChar; PEnd: PAnsiChar; Server: TSQLRestServer);
  procedure RaiseError;
  begin
    raise ESynException.CreateUTF8('%.CreateFrom() with invalid format',[self]);
  end;
var PB: PByte absolute P;
    i32: cardinal;
begin
  if PB^=TAUTHSESSION_MAGIC then
    inc(PB) else
    RaiseError;
  PB := FromVarUInt32Safe(PB,pointer(PEnd),fIDCardinal);
  if PB=nil then
    RaiseError;
  UInt32ToUtf8(fIDCardinal,fID);
  fUser := Server.SQLAuthUserClass.Create;
  PB := FromVarUInt32Safe(PB,pointer(PEnd),i32);
  if PB=nil then
    RaiseError;
  fUser.fID := i32;
  fUser.SetBinaryValues(P,PEnd); // fUser.fGroup will be overriden by true instance
  fUser.fGroup := Server.SQLAuthGroupClass.Create;
  PB := FromVarUInt32Safe(PB,pointer(PEnd),i32);
  if PB=nil then
    RaiseError;
  fUser.fGroup.fID := i32;
  fUser.fGroup.SetBinaryValues(P,PEnd);
  fPrivateKey := FromVarString(PB,pointer(PEnd));
  fSentHeaders := FromVarString(PB,pointer(PEnd));
  if PB=nil then
    RaiseError;
  ComputeProtectedValues;
  FindNameValue(fSentHeaders,HEADER_REMOTEIP_UPPER,fRemoteIP);
end;


{ TSQLAccessRights }

procedure TSQLAccessRights.Edit(aTableIndex: integer; C, R, U, D: Boolean);
begin
  if C then
    Include(POST,aTableIndex) else
    Exclude(POST,aTableindex);
  if R then
    Include(GET,aTableIndex) else
    Exclude(GET,aTableindex);
  if U then
    Include(PUT,aTableIndex) else
    Exclude(PUT,aTableindex);
  if D then
    Include(DELETE,aTableIndex) else
    Exclude(DELETE,aTableindex);
end;

procedure TSQLAccessRights.Edit(aTableIndex: integer; aRights: TSQLOccasions);
begin
  if soInsert in aRights then
    Include(POST,aTableIndex) else
    Exclude(POST,aTableindex);
  if soSelect in aRights then
    Include(GET,aTableIndex) else
    Exclude(GET,aTableindex);
  if soUpdate in aRights then
    Include(PUT,aTableIndex) else
    Exclude(PUT,aTableindex);
  if soDelete in aRights then
    Include(DELETE,aTableIndex) else
    Exclude(DELETE,aTableindex);
end;

procedure TSQLAccessRights.Edit(aModel: TSQLModel; aTable: TSQLRecordClass;
  C, R, U, D: Boolean);
begin
  Edit(aModel.GetTableIndexExisting(aTable),C,R,U,D);
end;

procedure TSQLAccessRights.Edit(aModel: TSQLModel; aTable: TSQLRecordClass;
  aRights: TSQLOccasions);
begin
  Edit(aModel.GetTableIndexExisting(aTable),aRights);
end;

procedure TSQLAccessRights.FromString(P: PUTF8Char);
begin
  FillCharFast(self,SizeOf(self),0);
  if P=nil then
    exit;
  AllowRemoteExecute := TSQLAllowRemoteExecute(byte(GetNextItemCardinal(P)));
  SetBitCSV(GET,MAX_SQLTABLES,P);
  SetBitCSV(POST,MAX_SQLTABLES,P);
  SetBitCSV(PUT,MAX_SQLTABLES,P);
  SetBitCSV(DELETE,MAX_SQLTABLES,P);
end;

function TSQLAccessRights.ToString: RawUTF8;
begin
  FormatUTF8('%,%,%,%,%', [Byte(AllowRemoteExecute),
     GetBitCSV(GET,MAX_SQLTABLES), GetBitCSV(POST,MAX_SQLTABLES),
     GetBitCSV(PUT,MAX_SQLTABLES), GetBitCSV(DELETE,MAX_SQLTABLES)],result);
end;

function TSQLAccessRights.CanExecuteORMWrite(Method: TSQLURIMethod;
  Table: TSQLRecordClass; TableIndex: integer; const TableID: TID;
  Context: TSQLRestServerURIContext): boolean;
begin
  result := true;
  case Method of
  mPOST:   // POST=ADD=INSERT
    if Table<>nil then  // ExecuteORMWrite will check reSQL access right
      result := (TableIndex in POST);
  mPUT:    // PUT=UPDATE
    result := (Table<>nil) and
     ((TableIndex in PUT) or
      ((TableID>0) and (Context.Session>CONST_AUTHENTICATION_NOT_USED) and
       (Table=Context.Server.fSQLAuthUserClass) and (TableID=Context.SessionUser) and
       (reUserCanChangeOwnPassword in AllowRemoteExecute)));
  mDelete:
    result := (Table<>nil) and (TableIndex in DELETE) and
      ((TableID>0) or (reUrlEncodedDelete in AllowRemoteExecute));
  end;
end;


{ TSQLAuthGroup }

function TSQLAuthGroup.GetSQLAccessRights: TSQLAccessRights;
begin
  if self=nil then
    FillCharFast(result,SizeOf(result),0) else
    result.FromString(pointer(AccessRights));
end;

class procedure TSQLAuthGroup.InitializeTable(Server: TSQLRestServer;
  const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
var G: TSQLAuthGroup;
    A: TSQLAccessRights;
    U: TSQLAuthUser;
    AuthUserIndex, AuthGroupIndex: integer;
    AdminID, SupervisorID, UserID: PtrInt;
begin
  inherited; // will create any needed index
  if (Server<>nil) and (FieldName='') then
    if Server.HandleAuthentication then begin
      // create default Groups and Users (we are already in a Transaction)
      AuthGroupIndex := Server.Model.GetTableIndexExisting(Server.fSQLAuthUserClass);
      AuthUserIndex := Server.Model.GetTableIndexExisting(Server.fSQLAuthGroupClass);
      if not (itoNoAutoCreateGroups in Options) then begin
        G := Server.fSQLAuthGroupClass.Create;
        try
          //            POSTSQL SELECTSQL Service AuthR AuthW TablesR TablesW
          // Admin        Yes     Yes       Yes    Yes   Yes    Yes    Yes
          // Supervisor   No      Yes       Yes    Yes   No     Yes    Yes
          // User         No      No        Yes    No    No     Yes    Yes
          // Guest        No      No        No     No    No     Yes    No
          A := FULL_ACCESS_RIGHTS;
          G.Ident := 'Admin';
          G.SQLAccessRights := A;
          G.SessionTimeout := AuthAdminGroupDefaultTimeout;
          AdminID := Server.Add(G,true);
          G.Ident := 'Supervisor';
          A.AllowRemoteExecute := SUPERVISOR_ACCESS_RIGHTS.AllowRemoteExecute;
          A.Edit(AuthUserIndex,[soSelect]); // AuthUser  R/O
          A.Edit(AuthGroupIndex,[soSelect]); // AuthGroup R/O
          G.SQLAccessRights := A;
          G.SessionTimeout := AuthSupervisorGroupDefaultTimeout;
          SupervisorID := Server.Add(G,true);
          G.Ident := 'User';
          Exclude(A.AllowRemoteExecute,reSQLSelectWithoutTable);
          Exclude(A.GET,AuthUserIndex); // no Auth R
          Exclude(A.GET,AuthGroupIndex);
          G.SQLAccessRights := A;
          G.SessionTimeout := AuthUserGroupDefaultTimeout;
          UserID := Server.Add(G,true);
          G.Ident := 'Guest';
          A.AllowRemoteExecute := [];
          FillcharFast(A.POST,SizeOf(TSQLFieldTables),0); // R/O access
          FillcharFast(A.PUT,SizeOf(TSQLFieldTables),0);
          FillcharFast(A.DELETE,SizeOf(TSQLFieldTables),0);
          G.SQLAccessRights := A;
          G.SessionTimeout := AuthGuestGroupDefaultTimeout;
          Server.Add(G,true);
        finally
          G.Free;
        end;
        if not (itoNoAutoCreateUsers in Options) and
           (Server.TableRowCount(Server.fSQLAuthUserClass)=0) then begin
          U := Server.fSQLAuthUserClass.Create;
          try
            U.LogonName := 'Admin';
            U.PasswordHashHexa := AuthAdminDefaultPassword;
            U.DisplayName := U.LogonName;
            U.GroupRights := TSQLAuthGroup(AdminID);
            Server.Add(U,true);
            U.LogonName := 'Supervisor';
            U.PasswordHashHexa := AuthSupervisorDefaultPassword;
            U.DisplayName := U.LogonName;
            U.GroupRights := TSQLAuthGroup(SupervisorID);
            Server.Add(U,true);
            U.LogonName := 'User';
            U.PasswordHashHexa := AuthUserDefaultPassword;
            U.DisplayName := U.LogonName;
            U.GroupRights := TSQLAuthGroup(UserID);
            Server.Add(U,true);
          finally
            U.Free;
          end;
        end;
      end;
    end;
end;

procedure TSQLAuthGroup.SetSQLAccessRights(const Value: TSQLAccessRights);
begin
  if self<>nil then
    AccessRights := Value.ToString;
end;


{ TSQLAuthUser }

class function TSQLAuthUser.ComputeHashedPassword(
  const aPasswordPlain, aHashSalt: RawUTF8; aHashRound: integer): RawUTF8;
const TSQLAUTHUSER_SALT = 'salt';
var dig: TSHA256Digest;
begin
  if aHashSalt='' then
    result := SHA256(TSQLAUTHUSER_SALT+aPasswordPlain) else begin
    PBKDF2_HMAC_SHA256(aPasswordPlain,aHashSalt,aHashRound,dig);
    result := SHA256DigestToString(dig);
    FillCharFast(dig,SizeOf(dig),0);
  end;
end;

procedure TSQLAuthUser.SetPasswordPlain(const Value: RawUTF8);
begin
  if self<>nil then
    PasswordHashHexa := ComputeHashedPassword(Value);
end;

procedure TSQLAuthUser.SetPassword(const aPasswordPlain, aHashSalt: RawUTF8;
  aHashRound: integer);
begin
  if self<>nil then
    PasswordHashHexa := ComputeHashedPassword(aPasswordPlain,aHashSalt,aHashRound);
end;

function TSQLAuthUser.CanUserLog(Ctxt: TSQLRestServerURIContext): boolean;
begin
  result := true; // any existing TSQLAuthUser is allowed by default
end;


{ TSQLRestServerAuthentication }

constructor TSQLRestServerAuthentication.Create(aServer: TSQLRestServer);
begin
  fServer := aServer;
  fOptions := [saoUserByLogonOrID];
end;

function TSQLRestServerAuthentication.AuthSessionRelease(
  Ctxt: TSQLRestServerURIContext): boolean;
var aUserName: RawUTF8;
    aSessionID: cardinal;
    i: integer;
begin
  result := false;
  if fServer.fSessions=nil then
    exit;
  aUserName := Ctxt.InputUTF8OrVoid['UserName'];
  if aUserName='' then
    exit;
  aSessionID := Ctxt.InputIntOrVoid['Session'];
  if aSessionID=0 then
    aSessionID := Ctxt.InputHexaOrVoid['SessionHex'];
  if aSessionID=0 then
    exit;
  result := true; // recognized GET ModelRoot/auth?UserName=...&Session=...
  // allow only to delete its own session - ticket [7723fa7ebd]
  if aSessionID=Ctxt.Session then
    for i := 0 to fServer.fSessions.Count-1 do
      with TAuthSession(fServer.fSessions.List[i]) do
      if (fIDCardinal=aSessionID) and (fUser.LogonName=aUserName) then begin
        Ctxt.fSession := nil; // avoid GPF
        fServer.SessionDelete(i,Ctxt);
        Ctxt.Success;
        break;
      end;
end;

function TSQLRestServerAuthentication.GetUser(Ctxt: TSQLRestServerURIContext;
  const aUserName: RawUTF8): TSQLAuthUser;
var UserID: TID;
    err: integer;
begin
  UserID := GetInt64(pointer(aUserName),err);
  if (err<>0) or (UserID<=0) or not (saoUserByLogonOrID in fOptions) then
    UserID := 0;
  if Assigned(fServer.OnAuthenticationUserRetrieve) then
    result := fServer.OnAuthenticationUserRetrieve(self,Ctxt,UserID,aUserName) else begin
    if UserID<>0 then begin // try if TSQLAuthUser.ID was transmitted
      result := fServer.fSQLAuthUserClass.Create(fServer,UserID); // may use ORM cache :)
      if result.fID=0 then
        FreeAndNil(result);
    end else
      result := nil;
    if result=nil then
      result := fServer.fSQLAuthUserClass.Create(fServer,'LogonName=?',[aUserName]);
    if (result.fID=0) and
       (saoHandleUnknownLogonAsStar in fOptions) then
      if fServer.Retrieve('LogonName=?',[],['*'],result) then begin
        result.LogonName := aUserName;
        result.DisplayName := aUserName;
      end;
  end;
  if (result=nil) or (result.fID=0) then begin
    fServer.InternalLog('%.LogonName=% not found',[fServer.fSQLAuthUserClass,aUserName],sllUserAuth);
    FreeAndNil(result);
  end else
  if not result.CanUserLog(Ctxt) then begin
    fServer.InternalLog('%.CanUserLog(%) returned FALSE -> rejected',[result,aUserName],sllUserAuth);
    FreeAndNil(result);
  end;
end;

procedure TSQLRestServerAuthentication.SessionCreate(Ctxt: TSQLRestServerURIContext;
  var User: TSQLAuthUser);
var Session: TAuthSession;
begin
  if User<>nil then
  try // now client is authenticated -> create a session
    fServer.SessionCreate(User,Ctxt,Session); // call Ctxt.AuthenticationFailed on error
    if Session<>nil then
      SessionCreateReturns(Ctxt,Session,Session.fPrivateSalt,'','');
  finally
    User.Free;
  end;
end;

procedure TSQLRestServerAuthentication.SessionCreateReturns(
  Ctxt: TSQLRestServerURIContext; Session: TAuthSession; const result, data, header: RawUTF8);
var body: TDocVariantData;
begin
  body.InitFast(10,dvObject);
  if result='' then
    body.AddValue('result',Session.IDCardinal) else
    body.AddValue('result',RawUTF8ToVariant(result));
  if data<>'' then
    body.AddValue('data',RawUTF8ToVariant(data));
  if fAlgoName<>'' then // match e.g. TSQLRestServerAuthenticationSignedURIAlgo
    body.AddValue('algo',RawUTF8ToVariant(fAlgoName));
  with Session.User do
    body.AddNameValuesToObject(['logonid',IDValue,'logonname',LogonName,
      'logondisplay',DisplayName,'logongroup',GroupRights.IDValue,
      'timeout',GroupRights.SessionTimeout,
      'server',ExeVersion.ProgramName,'version',ExeVersion.Version.DetailedOrVoid]);
  Ctxt.ReturnsJson(variant(body),HTTP_SUCCESS,false,twJSONEscape,false,header);
end;

class function TSQLRestServerAuthentication.ClientGetSessionKey(
  Sender: TSQLRestClientURI; User: TSQLAuthUser; const aNameValueParameters: array of const): RawUTF8;
var resp: RawUTF8;
    values: array[0..9] of TValuePUTF8Char;
    a: integer;
    algo: TSQLRestServerAuthenticationSignedURIAlgo absolute a;
begin
  if (Sender.CallBackGet('Auth',aNameValueParameters,resp)<>HTTP_SUCCESS) or
     (JSONDecode(pointer(resp),['result','data','server','version','logonid',
      'logonname','logondisplay','logongroup','timeout','algo'],@values)=nil) then begin
    Sender.fSessionData := ''; // reset temporary 'data' field
    result := '';
  end else begin
    values[0].ToUTF8(result);
    Base64ToBin(PAnsiChar(values[1].Value),values[1].ValueLen,Sender.fSessionData);
    values[2].ToUTF8(Sender.fSessionServer);
    values[3].ToUTF8(Sender.fSessionVersion);
    SetID(values[4].Value,User.fID);
    values[5].ToUTF8(User.fLogonName); // set/fix using values from server
    values[6].ToUTF8(User.fDisplayName);
    User.GroupRights := pointer(values[7].ToInteger);
    Sender.fSessionServerTimeout := values[8].ToInteger;
    if Sender.fSessionServerTimeout<=0 then
      Sender.fSessionServerTimeout := 60; // default 1 hour if not suppplied
    a := GetEnumNameValueTrimmed(TypeInfo(TSQLRestServerAuthenticationSignedURIAlgo),
      values[9].Value,values[9].ValueLen);
    if a>=0 then
      Sender.fComputeSignature := TSQLRestServerAuthenticationSignedURI.GetComputeSignature(algo);
  end;
end;

class function TSQLRestServerAuthentication.ClientSetUser(Sender: TSQLRestClientURI;
  const aUserName, aPassword: RawUTF8; aPasswordKind: TSQLRestServerAuthenticationClientSetUserPassword;
  const aHashSalt: RawUTF8; aHashRound: integer): boolean;
var U: TSQLAuthUser;
    key: RawUTF8;
begin
  result := false;
  if Sender=nil then
    exit;
  try
    Sender.SessionClose;  // ensure Sender.SessionUser=nil
    U := TSQLAuthUser(Sender.Model.GetTableInherited(TSQLAuthUser).Create);
    try
      U.LogonName := trim(aUserName);
      U.DisplayName := U.LogonName;
      if aPasswordKind<>passClear then
        U.PasswordHashHexa := aPassword else
        if aHashSalt='' then
          U.PasswordPlain := aPassword else // compute SHA256('salt'+aPassword)
          U.SetPassword(aPassword,aHashSalt,aHashRound);
      key := ClientComputeSessionKey(Sender,U);
      result := Sender.SessionCreate(self,U,key);
    finally
      U.Free;
    end;
  finally
    if Assigned(Sender.OnSetUser) then
      Sender.OnSetUser(Sender); // always notify of user change, even if failed
  end;
end;


{ TSQLRestServerAuthenticationURI }

function TSQLRestServerAuthenticationURI.RetrieveSession(
  Ctxt: TSQLRestServerURIContext): TAuthSession;
begin
  result := nil;
  if (Ctxt=nil) or (Ctxt.URISessionSignaturePos=0) then
    exit;
  // expected format is 'session_signature='Hexa8(SessionID)'...
  if (Ctxt.URISessionSignaturePos>0) and
     (Ctxt.URISessionSignaturePos+(18+8)<=length(Ctxt.Call^.Url)) and
     HexDisplayToCardinal(PAnsiChar(pointer(Ctxt.Call^.url))+Ctxt.URISessionSignaturePos+18,Ctxt.Session) then
    result := fServer.SessionAccess(Ctxt);
end;

class procedure TSQLRestServerAuthenticationURI.ClientSessionSign(
  Sender: TSQLRestClientURI; var Call: TSQLRestURIParams);
begin
  if (Sender<>nil) and (Sender.fSessionID<>0) and (Sender.fSessionUser<>nil) then
    if PosExChar('?',Call.url)=0 then
      Call.url := Call.url+'?session_signature='+Sender.fSessionIDHexa8 else
      Call.url := Call.url+'&session_signature='+Sender.fSessionIDHexa8;
end;


{ TSQLRestServerAuthenticationSignedURI }

// expected format is session_signature=
// Hexa8(SessionID)+
// Hexa8(Timestamp)+
// Hexa8(crc32('SessionID+HexaSessionPrivateKey'+Sha256('salt'+PassWord)+
//             Hexa8(Timestamp)+url))

constructor TSQLRestServerAuthenticationSignedURI.Create(aServer: TSQLRestServer);
begin
  inherited Create(aServer);
  fComputeSignature := TSQLRestServerAuthenticationSignedURI.ComputeSignatureCrc32;
  TimestampCoherencySeconds := 5;
end;

procedure TSQLRestServerAuthenticationSignedURI.SetNoTimestampCoherencyCheck(
  value: boolean);
begin
  if self<>nil then
    fNoTimestampCoherencyCheck := value;
end;

procedure TSQLRestServerAuthenticationSignedURI.SetTimestampCoherencySeconds(
  value: cardinal);
begin
  if self=nil then
    exit;
  fTimestampCoherencySeconds := value;
  fTimestampCoherencyTicks := round(value*(1000/256)); // 256 ms resolution
end;

procedure TSQLRestServerAuthenticationSignedURI.SetAlgorithm(
  value: TSQLRestServerAuthenticationSignedURIAlgo);
begin
  fComputeSignature := GetComputeSignature(value);
  if value=suaCRC32 then
    fAlgoName := '' else
    fAlgoName := SynCommons.LowerCase(TrimLeftLowerCaseShort(ToText(value)));
end;

class function TSQLRestServerAuthenticationSignedURI.GetComputeSignature(
  algo: TSQLRestServerAuthenticationSignedURIAlgo): TSQLRestServerAuthenticationSignedURIComputeSignature;
begin // FPC doesn't allow to use constants for procedure of object
  case algo of
  suaCRC32C: result := ComputeSignatureCrc32c;
  suaXXHASH: result := ComputeSignaturexxHash;
  suaMD5:    result := ComputeSignatureMD5;
  suaSHA1:   result := ComputeSignatureSHA1;
  suaSHA256: result := ComputeSignatureSHA256;
  suaSHA512: result := ComputeSignatureSHA512;
  else       result := ComputeSignatureCrc32; // default/fallback
  end;
end;

class function TSQLRestServerAuthenticationSignedURI.ComputeSignatureCrc32(
  privatesalt: cardinal; timestamp, url: PAnsiChar; urllen: integer): cardinal;
begin // historical algorithm
  result := crc32(crc32(privatesalt,timestamp,8),url,urllen);
end;

class function TSQLRestServerAuthenticationSignedURI.ComputeSignatureCrc32c(
  privatesalt: cardinal; timestamp, url: PAnsiChar; urllen: integer): cardinal;
begin // faster on SSE4.2 CPU, and slightly more secure if not cascaded
  result := crc32c(privatesalt,timestamp,8) xor crc32c(privatesalt,url,urllen);
end;

class function TSQLRestServerAuthenticationSignedURI.ComputeSignaturexxHash(
  privatesalt: cardinal; timestamp, url: PAnsiChar; urllen: integer): cardinal;
begin // xxHash32 has no immediate reverse function
  result := xxHash32(privatesalt,timestamp,8) xor xxHash32(privatesalt,url,urllen);
end;

class function TSQLRestServerAuthenticationSignedURI.ComputeSignatureMD5(
  privatesalt: cardinal; timestamp, url: PAnsiChar; urllen: integer): cardinal;
var digest: THash128Rec;
    MD5: TMD5;
    i: integer;
begin
  MD5.Init;
  MD5.Update(privatesalt,4);
  MD5.Update(timestamp^,8);
  MD5.Update(url^,urllen);
  MD5.Final(digest.b);
  result := digest.c[0];
  for i := 1 to high(digest.c) do
    result := result xor digest.c[i];
end;

class function TSQLRestServerAuthenticationSignedURI.ComputeSignatureSHA1(
  privatesalt: cardinal; timestamp, url: PAnsiChar; urllen: integer): cardinal;
var digest: array[0..(SizeOf(TSHA1Digest)div 4)-1] of cardinal;
    SHA1: TSHA1;
    i: integer;
begin
  SHA1.Init;
  SHA1.Update(@privatesalt,4);
  SHA1.Update(timestamp,8);
  SHA1.Update(url,urllen);
  SHA1.Final(TSHA1Digest(digest));
  result := digest[0];
  for i := 1 to high(digest) do
    result := result xor digest[i];
end;

class function TSQLRestServerAuthenticationSignedURI.ComputeSignatureSHA256(
  privatesalt: cardinal; timestamp, url: PAnsiChar; urllen: integer): cardinal;
var digest: THash256Rec;
    SHA256: TSHA256;
    i: integer;
begin
  SHA256.Init;
  SHA256.Update(@privatesalt,4);
  SHA256.Update(timestamp,8);
  SHA256.Update(url,urllen);
  SHA256.Final(digest.b);
  result := digest.c[0];
  for i := 1 to high(digest.c) do
    result := result xor digest.c[i];
end;

class function TSQLRestServerAuthenticationSignedURI.ComputeSignatureSHA512(
  privatesalt: cardinal; timestamp, url: PAnsiChar; urllen: integer): cardinal;
var digest: THash512Rec;
    SHA512: TSHA512;
    i: integer;
begin
  SHA512.Init;
  SHA512.Update(@privatesalt,4);
  SHA512.Update(timestamp,8);
  SHA512.Update(url,urllen);
  SHA512.Final(digest.b);
  result := digest.c[0];
  for i := 1 to high(digest.c) do
    result := result xor digest.c[i];
end;

function TSQLRestServerAuthenticationSignedURI.RetrieveSession(
  Ctxt: TSQLRestServerURIContext): TAuthSession;
var aTimestamp, aSignature, aMinimalTimestamp, aExpectedSignature: cardinal;
    PTimestamp: PAnsiChar;
    aURLlength: Integer;
begin
  result := inherited RetrieveSession(Ctxt);
  if result=nil then
    exit; // no valid session ID in session_signature
  if Ctxt.URISessionSignaturePos+(18+8+8+8)>length(Ctxt.Call^.url) then begin
    result := nil;
    exit;
  end;
  aURLlength := Ctxt.URISessionSignaturePos-1;
  PTimestamp := @Ctxt.Call^.url[aURLLength+(20+8)]; // points to Hexa8(Timestamp)
  aMinimalTimestamp := result.fLastTimestamp-fTimestampCoherencyTicks;
  if HexDisplayToCardinal(PTimestamp,aTimestamp) and
     (fNoTimestampCoherencyCheck or (integer(aMinimalTimestamp)<0) or // <0 just after login
      (aTimestamp>=aMinimalTimestamp)) then begin
    aExpectedSignature := fComputeSignature(result.fPrivateSaltHash,PTimestamp,
      pointer(Ctxt.Call^.url),aURLlength);
    if HexDisplayToCardinal(PTimestamp+8,aSignature) and
       (aSignature=aExpectedSignature) then begin
      if aTimestamp>result.fLastTimestamp then
        result.fLastTimestamp := aTimestamp;
      exit;
    end else begin
      {$ifdef WITHLOG}
      Ctxt.Log.Log(sllUserAuth,'Invalid Signature: expected %, got %',
        [Int64(aExpectedSignature),Int64(aSignature)],self);
      {$endif}
    end;
  end else begin
    {$ifdef WITHLOG}
    Ctxt.Log.Log(sllUserAuth,'Invalid Timestamp: expected >=%, got %',
      [aMinimalTimestamp,Int64(aTimestamp)],self);
    {$endif}
  end;
  result := nil; // indicates invalid signature
end;

class procedure TSQLRestServerAuthenticationSignedURI.ClientSessionSign(
  Sender: TSQLRestClientURI; var Call: TSQLRestURIParams);
var nonce, blankURI: RawUTF8;
begin
  if (Sender=nil) or (Sender.fSessionID=0) or (Sender.fSessionUser=nil) then
    exit;
  blankURI := Call.Url;
  if PosExChar('?',Call.url)=0 then
    Call.url := Call.Url+'?session_signature=' else
    Call.url := Call.Url+'&session_signature=';
  with Sender do begin
    fSessionLastTick64 := GetTickCount64;
    nonce := CardinalToHexLower(fSessionLastTick64 shr 8); // 256 ms resolution
    Call.url := Call.url+fSessionIDHexa8+nonce+CardinalToHexLower(
      Sender.fComputeSignature(fSessionPrivateKey,Pointer(nonce),
        Pointer(blankURI),length(blankURI)));
  end;
end;


{ TSQLRestServerAuthenticationDefault }

function TSQLRestServerAuthenticationDefault.Auth(Ctxt: TSQLRestServerURIContext): boolean;
var aUserName, aPassWord, aClientNonce: RawUTF8;
    User: TSQLAuthUser;
begin
  result := true;
  if AuthSessionRelease(Ctxt) then
    exit;
  aUserName := Ctxt.InputUTF8OrVoid['UserName'];
  aPassWord := Ctxt.InputUTF8OrVoid['Password'];
  aClientNonce := Ctxt.InputUTF8OrVoid['ClientNonce'];
  if (aUserName<>'') and (length(aClientNonce)>32) then begin
    // GET ModelRoot/auth?UserName=...&PassWord=...&ClientNonce=... -> handshaking
    User := GetUser(Ctxt,aUserName);
    if User<>nil then
    try
      // check if match TSQLRestClientURI.SetUser() algorithm
      if CheckPassword(Ctxt,User,aClientNonce,aPassWord) then
        SessionCreate(Ctxt,User) else // will call Ctxt.AuthenticationFailed on error
        Ctxt.AuthenticationFailed(afInvalidPassword);
    finally
      User.Free;
    end else
      Ctxt.AuthenticationFailed(afUnknownUser);
  end else
    if aUserName<>'' then
      // only UserName=... -> return hexadecimal nonce content valid for 5 minutes
      Ctxt.Results([CurrentServerNonce]) else
      // parameters does not match any expected layout -> try next authentication
      result := false;
end;

function TSQLRestServerAuthenticationDefault.CheckPassword(Ctxt: TSQLRestServerURIContext;
  User: TSQLAuthUser; const aClientNonce, aPassWord: RawUTF8): boolean;
var aSalt: RawUTF8;
begin
  aSalt := aClientNonce+User.LogonName+User.PasswordHashHexa;
  result := IsHex(aPassword,SizeOf(THash256)) and
    (IdemPropNameU(aPassWord,SHA256(fServer.Model.Root+CurrentServerNonce(false)+aSalt)) or
     // if current nonce failed, tries with previous 5 minutes' nonce
     IdemPropNameU(aPassWord,SHA256(fServer.Model.Root+CurrentServerNonce(true)+aSalt)));
end;

class function TSQLRestServerAuthenticationDefault.ClientComputeSessionKey(
  Sender: TSQLRestClientURI; User: TSQLAuthUser): RawUTF8;
var aServerNonce, aClientNonce: RawUTF8;
    rnd: THash256;
begin
  result := '';
  if User.LogonName='' then
    exit;
  aServerNonce := Sender.CallBackGetResult('Auth',['UserName',User.LogonName]);
  if aServerNonce='' then
    exit;
  TAESPRNG.Main.FillRandom(@rnd,SizeOf(rnd));
  aClientNonce := BinToHexLower(@rnd,SizeOf(rnd));
  result := ClientGetSessionKey(Sender,User,['UserName',User.LogonName,'Password',
     Sha256(Sender.Model.Root+aServerNonce+aClientNonce+User.LogonName+User.PasswordHashHexa),
     'ClientNonce',aClientNonce]);
end;


{ TSQLRestServerAuthenticationNone }

function TSQLRestServerAuthenticationNone.Auth(Ctxt: TSQLRestServerURIContext): boolean;
var aUserName: RawUTF8;
    U: TSQLAuthUser;
begin
  aUserName := Ctxt.InputUTF8OrVoid['UserName'];
  if aUserName='' then begin
    result := false; // let's try another TSQLRestServerAuthentication class
    exit;
  end;
  result := true; // this kind of weak authentication avoid stronger ones
  if AuthSessionRelease(Ctxt) then
    exit;
  U := GetUser(Ctxt,aUserName);
  if U=nil then
    Ctxt.AuthenticationFailed(afUnknownUser) else
    SessionCreate(Ctxt,U); // call Ctxt.AuthenticationFailed on error
end;

class function TSQLRestServerAuthenticationNone.ClientComputeSessionKey(
  Sender: TSQLRestClientURI; User: TSQLAuthUser): RawUTF8;
begin
  result := ClientGetSessionKey(Sender,User,['UserName',User.LogonName]);
end;


{ TSQLRestServerAuthenticationHttpAbstract }

const
  COOKIE_SESSION = 'mORMot_session_signature';

class procedure TSQLRestServerAuthenticationHttpAbstract.ClientSessionSign(
  Sender: TSQLRestClientURI; var Call: TSQLRestURIParams);
begin
  if (Sender<>nil) and (Sender.fSessionID<>0) and (Sender.fSessionUser<>nil) then
    Call.InHead := Trim(Call.InHead+ // session ID transmitted as HTTP cookie
      (#13#10'Cookie: '+COOKIE_SESSION+'=')+Sender.fSessionIDHexa8);
end;

class function TSQLRestServerAuthenticationHttpAbstract.ClientSetUser(
  Sender: TSQLRestClientURI; const aUserName, aPassword: RawUTF8;
  aPasswordKind: TSQLRestServerAuthenticationClientSetUserPassword;
  const aHashSalt: RawUTF8; aHashRound: integer): boolean;
var res: RawUTF8;
    U: TSQLAuthUser;
begin
  result := false;
  if (aUserName='') or (Sender=nil) then
    exit;
  if aPasswordKind<>passClear then
    raise ESecurityException.CreateUTF8('%.ClientSetUser(%) expects passClear',
      [self,Sender]);
  Sender.SessionClose; // ensure Sender.SessionUser=nil
  try // inherited ClientSetUser() won't fit with Auth() method below
    ClientSetUserHttpOnly(Sender,aUserName,aPassword);
    Sender.fSessionAuthentication := self; // to enable ClientSessionSign()
    U := TSQLAuthUser(Sender.Model.GetTableInherited(TSQLAuthUser).Create);
    try
      U.LogonName := trim(aUserName);
      res := ClientGetSessionKey(Sender,U,[]);
      if res<>'' then
        result := Sender.SessionCreate(self,U,res);
    finally
      U.Free;
    end;
  finally
    if not result then begin
      // on error, reverse all values
      Sender.fSessionAuthentication := nil;
      Sender.fSessionHttpHeader := '';
    end;
    if Assigned(Sender.OnSetUser) then
      Sender.OnSetUser(Sender); // always notify of user change, even if failed
  end;
end;

function TSQLRestServerAuthenticationHttpAbstract.RetrieveSession(
  Ctxt: TSQLRestServerURIContext): TAuthSession;
var cookie: RawUTF8;
begin
  cookie := Ctxt.InCookie[COOKIE_SESSION];
  if (length(cookie)=8) and HexDisplayToCardinal(pointer(cookie),Ctxt.Session) then
    result := fServer.SessionAccess(Ctxt) else
    result := nil;
end;

class procedure TSQLRestServerAuthenticationHttpAbstract.ClientSetUserHttpOnly(
  Sender: TSQLRestClientURI; const aUserName, aPasswordClear: RawUTF8);
begin
  Sender.fSessionHttpHeader := ComputeAuthenticateHeader(aUserName,aPasswordClear);
end;


{ TSQLRestServerAuthenticationHttpBasic }

class function TSQLRestServerAuthenticationHttpBasic.GetUserPassFromInHead(
  Ctxt: TSQLRestServerURIContext; out userPass,user,pass: RawUTF8): boolean;
begin
  userPass := Ctxt.InHeader['Authorization'];
  if IdemPChar(pointer(userPass),'BASIC ') then begin
    delete(userPass,1,6);
    Split(Base64ToBin(userPass),':',user,pass);
    result := user<>'';
  end else
    result := false;
end;

function TSQLRestServerAuthenticationHttpBasic.RetrieveSession(
  Ctxt: TSQLRestServerURIContext): TAuthSession;
var userPass,user,pass: RawUTF8;
begin
  result := inherited RetrieveSession(Ctxt);
  if result=nil then
    exit; // not a valid 'Cookie: mORMot_session_signature=...' header
  if (result.fExpectedHttpAuthentication<>'') and
     (result.fExpectedHttpAuthentication=Ctxt.InHeader['Authorization']) then
    exit; // already previously authenticated for this session
  if GetUserPassFromInHead(Ctxt,userPass,user,pass) then
    if user=Result.User.LogonName then
    with Ctxt.Server.SQLAuthUserClass.Create do
    try
      PasswordPlain := pass; // compute SHA-256 hash of the supplied password
      if PasswordHashHexa=result.User.PasswordHashHexa then begin
        // match -> store header in result (locked by fSessions.fSafe.Lock)
        result.fExpectedHttpAuthentication := userPass;
        exit;
      end;
    finally
      Free;
    end;
  result := nil; // identicates authentication error
end;

class function TSQLRestServerAuthenticationHttpBasic.ComputeAuthenticateHeader(
  const aUserName,aPasswordClear: RawUTF8): RawUTF8;
begin
  result := 'Authorization: Basic '+BinToBase64(aUsername+':'+aPasswordClear);
end;

function TSQLRestServerAuthenticationHttpBasic.CheckPassword(Ctxt: TSQLRestServerURIContext;
  User: TSQLAuthUser; const aPassWord: RawUTF8): boolean;
var expectedPass: RawUTF8;
begin
  expectedPass := User.PasswordHashHexa;
  User.PasswordPlain := aPassWord; // override with SHA-256 hash from HTTP header
  result := IdemPropNameU(User.PasswordHashHexa,expectedPass);
end;

function TSQLRestServerAuthenticationHttpBasic.Auth(Ctxt: TSQLRestServerURIContext): boolean;
var userPass,user,pass: RawUTF8;
    U: TSQLAuthUser;
    Session: TAuthSession;
begin
  if Ctxt.InputExists['UserName'] then begin
    result := false; // allow other schemes to check this request
    exit;
  end;
  result := true; // this authentication method is exclusive to any other
  if GetUserPassFromInHead(Ctxt,userPass,user,pass) then begin
    U := GetUser(Ctxt,user);
    if U<>nil then
    try
      if CheckPassword(Ctxt,U,pass) then begin
        fServer.SessionCreate(U,Ctxt,Session); // call Ctxt.AuthenticationFailed on error
        if Session<>nil then begin
          // see TSQLRestServerAuthenticationHttpAbstract.ClientSessionSign()
          Ctxt.SetOutSetCookie((COOKIE_SESSION+'=')+CardinalToHexLower(Session.IDCardinal));
          if (rsoRedirectForbiddenToAuth in fServer.Options) and (Ctxt.ClientKind=ckAjax) then
            Ctxt.Redirect(fServer.Model.Root) else
            SessionCreateReturns(Ctxt,Session,'','','');
          exit; // success
        end;
      end else
        Ctxt.AuthenticationFailed(afInvalidPassword);
    finally
      U.Free;
    end else
      Ctxt.AuthenticationFailed(afUnknownUser);
  end else begin
    Ctxt.Call.OutHead := 'WWW-Authenticate: Basic realm="mORMot Server"';;
    Ctxt.Error('',HTTP_UNAUTHORIZED); // 401 will popup for credentials in browser
  end;
end;


{$ifdef DOMAINAUTH}

{ TSQLRestServerAuthenticationSSPI }

const
  /// maximum number of Windows Authentication context to be handled at once
  // - 64 should be big enough
  MAXSSPIAUTHCONTEXTS = 64;

function TSQLRestServerAuthenticationSSPI.Auth(
  Ctxt: TSQLRestServerURIContext): boolean;
var i: integer;
    UserName, InDataEnc: RawUTF8;
    ticks,ConnectionID: Int64;
    BrowserAuth: Boolean;
    CtxArr: TDynArray;
    SecCtxIdx: Integer;
    OutData: RawByteString;
    User: TSQLAuthUser;
    Session: TAuthSession;
begin
  result := AuthSessionRelease(Ctxt);
  if result or not Ctxt.InputExists['UserName'] or not Ctxt.InputExists['Data'] then
    exit;
  // use ConnectionID to find authentication session
  ConnectionID := Ctxt.Call^.LowLevelConnectionID;
  // GET ModelRoot/auth?UserName=&data=... -> windows SSPI auth
  InDataEnc := Ctxt.InputUTF8['Data'];
  if InDataEnc='' then begin
    // client is browser and used HTTP headers to send auth data
    FindNameValue(Ctxt.Call.InHead,SECPKGNAMEHTTPAUTHORIZATION,InDataEnc);
    if InDataEnc = '' then begin
      // no auth data sent, reply with supported auth methods
      Ctxt.Call.OutHead := SECPKGNAMEHTTPWWWAUTHENTICATE;
      Ctxt.Call.OutStatus := HTTP_UNAUTHORIZED; // (401)
      StatusCodeToErrorMessage(Ctxt.Call.OutStatus, Ctxt.Call.OutBody);
      exit;
    end;
    BrowserAuth := True;
  end else
    BrowserAuth := False;
  CtxArr.InitSpecific(TypeInfo(TSecContextDynArray),fSSPIAuthContexts,djInt64);
  // check for outdated auth context
  ticks := GetTickCount64-30000;
  for i := High(fSSPIAuthContexts) downto 0 do
    if ticks>fSSPIAuthContexts[i].CreatedTick64 then begin
      FreeSecContext(fSSPIAuthContexts[i]);
      CtxArr.Delete(i);
    end;
  // if no auth context specified, create a new one
  result := true;
  SecCtxIdx := CtxArr.Find(ConnectionID);
  if SecCtxIdx<0 then begin
    // 1st call: create SecCtxId
    if High(fSSPIAuthContexts)>MAXSSPIAUTHCONTEXTS then begin
      fServer.InternalLog(
        'Too many Windows Authenticated session in pending state: MAXSSPIAUTHCONTEXTS=%',
        [MAXSSPIAUTHCONTEXTS],sllUserAuth);
      exit;
    end;
    SecCtxIdx := CtxArr.New; // add a new entry to fSSPIAuthContexts[]
    InvalidateSecContext(fSSPIAuthContexts[SecCtxIdx],ConnectionID);
  end;
  // call SSPI provider
  if ServerSSPIAuth(fSSPIAuthContexts[SecCtxIdx], Base64ToBin(InDataEnc), OutData) then begin
    if BrowserAuth then begin
      Ctxt.Call.OutHead := (SECPKGNAMEHTTPWWWAUTHENTICATE+' ')+BinToBase64(OutData);
      Ctxt.Call.OutStatus := HTTP_UNAUTHORIZED; // (401)
      StatusCodeToErrorMessage(Ctxt.Call.OutStatus, Ctxt.Call.OutBody);
    end else
      Ctxt.Returns(['result','','data',BinToBase64(OutData)]);
    exit; // 1st call: send back OutData to the client
  end;
  // 2nd call: user was authenticated -> release used context
  ServerSSPIAuthUser(fSSPIAuthContexts[SecCtxIdx],UserName);
  {$ifdef WITHLOG}
  if sllUserAuth in fServer.fLogFamily.Level then
    fServer.fLogFamily.SynLog.Log(sllUserAuth,'% Authentication success for %',
      [SecPackageName(fSSPIAuthContexts[SecCtxIdx]),UserName],self);
  {$endif}
  // now client is authenticated -> create a session for aUserName
  // and send back OutData
  try
    if UserName='' then
      exit;
    User := GetUser(Ctxt,UserName);
    if User<>nil then
    try
      User.PasswordHashHexa := ''; // override with context
      fServer.SessionCreate(User,Ctxt,Session); // call Ctxt.AuthenticationFailed on error
      if Session<>nil then
        with Session.User do
          if BrowserAuth then
            SessionCreateReturns(Ctxt,Session,Session.fPrivateSalt,'',
              (SECPKGNAMEHTTPWWWAUTHENTICATE+' ')+BinToBase64(OutData)) else
            SessionCreateReturns(Ctxt,Session,
              BinToBase64(SecEncrypt(fSSPIAuthContexts[SecCtxIdx],Session.fPrivateSalt)),
              BinToBase64(OutData),'');
    finally
      User.Free;
    end else
      Ctxt.AuthenticationFailed(afUnknownUser);
  finally
    FreeSecContext(fSSPIAuthContexts[SecCtxIdx]);
    CtxArr.Delete(SecCtxIdx);
  end;
end;

class function TSQLRestServerAuthenticationSSPI.ClientComputeSessionKey(
  Sender: TSQLRestClientURI; User: TSQLAuthUser): RawUTF8;
var SecCtx: TSecContext;
    WithPassword: Boolean;
    OutData: RawByteString;
begin
  result := '';
  InvalidateSecContext(SecCtx,0);
  WithPassword := User.LogonName<>'';
  Sender.fSessionData := '';
  try
    repeat
      if WithPassword then
        ClientSSPIAuthWithPassword(SecCtx,Sender.fSessionData,
          User.LogonName,User.PasswordHashHexa,OutData) else
        ClientSSPIAuth(SecCtx,Sender.fSessionData,User.PasswordHashHexa,OutData);
      if OutData='' then
        break;
      if result<>'' then
        break; // 2nd pass
      // 1st call will return data, 2nd call SessionKey
      result := ClientGetSessionKey(Sender,User,['UserName','','data',BinToBase64(OutData)]);
    until Sender.fSessionData='';
    if result<>'' then
      result := SecDecrypt(SecCtx,Base64ToBin(result));
  finally
    FreeSecContext(SecCtx);
  end;
  // authenticated by Windows on the server side: use the returned
  // SessionKey + PasswordHashHexa to sign the URI, as usual
  User.PasswordHashHexa := ''; // should not appear on URI signature
end;

constructor TSQLRestServerAuthenticationSSPI.Create(aServer: TSQLRestServer);
begin
  inherited Create(aServer);
end;

destructor TSQLRestServerAuthenticationSSPI.Destroy;
var i: integer;
begin
  for i := 0 to High(fSSPIAuthContexts) do
    FreeSecContext(fSSPIAuthContexts[i]);
  inherited;
end;

{$endif DOMAINAUTH}


{ TSynAuthenticationRest }

constructor TSynAuthenticationRest.Create(aServer: TSQLRestServer;
  const aAllowedGroups: array of integer);
begin
  inherited Create;
  fServer := aServer;
  RegisterAllowedGroups(aAllowedGroups);
end;

procedure TSynAuthenticationRest.RegisterAllowedGroups(
  const aAllowedGroups: array of integer);
var i: integer;
begin
  for i := 0 to high(aAllowedGroups) do
    AddSortedInteger(fAllowedGroups,aAllowedGroups[i]);
end;

function TSynAuthenticationRest.GetPassword(const UserName: RawUTF8;
  out Password: RawUTF8): boolean;
var U: TSQLAuthUser;
begin
  if fServer=nil then begin
    result := false;
    exit;
  end;
  U := fServer.fSQLAuthUserClass.Create(fServer,'LogonName=?',[UserName]);
  try
    result := (U.fID>0) and
      (FastFindIntegerSorted(fAllowedGroups,PtrInt(U.fGroup))>=0);
    if result then
      Password := U.PasswordHashHexa; // same as ComputeHash() below
  finally
    U.Free;
  end;
end;

function TSynAuthenticationRest.GetUsersCount: integer;
begin
  result := 1; // fake answer indicating that authentication is enabled
end;

class function TSynAuthenticationRest.ComputeHash(Token: Int64;
  const UserName,PassWord: RawUTF8): cardinal;
begin // same as GetPassword() above
  result := inherited ComputeHash(Token,UserName,
    TSQLAuthUser.ComputeHashedPassword(Password));
end;


{ TServiceContainer }

function TServiceContainer.AddInterface(
  const aInterfaces: array of PTypeInfo; aInstanceCreation: TServiceInstanceImplementation;
  aContractExpected: RawUTF8): boolean;
var i: integer;
    F: TServiceFactoryClient;
begin
  result := false;
  if (self=nil) or (high(aInterfaces)<0) then
    exit;
  CheckInterface(aInterfaces);
  for i := 0 to high(aInterfaces) do begin
    F := ServicesFactoryClients.Create(
      Rest,aInterfaces[i],aInstanceCreation,aContractExpected);
    AddServiceInternal(F);
    aContractExpected := ''; // supplied contract is only for the 1st interface
  end;
  result := true;
end;

function TServiceContainer.AddInterface(aInterface: PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactoryClient;
begin
  CheckInterface([aInterface]);
  result := ServicesFactoryClients.Create(Rest,aInterface,aInstanceCreation,aContractExpected);
  AddServiceInternal(result);
end;

function TServiceContainer.Count: integer;
begin
  if self=nil then
    result := 0 else
    result := length(fInterface);
end;

constructor TServiceContainer.Create(aRest: TSQLRest);
begin
  fRest := aRest;
  fInterfaces.InitSpecific(TypeInfo(TServiceContainerInterfaces),
    fInterface,djRawUTF8,nil,{caseinsensitive=}true);
  fInterfaceMethods.InitSpecific(TypeInfo(TServiceContainerInterfaceMethods),
    fInterfaceMethod,djRawUTF8,nil,{caseinsensitive=}true);
  fServicesFactoryClients := TServiceFactoryClient;
end;

destructor TServiceContainer.Destroy;
var i: PtrInt;
begin
  for i := 0 to high(fInterface) do
    fInterface[i].Service.Free;
  inherited;
end;

procedure TServiceContainer.Release;
begin
  if (self<>nil) and (fRest<>nil) and (fRest.fServices=self) then
    FreeAndNil(fRest.fServices);
end;

function TServiceContainer.AddServiceInternal(aService: TServiceFactory): integer;
var MethodIndex: integer;
  procedure AddOne(const aInterfaceDotMethodName: RawUTF8);
  var p: PServiceContainerInterfaceMethod;
  begin
    p := fInterfaceMethods.AddUniqueName(aInterfaceDotMethodName);
    p^.InterfaceService := aService;
    p^.InterfaceMethodIndex := MethodIndex;
    inc(MethodIndex);
  end;
var aURI: RawUTF8;
    internal: TServiceInternalMethod;
    m: integer;
begin
  if (self=nil) or (aService=nil) then
    result := 0 else
  // add service factory
  if ExpectMangledURI then
    aURI := aService.fInterfaceMangledURI else
    aURI := aService.fInterfaceURI;
  PServiceContainerInterface(fInterfaces.AddUniqueName(aURI,@result))^.Service := aService;
  // add associated methods
  aURI := aURI+'.';
  MethodIndex := 0;
  for internal := Low(TServiceInternalMethod) to High(TServiceInternalMethod) do
    AddOne(aURI+SERVICE_PSEUDO_METHOD[internal]);
  for m := 0 to aService.fInterface.fMethodsCount-1 do
    AddOne(aURI+aService.fInterface.fMethods[m].URI);
end;

procedure TServiceContainer.CheckInterface(const aInterfaces: array of PTypeInfo);
var i: integer;
begin
  for i := 0 to high(aInterfaces) do
    if aInterfaces[i]=nil then
      raise EServiceException.CreateUTF8('%: aInterfaces[%]=nil',[self,i]) else
    with aInterfaces[i]^, PInterfaceTypeData(ClassType)^ do
    if Kind<>tkInterface then
      raise EServiceException.CreateUTF8('%: % is not an interface',[self,Name]) else
    if not (ifHasGuid in IntfFlags) then
      raise EServiceException.CreateUTF8('%: % interface has no GUID',[self,Name]) else
    if Info(IntfGuid)<>nil then
      raise EServiceException.CreateUTF8('%: % GUID already registered',[self,Name]);
end;

procedure TServiceContainer.SetExpectMangledURI(aValue: Boolean);
var i: Integer;
    toregisteragain: TServiceContainerInterfaces;
begin
  if aValue=fExpectMangledURI then
    exit;
  fExpectMangledURI := aValue;
  toregisteragain := fInterface; // same services, but other URIs
  fInterface := nil;
  fInterfaces.InitSpecific(TypeInfo(TServiceContainerInterfaces),
    fInterface,djRawUTF8,nil,{caseinsensitive=}not aValue);
  fInterfaceMethod := nil;
  fInterfaceMethods.InitSpecific(TypeInfo(TServiceContainerInterfaceMethods),
    fInterfaceMethod,djRawUTF8,nil,not aValue);
  for i := 0 to high(toregisteragain) do
    AddServiceInternal(toregisteragain[i].Service);
end;

procedure TServiceContainer.SetInterfaceMethodBits(MethodNamesCSV: PUTF8Char;
  IncludePseudoMethods: boolean; out bits: TServiceContainerInterfaceMethodBits);
var i,n: integer;
    method: RawUTF8;
begin
  FillCharFast(bits,SizeOf(bits),0);
  n := length(fInterfaceMethod);
  if n>SizeOf(bits) shl 3 then
    raise EServiceException.CreateUTF8('%.SetInterfaceMethodBits: n=%',[self,n]);
  if IncludePseudoMethods then
    for i := 0 to n-1 do
      if fInterfaceMethod[i].InterfaceMethodIndex<SERVICE_PSEUDO_METHOD_COUNT then
        include(bits,i);
  while MethodNamesCSV<>nil do begin
    GetNextItem(MethodNamesCSV,',',method);
    if PosExChar('.',method)=0 then begin
      for i := 0 to n-1 do
      with fInterfaceMethod[i] do // O(n) search is fast enough here
        if (InterfaceMethodIndex>=SERVICE_PSEUDO_METHOD_COUNT) and
           IdemPropNameU(method,InterfaceService.fInterface.
            fMethods[InterfaceMethodIndex-SERVICE_PSEUDO_METHOD_COUNT].URI) then
          include(bits,i);
    end else begin
      i := fInterfaceMethods.FindHashed(method); // O(1) search
      if i>=0 then
        include(bits,i);
    end;
  end;
end;

function TServiceContainer.GetMethodName(ListInterfaceMethodIndex: integer): RawUTF8;
begin
  if cardinal(ListInterfaceMethodIndex)>=cardinal(length(fInterfaceMethod)) then
    result := '' else
    with fInterfaceMethod[ListInterfaceMethodIndex] do
      result := InterfaceService.fInterface.GetMethodName(InterfaceMethodIndex);
end;

function TServiceContainer.GetService(const aURI: RawUTF8): TServiceFactory;
var i: Integer;
begin
  if (self<>nil) and (aURI<>'') then begin
    i := fInterfaces.FindHashed(aURI);
    if i>=0 then
      result := fInterface[i].Service else
      result := nil;
  end else
    result := nil;
end;

function TServiceContainer.Info(aTypeInfo: PTypeInfo): TServiceFactory;
var i: PtrInt;
    p: PServiceContainerInterface;
begin
  if self<>nil then begin
    p := pointer(fInterface);
    for i := 1 to length(fInterface) do begin
      result := p^.Service;
      if result.fInterface.fInterfaceTypeInfo=aTypeInfo then
        exit else
        inc(p);
    end;
  end;
  result := nil;
end;

function TServiceContainer.Info(const aGUID: TGUID): TServiceFactory;
var i: PtrInt;
    p: PServiceContainerInterface;
begin
  if self<>nil then begin
    p := pointer(fInterface);
    for i := 1 to length(fInterface) do begin
      result := p^.Service;
      if IsEqualGUID(@result.fInterface.fInterfaceIID,@aGUID) then
        exit else
        inc(p);
    end;
  end;
  result := nil;
end;

procedure TServiceContainer.SetGUIDs(out Services: TGUIDDynArray);
var i,n: PtrInt;
begin
  if self=nil then
    exit;
  n := length(fInterface);
  SetLength(Services,n);
  for i := 0 to n-1 do
    Services[i] := fInterface[i].Service.fInterface.fInterfaceIID;
end;

procedure TServiceContainer.SetInterfaceNames(out Names: TRawUTF8DynArray);
var i,n: PtrInt;
begin
  if self=nil then
    exit;
  n := length(fInterface);
  SetLength(Names,n);
  for i := 0 to n-1 do
    Names[i] := fInterface[i].Service.fInterface.fInterfaceURI;
end;

function TServiceContainer.AsJson: RawJSON;
var WR: TTextWriter;
    i: PtrInt;
    temp: TTextWriterStackBuffer;
begin
  result := '';
  if (self=nil) or (fInterface=nil) then
    exit;
  WR := TJSONSerializer.CreateOwnedStream(temp);
  try
    WR.Add('[');
    for i := 0 to high(fInterface) do begin
      WR.AddString(fInterface[i].Service.Contract);
      WR.Add(',');
    end;
    WR.CancelLastComma;
    WR.Add(']');
    WR.SetText(RawUTF8(result));
  finally
    WR.Free;
  end;
end;

function TServiceContainer.TryResolve(aInterface: PTypeInfo; out Obj): boolean;
var factory: TServiceFactory;
begin
  factory := Info(aInterface);
  if factory=nil then
    result := inherited TryResolve(aInterface,Obj) else
    result := factory.Get(Obj);
end;

function TServiceContainer.Index(aIndex: integer): TServiceFactory;
begin
  if (self=nil) or (cardinal(aIndex)>cardinal(high(fInterface))) then
    result := nil else
    result := fInterface[aIndex].Service;
end;

function TServiceContainer.CallBackUnRegister(const Callback: IInvokable): boolean;
begin
  result := false; // nothing to be done here
end;


{ TInterfacedObjectFake }

const
  // QueryInterface, _AddRef and _Release methods are hard-coded
  RESERVED_VTABLE_SLOTS = 3;

// see http://docwiki.embarcadero.com/RADStudio/en/Program_Control

{$ifdef CPU64}
  // maximum stack size at method execution must match .PARAMS 64 (minus 4 regs)
  MAX_EXECSTACK = 60*8;
{$else}
  // maximum stack size at method execution
  {$ifdef CPUARM}
  MAX_EXECSTACK = 60*4;
  {$else}
  MAX_EXECSTACK = 1024;
  {$endif}
{$endif CPU64}

{$ifdef CPUX86}
  // 32-bit integer param registers (in "register" calling convention)
  REGEAX = 1;
  REGEDX = 2;
  REGECX = 3;
  PARAMREG_FIRST = REGEAX;
  PARAMREG_LAST = REGECX;
  // floating-point params are passed by reference
{$endif CPUX86}

{$ifdef CPUX64}
  // 64-bit integer param registers
  {$ifdef LINUX}
  REGRDI = 1;
  REGRSI = 2;
  REGRDX = 3;
  REGRCX = 4;
  REGR8 = 5;
  REGR9 = 6;
  PARAMREG_FIRST = REGRDI;
  PARAMREG_RESULT = REGRSI;
  {$else}
  REGRCX = 1;
  REGRDX = 2;
  REGR8 = 3;
  REGR9 = 4;
  PARAMREG_FIRST = REGRCX;
  PARAMREG_RESULT = REGRDX;
  {$endif}
  PARAMREG_LAST = REGR9;
  // 64-bit floating-point (double) registers
  REGXMM0 = 1;
  REGXMM1 = 2;
  REGXMM2 = 3;
  REGXMM3 = 4;
  {$ifdef LINUX}
  REGXMM4 = 5;
  REGXMM5 = 6;
  REGXMM6 = 7;
  REGXMM7 = 8;
  FPREG_FIRST = REGXMM0;
  FPREG_LAST = REGXMM7;
  {$else}
  FPREG_FIRST = REGXMM0;
  FPREG_LAST = REGXMM3;
  {$endif}
  {$define HAS_FPREG}
{$endif CPUX64}

{$ifdef CPUARM}
  // 32-bit integer param registers
  REGR0 = 1;
  REGR1 = 2;
  REGR2 = 3;
  REGR3 = 4;
  PARAMREG_FIRST = REGR0;
  PARAMREG_LAST = REGR3;
  PARAMREG_RESULT = REGR1;
  // 64-bit floating-point (double) registers
  REGD0 = 1;
  REGD1 = 2;
  REGD2 = 3;
  REGD3 = 4;
  REGD4 = 5;
  REGD5 = 6;
  REGD6 = 7;
  REGD7 = 8;
  FPREG_FIRST = REGD0;
  FPREG_LAST = REGD7;
  {$define HAS_FPREG}
{$endif CPUARM}

{$ifdef CPUAARCH64}
  // 64-bit integer param registers
  REGX0 = 1;
  REGX1 = 2;
  REGX2 = 3;
  REGX3 = 4;
  REGX4 = 5;
  REGX5 = 6;
  REGX6 = 7;
  REGX7 = 8;
  PARAMREG_FIRST = REGX0;
  PARAMREG_LAST = REGX7;
  PARAMREG_RESULT = REGX1;
  // 64-bit floating-point (double) registers
  REGD0 = 1; // map REGV0 128-bit NEON register
  REGD1 = 2; // REGV1
  REGD2 = 3; // REGV2
  REGD3 = 4; // REGV3
  REGD4 = 5; // REGV4
  REGD5 = 6; // REGV5
  REGD6 = 7; // REGV6
  REGD7 = 8; // REGV7
  FPREG_FIRST = REGD0;
  FPREG_LAST = REGD7;
  {$define HAS_FPREG}
{$endif CPUAARCH64}

  PTRSIZ = SizeOf(Pointer);
  PTRSHR = {$ifdef CPU64}3{$else}2{$endif};

  STACKOFFSET_NONE = -1;

  // ordinal values are stored within 64-bit buffer, and records in a RawUTF8
  ARGS_TO_VAR: array[TServiceMethodValueType] of TServiceMethodValueVar = (
    smvvNone, smvvSelf, smvv64, smvv64, smvv64, smvv64, smvv64, smvv64, smvv64,
    smvv64, smvv64,
    smvvRawUTF8, smvvString, smvvRawUTF8, smvvWideString, smvv64, smvvRecord,
    {$ifndef NOVARIANTS}smvvRecord,{$endif} smvvObject, smvvRawUTF8,
    smvvDynArray, smvvInterface);

  {$ifdef CPU32}
  // always aligned to 8 bytes boundaries for 64-bit
  ARGS_IN_STACK_SIZE: array[TServiceMethodValueType] of Cardinal = (
     0,  PTRSIZ,PTRSIZ, PTRSIZ,PTRSIZ,PTRSIZ, PTRSIZ,    8,     8,      8,
 // None, Self, Boolean, Enum, Set,  Integer, Cardinal, Int64, Double, DateTime,
     8,       PTRSIZ,  PTRSIZ, PTRSIZ,        PTRSIZ,     0,      PTRSIZ,
 // Currency, RawUTF8, String, RawByteString, WideString, Binary, Record,
    {$ifndef NOVARIANTS}PTRSIZ,{$endif} // Variant
    PTRSIZ, PTRSIZ,  PTRSIZ, PTRSIZ);
 // Object, RawJSON, DynArray, Interface
  {$endif}

  ARGS_RESULT_BY_REF: TServiceMethodValueTypes = [
    smvRawUTF8, smvRawJSON, smvString, smvRawByteString, smvWideString, smvRecord,
    {$ifndef NOVARIANTS}smvVariant,{$endif} smvDynArray];

  PSEUDO_RESULT_NAME: string[6] = 'Result';
  PSEUDO_SELF_NAME: string[4] = 'Self';
  INTEGER_NAME: string[7] = 'Integer';
  CARDINAL_NAME: string[8] = 'Cardinal';

type
  /// map the stack memory layout at TInterfacedObjectFake.FakeCall()
  TFakeCallStack = packed record
    {$ifdef CPUX86}
    EDX, ECX, MethodIndex, EBP, Ret: cardinal;
    {$else}
    {$ifdef Linux}
    ParamRegs: packed array[PARAMREG_FIRST..PARAMREG_LAST] of pointer;
    {$endif}
    {$ifdef HAS_FPREG}
    FPRegs: packed array[FPREG_FIRST..FPREG_LAST] of double;
    {$endif}
    MethodIndex: PtrUInt;
    Frame: pointer;
    Ret: pointer;
    {$ifndef Linux}
    ParamRegs: packed array[PARAMREG_FIRST..PARAMREG_LAST] of pointer;
    {$endif}
    {$endif CPUX86}
    {$ifdef CPUARM}
    // alf: on ARM, there is more on the stack than you will expect
    DummyStack: packed array[0..9] of pointer;
    {$endif}
    {$ifdef CPUAARCH64}
    // alf: on AARCH64, there is more on the stack than you will expect
    DummyStack: packed array[0..0] of pointer;
    {$endif}
    Stack: packed array[word] of byte;
  end;

  /// instances of this class will emulate a given interface
  // - as used by TInterfaceFactory.CreateFakeInstance
  TInterfacedObjectFake = class(TInterfacedObjectFromFactory)
  protected
    fVTable: PPointerArray;
    fServiceFactory: TServiceFactory;
    function FakeCall(var aCall: TFakeCallStack): Int64;
    {$ifdef FPC}
    {$ifdef CPUARM}
    // on ARM, the FakeStub needs to be here, otherwise the FakeCall cannot be found by the FakeStub
    procedure ArmFakeStub;
    {$endif}
    {$ifdef CPUAARCH64}
    // on Aarch64, the FakeStub needs to be here, otherwise the FakeCall cannot be found by the FakeStub
    procedure AArch64FakeStub;
    {$endif}
    function FakeQueryInterface(
      {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID;
      out Obj): longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function Fake_AddRef: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function Fake_Release: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    {$else}
    function FakeQueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function Fake_AddRef: Integer; stdcall;
    function Fake_Release: Integer; stdcall;
    {$endif}
    function SelfFromInterface: TInterfacedObjectFake;
      {$ifdef HASINLINE}inline;{$endif}
    procedure InterfaceWrite(W: TJSONSerializer; const aMethod: TServiceMethod;
      const aParamInfo: TServiceMethodArgument; aParamValue: Pointer); virtual;
  public
    /// create an instance, using the specified interface
    constructor Create(aFactory: TInterfaceFactory; aServiceFactory: TServiceFactory;
      aOptions: TInterfacedObjectFromFactoryOptions;
      aInvoke: TOnFakeInstanceInvoke; aNotifyDestroy: TOnFakeInstanceDestroy);
    /// retrieve one local instance of this interface
    procedure Get(out Obj);
  end;

  TInterfacedObjectFakeClient = class(TInterfacedObjectFake)
  protected
    fClient: TServiceFactoryClient;
    procedure InterfaceWrite(W: TJSONSerializer; const aMethod: TServiceMethod;
      const aParamInfo: TServiceMethodArgument; aParamValue: Pointer); override;
  public
    constructor Create(aClient: TServiceFactoryClient;
      aInvoke: TOnFakeInstanceInvoke; aNotifyDestroy: TOnFakeInstanceDestroy);
    destructor Destroy; override;
  end;

  TInterfacedObjectFakeServer = class(TInterfacedObjectFake)
  protected
    fServer: TSQLRestServer;
    fLowLevelConnectionID: Int64;
    fService: TServiceFactoryServer;
    fReleasedOnClientSide: boolean;
    fFakeInterface: Pointer;
    fRaiseExceptionOnInvokeError: boolean;
    function CallbackInvoke(const aMethod: TServiceMethod;
      const aParams: RawUTF8; aResult, aErrorMsg: PRawUTF8;
      aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean; virtual;
  public
    constructor Create(aRequest: TSQLRestServerURIContext;
      aFactory: TInterfaceFactory; aFakeID: Integer);
    destructor Destroy; override;
  end;

  EInterfaceStub = class(EInterfaceFactoryException)
  public
    constructor Create(Sender: TInterfaceStub; const Method: TServiceMethod;
      const Error: RawUTF8); overload;
    constructor Create(Sender: TInterfaceStub; const Method: TServiceMethod;
      const Format: RawUTF8; const Args: array of const); overload;
  end;

constructor TInterfacedObjectFake.Create(aFactory: TInterfaceFactory; aServiceFactory: TServiceFactory;
  aOptions: TInterfacedObjectFromFactoryOptions; aInvoke: TOnFakeInstanceInvoke;
  aNotifyDestroy: TOnFakeInstanceDestroy);
begin
  inherited Create(aFactory,aOptions,aInvoke,aNotifyDestroy);
  fVTable := aFactory.GetMethodsVirtualTable;
  fServiceFactory := aServiceFactory;
end;

function TInterfacedObjectFake.SelfFromInterface: TInterfacedObjectFake;
{$ifdef HASINLINE}
begin
  result := pointer(PtrUInt(self)-PtrUInt(@TInterfacedObjectFake(nil).fVTable));
end;
{$else}
asm
  sub eax,TInterfacedObjectFake.fVTable
end;
{$endif HASINLINE}

function TInterfacedObjectFake.Fake_AddRef: {$ifdef FPC}longint{$else}integer{$endif};
begin
  result := SelfFromInterface._AddRef;
end;

function TInterfacedObjectFake.Fake_Release: {$ifdef FPC}longint{$else}integer{$endif};
begin
  result := SelfFromInterface._Release;
end;

function TInterfacedObjectFake.FakeQueryInterface(
{$ifdef FPC}
  {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): longint;
{$else}
  const IID: TGUID; out Obj): HResult;
{$endif}
begin
  self := SelfFromInterface;
  if IsEqualGUID(@IID,@fFactory.fInterfaceIID) then begin
    pointer(Obj) := @fVTable;
    _AddRef;
    result := NOERROR;
  end else
  if GetInterface(IID,Obj) then
    result := NOERROR else
    result := {$ifdef FPC}longint{$endif}(E_NOINTERFACE);
end;

procedure TInterfacedObjectFake.Get(out Obj);
begin
  pointer(Obj) := @fVTable;
  _AddRef;
end;

procedure IgnoreComma(var P: PUTF8Char); {$ifdef HASINLINE}inline;{$endif}
begin
  if P<>nil then begin
    while (P^<=' ') and (P^<>#0) do inc(P);
    if P^=',' then inc(P);
  end;
end;

function TInterfacedObjectFake.FakeCall(var aCall: TFakeCallStack): Int64;
var method: PServiceMethod;
    resultType: TServiceMethodValueType; // type of value stored into result
  procedure RaiseError(const Format: RawUTF8; const Args: array of const);
  var msg: RawUTF8;
  begin
    msg := FormatUTF8(Format,Args);
    raise EInterfaceFactoryException.CreateUTF8('%.FakeCall(%.%) failed: %',
      [self,fFactory.fInterfaceTypeInfo^.Name,method^.URI,msg]);
  end;
  procedure InternalProcess;
  var Params: TJSONSerializer;
      Error, ResArray, ParamsJSON: RawUTF8;
      arg, ValLen: integer;
      V: PPointer;
      R, Val: PUTF8Char;
      resultAsJSONObject: boolean;
      opt: TTextWriterWriteObjectOptions;
      ServiceCustomAnswerPoint: PServiceCustomAnswer;
      DynArrays: array[0..MAX_METHOD_ARGS-1] of TDynArray;
      Value: array[0..MAX_METHOD_ARGS-1] of pointer;
      I64s: array[0..MAX_METHOD_ARGS-1] of Int64;
      temp: TTextWriterStackBuffer;
  begin
    Params := TJSONSerializer.CreateOwnedStream(temp);
    try
      // create the parameters
      if ifoJsonAsExtended in fOptions then
        include(Params.fCustomOptions,twoForceJSONExtended) else
        include(Params.fCustomOptions,twoForceJSONStandard); // e.g. for AJAX
      if ifoDontStoreVoidJSON in fOptions then begin
        opt := DEFAULT_WRITEOPTIONS[true];
        include(Params.fCustomOptions,twoIgnoreDefaultInRecord);
      end else
        opt := DEFAULT_WRITEOPTIONS[false];
      FillCharFast(I64s,method^.ArgsUsedCount[smvv64]*SizeOf(Int64),0);
      for arg := 1 to high(method^.Args) do
      with method^.Args[arg] do
      if ValueType>smvSelf then begin
        {$ifdef HAS_FPREG} // x64, arm, aarch64
        if FPRegisterIdent>0 then
          V := @aCall.FPRegs[FPREG_FIRST+FPRegisterIdent-1]
        else
        if RegisterIdent>0 then
          V := @aCall.ParamRegs[PARAMREG_FIRST+RegisterIdent-1]
        else
        {$endif}
          V := nil;
        if RegisterIdent=PARAMREG_FIRST then
           RaiseError('unexpected self',[]);
        {$ifdef CPUX86}
        case RegisterIdent of
        REGEAX: RaiseError('unexpected self',[]);
        REGEDX: V := @aCall.EDX;
        REGECX: V := @aCall.ECX;
        else
        {$endif}
        if V=nil then
          if (SizeInStack>0) and (InStackOffset<>STACKOFFSET_NONE) then
            V := @aCall.Stack[InStackOffset] else
            V := @I64s[IndexVar]; // for results in CPU
        {$ifdef CPUX86}
        end;
        {$endif}
        if vPassedByReference in ValueKindAsm then
          V := PPointer(V)^;
        if ValueType=smvDynArray then
          DynArrays[IndexVar].InitFrom(DynArrayWrapper,V^);
        Value[arg] := V;
        if ValueDirection in [smdConst,smdVar] then
          case ValueType of
          smvInterface:
            InterfaceWrite(Params,method^,method^.Args[arg],V^);
          smvDynArray: begin
            if vIsObjArray in ValueKindAsm then
              Params.AddObjArrayJSON(V^,opt) else
              Params.AddDynArrayJSON(DynArrays[IndexVar]);
            Params.Add(',');
          end;
          else AddJSON(Params,V,opt);
          end;
      end;
      Params.CancelLastComma;
      Params.SetText(ParamsJSON); // without [ ]
    finally
      Params.Free;
    end;
    // call remote server or stub implementation
    if method^.ArgsResultIsServiceCustomAnswer then
      ServiceCustomAnswerPoint := Value[method^.ArgsResultIndex] else
      ServiceCustomAnswerPoint := nil;
    if not fInvoke(method^,ParamsJSON,
       @ResArray,@Error,@fClientDrivenID,ServiceCustomAnswerPoint) then
      RaiseError('''%''',[Error]);
    // retrieve method result and var/out parameters content
    if ServiceCustomAnswerPoint=nil then
    if ResArray<>'' then begin
      R := pointer(ResArray);
      if R^ in [#1..' '] then repeat inc(R) until not(R^ in [#1..' ']);
      resultAsJSONObject := false; // [value,...] JSON array format
      if R^='{' then   // {"paramname":value,...} JSON object format
        resultAsJSONObject := true else
      if R^<>'[' then
        RaiseError('JSON array/object result expected',[]);
      inc(R);
      arg := method^.ArgsOutFirst;
      if arg>0 then
      repeat
        if resultAsJSONObject then begin
          Val := GetJSONPropName(R,@ValLen);
          if Val=nil then
            break; // end of JSON object
          if (arg>0) and not IdemPropName(method^.Args[arg].ParamName^,Val,ValLen) then begin
            arg := method^.ArgIndex(Val,ValLen,false); // only if were not in-order
            if arg<0 then
              RaiseError('unexpected parameter [%]',[Val]);
          end;
        end;
        with method^.Args[arg] do begin
          //assert(ValueDirection in [smdVar,smdOut,smdResult]);
          V := Value[arg];
          FromJSON(method^.InterfaceDotMethodName,R,V,nil
            {$ifndef NOVARIANTS},fFactory.DocVariantOptions{$endif});
          if ValueDirection=smdResult then begin
            resultType := ValueType;
            if ValueType in [smvBoolean..smvCurrency] then
              // ordinal/real result values to CPU/FPU registers
              MoveFast(V^,Result,SizeInStorage);
          end;
        end;
        if R=nil then
          break;
        if R^ in [#1..' '] then repeat inc(R) until not(R^ in [#1..' ']);
        if resultAsJSONObject then begin
          if (R^=#0) or (R^='}') then
            break else // end of JSON object
            if not method^.ArgNext(arg,false) then
              arg := 0; // no next result argument -> force manual search
        end else
        if not method^.ArgNext(arg,false) then
          break; // end of JSON array
      until false;
    end else
      if method^.ArgsOutputValuesCount>0 then
        RaiseError('method returned value, but ResArray=''''',[]);
  end;
begin
  (*
     WELCOME ABOARD: you just landed in TInterfacedObjectFake.FakeCall() !
     if your debugger reached here, you are executing a "fake" interface
     forged to call a remote SOA server or mock/stub an interface
  *)
  self := SelfFromInterface;
  if aCall.MethodIndex>=fFactory.fMethodsCount then
    raise EInterfaceFactoryException.CreateUTF8(
      '%.FakeCall(%.%) failed: out of range method %>=%',[self,
      fFactory.fInterfaceTypeInfo^.Name,aCall.MethodIndex,fFactory.fMethodsCount]);
  method := @fFactory.fMethods[aCall.MethodIndex];
  if not Assigned(fInvoke)then
    RaiseError('fInvoke=nil',[]);
  result := 0;
  resultType := smvNone;
  InternalProcess; // use an inner proc to ensure direct fld/fild FPU ops
  case resultType of // al/ax/eax/eax:edx/rax already in result
  {$ifdef HAS_FPREG}
  smvDouble,smvDateTime: aCall.FPRegs[FPREG_FIRST] := unaligned(PDouble(@result)^);
  {$else}
  smvDouble,smvDateTime: asm fld  qword ptr [result] end;  // in st(0)
  smvCurrency:           asm fild qword ptr [result] end;  // in st(0)
  {$endif}
  end;
end;

procedure TInterfacedObjectFake.InterfaceWrite(W: TJSONSerializer;
  const aMethod: TServiceMethod; const aParamInfo: TServiceMethodArgument;
  aParamValue: Pointer);
begin
  raise EInterfaceFactoryException.CreateUTF8('%: unhandled %.%(%: %) argument',
    [self,fFactory.fInterfaceTypeInfo^.Name,aMethod.URI,
     aParamInfo.ParamName^,aParamInfo.ArgTypeName^]);
end;

constructor TInterfacedObjectFakeClient.Create(aClient: TServiceFactoryClient;
  aInvoke: TOnFakeInstanceInvoke; aNotifyDestroy: TOnFakeInstanceDestroy);
var opt: TInterfacedObjectFromFactoryOptions;
begin
  fClient := aClient;
  if (fClient.fClient<>nil) and (fClient.fClient.fSessionID<>0) and
     (fClient.fClient.fSessionUser<>nil) then
    opt := [ifoJsonAsExtended,ifoDontStoreVoidJSON] else
    opt := [];
  inherited Create(aClient.fInterface,aClient,opt,aInvoke,aNotifyDestroy);
end;

procedure TInterfacedObjectFakeClient.InterfaceWrite(W: TJSONSerializer;
  const aMethod: TServiceMethod; const aParamInfo: TServiceMethodArgument;
  aParamValue: Pointer);
begin
  W.Add(fClient.fClient.FakeCallbackRegister(fClient,aMethod,aParamInfo,aParamValue));
  W.Add(',');
end;

destructor TInterfacedObjectFakeClient.Destroy;
begin
  fClient.fClient.InternalLog('%(%).Destroy I%',
    [ClassType,pointer(self),fClient.InterfaceURI]);
  inherited Destroy;
end;

constructor TInterfacedObjectFakeServer.Create(aRequest: TSQLRestServerURIContext;
  aFactory: TInterfaceFactory; aFakeID: Integer);
var opt: TInterfacedObjectFromFactoryOptions;
begin
  if aRequest.ClientKind=ckFramework then
    opt := [ifoJsonAsExtended,ifoDontStoreVoidJSON] else
    opt := [];
  fServer := aRequest.Server;
  fService := aRequest.Service;
  fLowLevelConnectionID := aRequest.Call^.LowLevelConnectionID;
  fClientDrivenID := aFakeID;
  inherited Create(aFactory,nil,opt,CallbackInvoke,nil);
  Get(fFakeInterface);
end;

destructor TInterfacedObjectFakeServer.Destroy;
begin
  if fServer<>nil then begin // may be called asynchronously AFTER server is down
    fServer.InternalLog('%(%:%).Destroy I%',
      [ClassType,pointer(self),fClientDrivenID,fService.InterfaceURI]);
    if fServer.Services<>nil then
      with (fServer.Services as TServiceContainerServer) do
        if fFakeCallbacks<>nil then
          FakeCallbackRemove(self);
  end;
  inherited Destroy;
end;

function TInterfacedObjectFakeServer.CallbackInvoke(const aMethod: TServiceMethod;
  const aParams: RawUTF8; aResult, aErrorMsg: PRawUTF8;
  aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean;
begin // here aClientDrivenID^ = FakeCall ID
  if fServer=nil then begin
    if aErrorMsg<>nil then
      aErrorMsg^ := 'Server was already shutdown';
    result := true;
    exit;
  end;
  if not Assigned(fServer.OnNotifyCallback) then
    raise EServiceException.CreateUTF8('%(%) does not support callbacks for I%',
      [fServer,fServer.Model.Root,aMethod.InterfaceDotMethodName]);
  if fReleasedOnClientSide then begin
    if not IdemPropName(fFactory.fInterfaceTypeInfo^.Name,'ISynLogCallback') then
      fServer.InternalLog('%.CallbackInvoke: % instance has been released on '+
        'the client side, so I% callback notification was NOT sent',
        [self,fFactory.fInterfaceTypeInfo^.Name,aMethod.InterfaceDotMethodName],sllWarning);
    if fRaiseExceptionOnInvokeError or
       ((fServer.Services<>nil) and
        (coRaiseExceptionIfReleasedByClient in
         (fServer.Services as TServiceContainerServer).CallbackOptions)) then begin
      if aErrorMsg<>nil then
        FormatUTF8('%.CallbackInvoke(I%): instance has been released on client side',
          [self,aMethod.InterfaceDotMethodName],aErrorMsg^);
      result := false; // will raise an exception
    end else
      result := true; // do not raise an exception here: just log warning
  end else begin
    if aMethod.ArgsOutputValuesCount=0 then
      aResult := nil; // no result -> asynchronous non blocking callback
    result := fServer.OnNotifyCallback(fServer,aMethod.InterfaceDotMethodName,
      aParams,fLowLevelConnectionID,aClientDrivenID^,aResult,aErrorMsg);
  end;
end;

procedure TSQLRestServerURIContext.ExecuteCallback(var Par: PUTF8Char;
  ParamInterfaceInfo: PTypeInfo; out Obj);
var FakeID: PtrInt;
    factory: TInterfaceFactory;
    instance: TInterfacedObjectFakeServer;
begin
  if not Assigned(Server.OnNotifyCallback) then
    raise EServiceException.CreateUTF8('% does not implement callbacks for I%',
      [Server,ParamInterfaceInfo^.Name]);
  FakeID := GetInteger(GetJSONField(Par,Par)); // GetInteger returns a PtrInt
  if Par=nil then
    Par := @NULL_SHORTSTRING; // allow e.g. '[12345]'
  if (FakeID=0) or (ParamInterfaceInfo=TypeInfo(IInvokable)) then begin
    pointer(Obj) := pointer(FakeID); // Obj = IInvokable(FakeID)
    exit;
  end;
  factory := TInterfaceFactory.Get(ParamInterfaceInfo);
  instance := TInterfacedObjectFakeServer.Create(self,factory,FakeID);
  pointer(Obj) := instance.fFakeInterface;
  (Server.Services as TServiceContainerServer).FakeCallbackAdd(instance);
end;


{ TInterfacedObjectFromFactory }

constructor TInterfacedObjectFromFactory.Create(aFactory: TInterfaceFactory;
  aOptions: TInterfacedObjectFromFactoryOptions; aInvoke: TOnFakeInstanceInvoke;
  aNotifyDestroy: TOnFakeInstanceDestroy);
begin
  inherited Create;
  fFactory := aFactory;
  fOptions := aOptions;
  fInvoke := aInvoke;
  fNotifyDestroy := aNotifyDestroy;
end;

destructor TInterfacedObjectFromFactory.Destroy;
var C: TClass;
begin
  if Assigned(fNotifyDestroy) then
  try // release server instance
    fNotifyDestroy(fClientDrivenID);
  except
    on E: Exception do begin
      C := E.ClassType;
      if (C=EInterfaceStub) or (C=EInterfaceFactoryException) or
         (C=EAccessViolation) {$ifndef LVCL}or (C=EInvalidPointer){$endif} then
        raise; // ignore all low-level exceptions
    end;
  end;
  inherited;
end;


{ TInterfaceFactory }

function TypeInfoToMethodValueType(P: PTypeInfo): TServiceMethodValueType;
var parser: PJSONCustomParser;
begin
  result := smvNone;
  if P<>nil then
  case P^.Kind of
  tkInteger:
    case P^.OrdType of
    otSLong: result := smvInteger;
    otULong: result := smvCardinal;
    end;
  tkInt64{$ifdef FPC}, tkQWord{$endif}:
    result := smvInt64;
  {$ifdef FPC}
  tkBool:
    result := smvBoolean;
  tkEnumeration:
    result := smvEnum;
  {$else}
  tkEnumeration:
    if P=TypeInfo(boolean) then
      result := smvBoolean else
      result := smvEnum;
  {$endif}
  tkSet:
    result := smvSet;
  tkFloat:
    if (P=TypeInfo(TDateTime)) or (P=TypeInfo(TDateTimeMS)) then
      result := smvDateTime else
      case P^.FloatType of
        ftCurr: result := smvCurrency;
        ftDoub: result := smvDouble;
      end;
  {$ifdef FPC}tkLStringOld,{$endif} tkLString:
    if P=TypeInfo(RawJSON) then
      result := smvRawJSON else
    if (P=TypeInfo(RawByteString)) or (P=TypeInfo(TSQLRawBlob)) then
      result := smvRawByteString else
  {$ifndef UNICODE}
    if P=TypeInfo(AnsiString) then
      result := smvString else
      result := smvRawUTF8; // UTF-8 by default
  {$ifdef HASVARUSTRING}
  tkUString:
    result := smvRawUTF8;
  {$endif}
  {$else UNICODE}
      result := smvRawUTF8;
  tkUString:
    result := smvString;
  {$endif UNICODE}
  tkWString:
    result := smvWideString;
  tkClass:
    with P^.ClassType^ do
    if ClassHasPublishedFields(ClassType) or // = oPersistent or oCustomPropName
       (JSONObjectFromClass(ClassType,parser) in // serialized w/o RTTI ?
         [{$ifndef LVCL}oCollection,{$endif}oObjectList,oUtfs,oStrings,
          oException,oCustomReaderWriter]) then
      result := smvObject; // JSONToObject/ObjectToJSON types
  {$ifdef FPC}tkObject,{$endif} tkRecord:
    // JSON or Base64 encoding of our RecordLoad / RecordSave binary format
    result := smvRecord;
  {$ifndef NOVARIANTS}
  tkVariant:
    result := smvVariant;
  {$endif}
  tkDynArray: // TDynArray.LoadFromJSON / TTextWriter.AddDynArrayJSON type
    result := smvDynArray;
  tkInterface:
    result := smvInterface;
  tkUnknown: // assume var/out untyped arguments are in fact objects
    result := smvObject;
  end;
end;

var
  InterfaceFactoryCache: TSynObjectListLocked;

procedure EnterInterfaceFactoryCache;
begin
  if InterfaceFactoryCache=nil then
    GarbageCollectorFreeAndNil(InterfaceFactoryCache,TSynObjectListLocked.Create);
  InterfaceFactoryCache.Safe.Lock;
end;

class function TInterfaceFactory.Get(aInterface: PTypeInfo): TInterfaceFactory;
var i: integer;
    F: ^TInterfaceFactory;
begin
  if (aInterface=nil) or (aInterface^.Kind<>tkInterface) then
    raise EInterfaceFactoryException.CreateUTF8('%.Get(nil)',[self]);
  EnterInterfaceFactoryCache;
  try
    F := pointer(InterfaceFactoryCache.List);
    for i := 1 to InterfaceFactoryCache.Count do
       if F^.fInterfaceTypeInfo=aInterface then begin
        result := F^;
        exit; // retrieved from cache
      end else
        inc(F);
    // not existing -> create new instance from RTTI
    {$ifdef HASINTERFACERTTI}
    result := TInterfaceFactoryRTTI.Create(aInterface);
    InterfaceFactoryCache.Add(result);
    {$else}
    result := nil; // make compiler happy
    raise EInterfaceFactoryException.CreateUTF8('No RTTI available for I%: please '+
      'define the methods using a TInterfaceFactoryGenerated wrapper',[aInterface^.Name]);
    {$endif}
  finally
    InterfaceFactoryCache.Safe.UnLock;
  end;
end;

class procedure TInterfaceFactory.RegisterInterfaces(const aInterfaces: array of PTypeInfo);
{$ifdef HASINTERFACERTTI}
var i: integer;
begin
  for i := 0 to high(aInterfaces) do
    Get(aInterfaces[i]);
end;
{$else}
begin // in fact, TInterfaceFactoryGenerated.RegisterInterface() should do it
end;
{$endif}

class function TInterfaceFactory.Get(const aGUID: TGUID): TInterfaceFactory;
type TGUID32 = packed record a,b{$ifdef CPU32},c,d{$endif}: PtrInt; end;
     PGUID32 = ^TGUID32; // brute force search optimization
var i,ga: PtrInt;
    F: ^TInterfaceFactory;
    GUID32: TGUID32 absolute aGUID;
begin
  if InterfaceFactoryCache<>nil then begin
    InterfaceFactoryCache.Safe.Lock;
    F := pointer(InterfaceFactoryCache.List);
    ga := GUID32.a;
    for i := 1 to InterfaceFactoryCache.Count do
    with PGUID32(@F^.fInterfaceIID)^ do
    if (a=ga) and (b=GUID32.b) {$ifdef CPU32}and (c=GUID32.c) and (d=GUID32.d){$endif} then begin
      result := F^;
      InterfaceFactoryCache.Safe.UnLock;
      exit;
    end else
      inc(F);
    InterfaceFactoryCache.Safe.UnLock;
  end;
  result := nil;
end;

function ToText({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  aGUID: TGUID): TGUIDShortString;
var fact: TInterfaceFactory;
begin
  fact := TInterfaceFactory.Get(aGUID);
  if fact=nil then
    GUIDToShort(aGUID,result) else
    result := fact.fInterfaceTypeInfo^.Name;
end;

class procedure TInterfaceFactory.AddToObjArray(var Obj: TInterfaceFactoryObjArray;
  const aGUIDs: array of TGUID);
var i: integer;
    fac: TInterfaceFactory;
begin
  for i := 0 to high(aGUIDs) do begin
    fac := Get(aGUIDs[i]);
    if fac<>nil then
      ObjArrayAddOnce(Obj,fac);
  end;
end;

class function TInterfaceFactory.GUID2TypeInfo(
  const aGUIDs: array of TGUID): PTypeInfoDynArray;
var i: integer;
begin
  result := nil;
  SetLength(result,length(aGUIDs));
  for i := 0 to high(aGUIDs) do
    result[i] := GUID2TypeInfo(aGUIDs[i]);
end;

class function TInterfaceFactory.GUID2TypeInfo(const aGUID: TGUID): PTypeInfo;
var fact: TInterfaceFactory;
begin
  fact := Get(aGUID);
  if fact=nil then
    raise EServiceException.CreateUTF8('%.GUID2TypeInfo(%): Interface not '+
      'registered - use %.RegisterInterfaces()',[self,GUIDToShort(aGUID),self]);
  result := fact.fInterfaceTypeInfo;
end;

class function TInterfaceFactory.Get(const aInterfaceName: RawUTF8): TInterfaceFactory;
var L,i: integer;
    F: ^TInterfaceFactory;
begin
  result := nil;
  L := length(aInterfaceName);
  if (InterfaceFactoryCache<>nil) and (L<>0) then begin
    InterfaceFactoryCache.Safe.Lock;
    try
      F := pointer(InterfaceFactoryCache.List);
      for i := 1 to InterfaceFactoryCache.Count do
        if IdemPropName(F^.fInterfaceTypeInfo^.Name,pointer(aInterfaceName),L) then begin
          result := F^;
          exit; // retrieved from cache
        end else
        inc(F);
    finally
      InterfaceFactoryCache.Safe.UnLock;
    end;
  end;
end;

class function TInterfaceFactory.GetUsedInterfaces: TSynObjectListLocked;
begin
  result := InterfaceFactoryCache;
end;

var
  GlobalUnsafeSPIType: array of PTypeInfo;

class procedure TInterfaceFactory.RegisterUnsafeSPIType(const Types: array of pointer);
var a: integer;
begin
  for a := 0 to high(Types) do
    if Types[a]<>nil then
      PtrArrayAddOnce(GlobalUnsafeSPIType,Types[a])
end;

constructor TInterfaceFactory.Create(aInterface: PTypeInfo);
var m,a,reg: integer;
    WR: TTextWriter;
    C: TClass;
    ErrorMsg: RawUTF8;
    dummy: pointer;
    {$ifdef HAS_FPREG}
    ValueIsInFPR: boolean;
    {$endif HAS_FPREG}
    {$ifdef CPUX86}
    offs: integer;
    {$else}
    {$ifdef Linux} // not used for Win64
    fpreg: integer;
    {$endif Linux}
    {$endif CPUX86}
  procedure RaiseError(const Args: array of const);
  begin
    raise EInterfaceFactoryException.CreateUTF8(
      '%.Create: %.% [%] parameter has unexpected type %%',Args);
  end;
begin
  if aInterface=nil then
    raise EInterfaceFactoryException.CreateUTF8('%.Create(nil)',[self]);
  if aInterface^.Kind<>tkInterface then
    raise EInterfaceFactoryException.CreateUTF8(
      '%.Create(%): % is not an interface',[self,aInterface^.Name,aInterface^.Name]);
  {$ifndef NOVARIANTS}
  fDocVariantOptions := JSON_OPTIONS_FAST;
  {$endif NOVARIANTS}
  fInterfaceTypeInfo := aInterface;
  fInterfaceIID := aInterface^.InterfaceGUID^;
  if IsNullGUID(fInterfaceIID) then
    raise EInterfaceFactoryException.CreateUTF8(
      '%.Create: % has no GUID',[self,aInterface^.Name]);
  fInterfaceName := ToUTF8(fInterfaceTypeInfo^.Name);
  fInterfaceURI := fInterfaceName;
  if fInterfaceURI[1] in ['i','I'] then
    delete(fInterfaceURI,1,1);  // as in TServiceFactory.Create
  // retrieve all interface methods (recursively including ancestors)
  fMethod.InitSpecific(TypeInfo(TServiceMethodDynArray),fMethods,djRawUTF8,
    @fMethodsCount,true);
  AddMethodsFromTypeInfo(aInterface); // from RTTI or generated code
  if fMethodsCount=0 then
    raise EInterfaceFactoryException.CreateUTF8('%.Create(%): interface has '+
      'no RTTI - should inherit from IInvokable',[self,fInterfaceName]);
  if fMethodsCount>MAX_METHOD_COUNT then
    raise EInterfaceFactoryException.CreateUTF8(
      '%.Create(%): interface has too many methods (%), so breaks the '+
      'Interface Segregation Principle',[self,fInterfaceName,fMethodsCount]);
  fMethodIndexCurrentFrameCallback := -1;
  fMethodIndexCallbackReleased := -1;
  SetLength(fMethods,fMethodsCount);
  // compute additional information for each method
  for m := 0 to fMethodsCount-1 do
  with fMethods[m] do begin
    InterfaceDotMethodName := fInterfaceURI+'.'+URI;
    IsInherited := HierarchyLevel<>fAddMethodsLevel;
    ExecutionMethodIndex := m+RESERVED_VTABLE_SLOTS;
    ArgsInFirst := -1;
    ArgsInLast := -2;
    ArgsOutFirst := -1;
    ArgsOutLast := -2;
    ArgsNotResultLast := -2;
    ArgsOutNotResultLast := -2;
    ArgsResultIndex := -1;
    ArgsManagedFirst := -1;
    ArgsManagedLast := -2;
    Args[0].ValueType := smvSelf;
    for a := 1 to high(Args) do
    with Args[a] do begin
      ValueType := TypeInfoToMethodValueType(ArgTypeInfo);
      case ValueType of
      smvNone: begin
        case ArgTypeInfo^.Kind of
        tkClass: begin
          C := ArgTypeInfo^.ClassType^.ClassType;
          if C.InheritsFrom(TList) then
            ErrorMsg := ' - use TObjectList instead' else
          {$ifndef LVCL}
          if (C.InheritsFrom(TCollection) and not C.InheritsFrom(TInterfacedCollection)) and
            (JSONSerializerRegisteredCollection.Find(TCollectionClass(C))=nil) then
            ErrorMsg := ' - inherit from TInterfacedCollection '+
              'or use TJSONSerializer.RegisterCollectionForJSON()' else
          {$endif}
            ErrorMsg := ' - use TJSONSerializer.RegisterCustomSerializer()';
        end;
        tkInteger: ErrorMsg := ' - use integer/cardinal instead';
        tkFloat:   ErrorMsg := ' - use double/currency instead';
        end;
        RaiseError([self,aInterface^.Name,URI,ParamName^,ArgTypeInfo^.Name,ErrorMsg]);
      end;
      smvObject:
        if ValueDirection=smdResult then begin
          ErrorMsg := ' - class not allowed as function result: use a var/out parameter';
          RaiseError([self,aInterface^.Name,URI,ParamName^,ArgTypeInfo^.Name,ErrorMsg]);
        end;
      smvInterface:
        if ValueDirection in [smdVar,smdOut,smdResult] then begin
          ErrorMsg := ' - interface not allowed as output: use a const parameter';
          RaiseError([self,aInterface^.Name,URI,ParamName^,ArgTypeInfo^.Name,ErrorMsg]);
        end;
      end;
      if ValueDirection=smdResult then
        ArgsResultIndex := a else begin
        ArgsNotResultLast := a;
        if ValueDirection<>smdOut then begin
          inc(ArgsInputValuesCount);
          if ArgsInFirst<0 then
            ArgsInFirst := a;
          ArgsInLast := a;
        end;
        if ValueDirection<>smdConst then
          ArgsOutNotResultLast := a;
      end;
      if ValueDirection<>smdConst then begin
        if ArgsOutFirst<0 then
          ArgsOutFirst := a;
        ArgsOutLast := a;
        inc(ArgsOutputValuesCount);
      end;
      if ValueType in [smvObject,smvDynArray,smvRecord,smvInterface
          {$ifndef NOVARIANTS},smvVariant{$endif}] then begin
        if ArgsManagedFirst<0 then
          ArgsManagedFirst := a;
        ArgsManagedLast := a;
      end;
      if PtrArrayFind(GlobalUnsafeSPIType,ArgTypeInfo)>=0 then begin
        include(ValueKindAsm,vIsSPI);
        include(HasSPIParams,ValueDirection);
      end;
    end;
    if ArgsOutputValuesCount=0 then // plain procedure with no out param
      case ArgsInputValuesCount of
      1: if Args[1].ValueType=smvBoolean then
           if IdemPropNameU(URI,'CurrentFrame') then
            fMethodIndexCurrentFrameCallback := m;
      2: if (Args[1].ValueType=smvInterface) and
            (Args[1].ArgTypeInfo=TypeInfo(IInvokable)) and
            (Args[2].ValueType=smvRawUTF8) and
             IdemPropNameU(URI,'CallbackReleased') then
            fMethodIndexCallbackReleased := m;
      end;
    if ArgsResultIndex>=0 then
      with Args[ArgsResultIndex] do
      case ValueType of
      smvNone, smvObject, smvInterface:
        raise EInterfaceFactoryException.CreateUTF8('%.Create: I% unexpected result type %',
          [self,InterfaceDotMethodName,ArgTypeName^]);
      smvRecord:
        if ArgTypeInfo=System.TypeInfo(TServiceCustomAnswer) then begin
          for a := ArgsOutFirst to ArgsOutLast do
            if Args[a].ValueDirection in [smdVar,smdOut] then
              raise EInterfaceFactoryException.CreateUTF8('%.Create: I% '+
                'var/out parameter [%] not allowed with TServiceCustomAnswer result',
                [self,InterfaceDotMethodName,Args[a].ParamName^]);
          ArgsResultIsServiceCustomAnswer := true;
        end;
      end;
    if (ArgsInputValuesCount=1) and (Args[1].ValueType=smvRawByteString) then
      ArgsInputIsOctetStream := true;
  end;
  // compute asm low-level layout of the parameters for each method
  for m := 0 to fMethodsCount-1 do
  with fMethods[m] do begin
    // prepare stack and register layout
    reg := PARAMREG_FIRST;
    {$ifndef CPUX86}
    {$ifdef Linux}
    fpreg := FPREG_FIRST;
    {$endif Linux}
    {$endif CPUX86}
    for a := 0 to high(Args) do
    with Args[a] do begin
      RegisterIdent := 0;
      {$ifdef HAS_FPREG}
      FPRegisterIdent := 0;
      ValueIsInFPR := false;
      {$endif HAS_FPREG}
      ValueVar := ARGS_TO_VAR[ValueType];
      IndexVar := ArgsUsedCount[ValueVar];
      inc(ArgsUsedCount[ValueVar]);
      include(ArgsUsed,ValueType);
      if (ValueType in [smvRecord{$ifndef NOVARIANTS},smvVariant{$endif}]) or
         (ValueDirection in [smdVar,smdOut]) or
         ((ValueDirection=smdResult) and (ValueType in ARGS_RESULT_BY_REF)) then
        Include(ValueKindAsm,vPassedByReference);
      case ValueType of
      smvInteger, smvCardinal, smvInt64:
        if TJSONCustomParserRTTI.TypeNameToSimpleBinary(
           ShortStringToUTF8(ArgTypeName^),SizeInBinary,SizeInStorage) then begin
          ValueType := smvBinary; // transmitted as hexa string
          Include(ValueKindAsm,vIsString);
        end else if ArgTypeInfo^.IsQWord then
          Include(ValueKindAsm,vIsQword);
      smvDouble,smvDateTime: begin
        {$ifdef HAS_FPREG}
        ValueIsInFPR := not (vPassedByReference in ValueKindAsm);
        {$endif HAS_FPREG}
        if ValueType=smvDateTime then begin
          include(ValueKindAsm,vIsString);
          if ArgTypeInfo=System.TypeInfo(TDateTimeMS) then
            include(ValueKindAsm,vIsDateTimeMS);
        end;
      end;
      smvRawUTF8..smvWideString:
        Include(ValueKindAsm,vIsString);
      smvDynArray: begin
        if ObjArraySerializers.Find(ArgTypeInfo)<>nil then
          Include(ValueKindAsm,vIsObjArray) else
          if (ArgTypeInfo^.DynArraySQLFieldType in STRING_FIELDS) or
             DynArrayItemTypeIsSimpleBinary(ShortStringToUTF8(ArgTypeName^)) then
            Include(ValueKindAsm,vIsDynArrayString);
        DynArrayWrapper.Init(ArgTypeInfo,dummy);
        DynArrayWrapper.IsObjArray := vIsObjArray in ValueKindAsm;
        DynArrayWrapper.HasCustomJSONParser; // set DynArrayWrapper.fParser
      end;
      end;
      case ValueType of
        smvBoolean:
          SizeInStorage := 1;
        smvInteger, smvCardinal:
          SizeInStorage := 4;
        smvInt64, smvDouble, smvDateTime, smvCurrency:
          SizeInStorage := 8;
        smvEnum:
          SizeInStorage := ArgTypeInfo^.EnumBaseType^.SizeInStorageAsEnum;
        smvSet: begin
          SizeInStorage := ArgTypeInfo^.SetEnumType^.SizeInStorageAsSet;
          if SizeInStorage=0 then
            raise EInterfaceFactoryException.CreateUTF8(
              '%.Create: % set invalid SizeInStorage=% in %.% method % parameter',
              [self,ArgTypeName^,SizeInStorage,fInterfaceTypeInfo^.Name,URI,ParamName^]);
        end;
        smvBinary: ; // already set SizeInStorage
        smvRecord:
          if ArgTypeInfo^.RecordType^.Size<=PTRSIZ then
            raise EInterfaceFactoryException.CreateUTF8(
              '%.Create: % record too small in %.% method % parameter',
              [self,ArgTypeName^,fInterfaceTypeInfo^.Name,URI,ParamName^]) else
            SizeInStorage := PTRSIZ; // handle only records when passed by ref
        else
          SizeInStorage := PTRSIZ;
      end;
      if ValueDirection=smdResult then begin
        if not (ValueType in ARGS_RESULT_BY_REF) then
          continue; // ordinal/real/class results are returned in CPU/FPU registers
        {$ifndef CPUX86}
        InStackOffset := STACKOFFSET_NONE;
        RegisterIdent := PARAMREG_RESULT;
        continue;
        {$endif CPUX86}
        // CPUX86 will add an additional by-ref parameter
      end;
      {$ifdef CPU32}
      if ValueDirection=smdConst then
        if ValueType=smvBinary then
          SizeInStack := SizeInBinary else
          SizeInStack := ARGS_IN_STACK_SIZE[ValueType] else
      {$endif CPU32}
        SizeInStack := PTRSIZ; // always aligned to 8 bytes boundaries for 64-bit
      if {$ifndef CPUARM}
        // on ARM, ordinals>PTRSIZ can also be placed in the normal registers !!
        (SizeInStack<>PTRSIZ) or
        {$endif CPUARM}
        {$ifdef CPUX86}
        (reg>PARAMREG_LAST) // Win32, Linux x86
        {$else}
        {$ifdef Linux}  // Linux x64, arm, aarch64
        ((ValueIsInFPR) and (fpreg>FPREG_LAST)) or
        (not ValueIsInFPR and (reg>PARAMREG_LAST))
        {$else}
        (reg>PARAMREG_LAST) // Win64: XMMs overlap regular registers
        {$endif Linux}
        {$endif CPUX86}
        {$ifdef FPC}or ((ValueType in [smvRecord]) and
          // trunk i386/x86_64\cpupara.pas: DynArray const is passed as register
          not (vPassedByReference in ValueKindAsm)){$endif} then begin
        // this parameter will go on the stack
        InStackOffset := ArgsSizeInStack;
        inc(ArgsSizeInStack,SizeInStack);
      end else begin
        // this parameter will go in a register
        InStackOffset := STACKOFFSET_NONE;
        {$ifndef CPUX86}
        if (ArgsResultIndex>=0) and (reg=PARAMREG_RESULT) and
           (Args[ArgsResultIndex].ValueType in ARGS_RESULT_BY_REF) then begin
          inc(reg); // this register is reserved for method result pointer
        end;
       {$endif CPUX86}
        {$ifdef HAS_FPREG}
        if ValueIsInFPR then begin
          // put in a floating-point register
          {$ifdef Linux}
          FPRegisterIdent := fpreg;
          inc(fpreg);
          {$else}
          FPRegisterIdent := reg; // Win64 ABI: reg and fpreg do overlap
          inc(reg);
          {$endif Linux}
        end
        else
        {$endif HAS_FPREG} begin
          // put in an integer register
          {$ifdef CPUARM}
          // on 32-bit ARM, ordinals>PTRSIZ are also placed in normal registers
          if (SizeInStack>PTRSIZ) and ((reg and 1)=0) then
            inc(reg); // must be aligned on even boundary
          // check if we have still enough registers, after previous increments
          if ((PARAMREG_LAST-reg+1)*PTRSIZ)<SizeInStack then begin
            // no space, put on stack
            InStackOffset := ArgsSizeInStack;
            inc(ArgsSizeInStack,SizeInStack);
            // all other parameters following the current one, must also be placed on stack
            reg := PARAMREG_LAST+1;
            continue;
          end;
          RegisterIdent := reg;
          if SizeInStack>PTRSIZ then
            inc(reg,SizeInStack shr PTRSHR) else
            inc(reg);
          {$else}
          RegisterIdent := reg;
          inc(reg);
          {$endif CPUARM}
        end;
      end;
    end;
    if ArgsSizeInStack>MAX_EXECSTACK then
      raise EInterfaceFactoryException.CreateUTF8(
        '%.Create: Stack size % > % for %.% method',
        [self,ArgsSizeInStack,MAX_EXECSTACK,fInterfaceTypeInfo^.Name,URI]);
    {$ifdef CPUX86}
    // pascal/register convention are passed left-to-right -> reverse order
    offs := ArgsSizeInStack;
    for a := 0 to high(Args) do
    with Args[a] do
      if InStackOffset>=0 then begin
        dec(offs,SizeInStack);
        InStackOffset := offs;
      end;
    //assert(offs=0);
    {$endif CPUX86}
  end;
  WR := TJSONSerializer.CreateOwnedStream;
  try
    // compute the default results JSON array for all methods
    for m := 0 to fMethodsCount-1 do
    with fMethods[m] do begin
      WR.CancelAll;
      WR.Add('[');
      for a := ArgsOutFirst to ArgsOutLast do
        with Args[a] do
        if ValueDirection in [smdVar,smdOut,smdResult] then
          AddDefaultJSON(WR);
      WR.CancelLastComma;
      WR.Add(']');
      WR.SetText(DefaultResult);
    end;
    // compute the service contract as a JSON array
    WR.CancelAll;
    WR.Add('[');
    for m := 0 to fMethodsCount-1 do
    with fMethods[m] do begin
      WR.Add('{"method":"%","arguments":[',[URI]);
      for a := 0 to High(Args) do
        Args[a].SerializeToContract(WR);
      WR.CancelLastComma;
      WR.AddShort(']},');
    end;
    WR.CancelLastComma;
    WR.Add(']');
    WR.SetText(fContract);
    {.$define SOA_DEBUG} // write the low-level interface info as json
    {$ifdef SOA_DEBUG}
    JSONReformatToFile(fContract,TFileName(fInterfaceName+
      '-'+COMP_TEXT+OS_TEXT+CPU_ARCH_TEXT+'.json'));
    {$endif SOA_DEBUG}
  finally
    WR.Free;
  end;
end;

function TInterfaceFactory.FindMethodIndex(const aMethodName: RawUTF8): integer;
begin
  if (self=nil) or (aMethodName='') then
    result := -1 else begin
    if fMethodsCount<10 then begin
      for result := 0 to fMethodsCount-1 do
        if IdemPropNameU(fMethods[result].URI,aMethodName) then
          exit;
      result := -1;
    end else
      result := fMethod.FindHashed(aMethodName);
    if (result<0) and (aMethodName[1]<>'_') then
      result := FindMethodIndex('_'+aMethodName);
  end;
end;

function TInterfaceFactory.FindMethod(const aMethodName: RawUTF8): PServiceMethod;
var i: integer;
begin
  i := FindMethodIndex(aMethodName);
  if i < 0 then
    result := nil else
    result := @fMethods[i];
end;

function TInterfaceFactory.FindFullMethodIndex(const aFullMethodName: RawUTF8;
  alsoSearchExactMethodName: boolean): integer;
begin
  if PosExChar('.',aFullMethodName)<>0 then
    for result := 0 to fMethodsCount-1 do
      if IdemPropNameU(fMethods[result].InterfaceDotMethodName,aFullMethodName) then
        exit;
  if alsoSearchExactMethodName then
    result := FindMethodIndex(aFullMethodName) else
    result := -1;
end;

function TInterfaceFactory.CheckMethodIndex(const aMethodName: RawUTF8): integer;
begin
  if self=nil then
    raise EInterfaceFactoryException.Create('TInterfaceFactory(nil).CheckMethodIndex');
  result := FindMethodIndex(aMethodName);
  if result<0 then
    raise EInterfaceFactoryException.CreateUTF8(
      '%.CheckMethodIndex: %.% not found',[self,fInterfaceTypeInfo^.Name,aMethodName]);
end;

function TInterfaceFactory.CheckMethodIndex(aMethodName: PUTF8Char): integer;
begin
  result := CheckMethodIndex(RawUTF8(aMethodName));
end;

procedure TInterfaceFactory.CheckMethodIndexes(const aMethodName: array of RawUTF8;
  aSetAllIfNone: boolean; out aBits: TInterfaceFactoryMethodBits);
var i: integer;
begin
  if aSetAllIfNone and (high(aMethodName)<0) then begin
    FillCharFast(aBits,SizeOf(aBits),255);
    exit;
  end;
  FillCharFast(aBits,SizeOf(aBits),0);
  for i := 0 to high(aMethodName) do
    include(aBits,CheckMethodIndex(aMethodName[i]));
end;

function TInterfaceFactory.GetMethodName(MethodIndex: integer): RawUTF8;
begin
  if (MethodIndex<0) or (self=nil) then
    result := '' else
  if MethodIndex<SERVICE_PSEUDO_METHOD_COUNT then
    result := SERVICE_PSEUDO_METHOD[TServiceInternalMethod(MethodIndex)] else begin
    dec(MethodIndex,SERVICE_PSEUDO_METHOD_COUNT);
    if cardinal(MethodIndex)<fMethodsCount then
      result := fMethods[MethodIndex].URI else
      result := '';
  end;
end;

function TInterfaceFactory.GetFullMethodName(aMethodIndex: integer): RawUTF8;
begin
  if self=nil then
    result := '' else begin
    result := GetMethodName(aMethodIndex);
    if result = '' then
      result := fInterfaceName else
      result := fInterfaceName+'.'+result;
  end;
end;

{ low-level ASM for TInterfaceFactory.GetMethodsVirtualTable
  - all ARM, AARCH64 and Linux64 code below was provided by ALF! Thanks! :)  }
{$ifdef FPC}
{$ifdef CPUARM}
{$ifdef ASMORIG}
procedure TInterfacedObjectFake.ArmFakeStub;
var // warning: exact local variables order should match TFakeCallStack
  smetndx: pointer;
  sd7, sd6, sd5, sd4, sd3, sd2, sd1, sd0: double;
  sr3,sr2,sr1,sr0: pointer;
asm
  // get method index
  str  v1,smetndx
  // store registers
  vstr d0,sd0
  vstr d1,sd1
  vstr d2,sd2
  vstr d3,sd3
  vstr d4,sd4
  vstr d5,sd5
  vstr d6,sd6
  vstr d7,sd7
  str r0,sr0
  str r1,sr1
  str r2,sr2
  str r3,sr3
  // TFakeCallStack address as 2nd parameter
  // there is no lea equivalent instruction for ARM (AFAIK), so this is calculated by hand (by looking at assembler)
  sub r1, fp, #128
  // branch to the FakeCall function
  bl FakeCall
  // FakeCall should set Int64 result in method result, and float in aCall.FPRegs["sd0"]
  vstr d0,sd0
end;
{$else}
procedure TInterfacedObjectFake.ArmFakeStub;nostackframe;assembler;
asm
    // get method index
    str   r12,[r13, #-52]
    // create stack space
    mov   r12,r13
    stmfd r13!,{r11,r12,r14,r15}
    sub   r11,r12,#4
    sub   r13,r13,#128
    // store registers
    vstr  d0,[r11, #-112]
    vstr  d1,[r11, #-104]
    vstr  d2,[r11, #-96]
    vstr  d3,[r11, #-88]
    vstr  d4,[r11, #-80]
    vstr  d5,[r11, #-72]
    vstr  d6,[r11, #-64]
    vstr  d7,[r11, #-56]
    str   r0,[r11, #-128]
    str   r1,[r11, #-124]
    str   r2,[r11, #-120]
    str   r3,[r11, #-116]
    // set stack address
    add   r1,r13, #12
    // branch to the FakeCall function
    bl    FakeCall
    // store result
    vstr  d0,[r11, #-112]
    ldmea r11,{r11,r13,r15}
end;
{$endif ASMORIG}

{$endif}
{$ifdef CPUAARCH64}
procedure TInterfacedObjectFake.AArch64FakeStub;
var // warning: exact local variables order should match TFakeCallStack
  sx0, sx1, sx2, sx3, sx4, sx5, sx6, sx7: pointer;
  sd0, sd1, sd2, sd3, sd4, sd5, sd6, sd7: double;
  smetndx:pointer;
asm
  // get method index from IP0 [x16/r16]
  str x16,smetndx
  // store registers
  str d0,sd0
  str d1,sd1
  str d2,sd2
  str d3,sd3
  str d4,sd4
  str d5,sd5
  str d6,sd6
  str d7,sd7
  str x0,sx0
  str x1,sx1
  str x2,sx2
  str x3,sx3
  str x4,sx4
  str x5,sx5
  str x6,sx6
  str x7,sx7
  // TFakeCallStack address as 2nd parameter
  // sx0 is at the stack pointer !
  // local variables are stored in reverse on the stack
  add x1, sp, #0
  // branch to the FakeCall function
  bl FakeCall
  // FakeCall should set Int64 result in method result, and float in aCall.FPRegs["sd0"]
  str d0,sd0
end;
{$endif}
{$endif}

{$ifdef CPUX64}
procedure x64FakeStub;
var // warning: exact local variables order should match TFakeCallStack
  smetndx,
  {$ifdef Linux}
  sxmm7, sxmm6, sxmm5, sxmm4,
  {$endif}
  sxmm3, sxmm2, sxmm1, sxmm0: double;
  {$ifdef Linux}
  sr9, sr8, srcx, srdx, srsi, srdi: pointer;
  {$endif}
asm // caller = mov ax,{MethodIndex}; jmp x64FakeStub
        {$ifndef FPC}
        // FakeCall(self: TInterfacedObjectFake; var aCall: TFakeCallStack): Int64
        // So, make space for two variables (+shadow space)
        // adds $50 to stack, so rcx .. at rpb+$10+$50 = rpb+$60
       .params 2
        {$endif}
        and     rax, $ffff
        mov     smetndx, rax
        movlpd  sxmm0, xmm0 // movlpd to ignore upper 64-bit of 128-bit xmm reg
        movlpd  sxmm1, xmm1
        movlpd  sxmm2, xmm2
        movlpd  sxmm3, xmm3
        {$ifdef LINUX}
        movlpd  sxmm4, xmm4
        movlpd  sxmm5, xmm5
        movlpd  sxmm6, xmm6
        movlpd  sxmm7, xmm7
        mov     sr9, r9
        mov     sr8, r8
        mov     srcx, rcx
        mov     srdx, rdx
        mov     srsi, rsi
        mov     srdi, rdi
        lea     rsi, srdi // TFakeCallStack address as 2nd parameter
        {$else}
        {$ifndef FPC}
        mov     [rbp + $60], rcx
        mov     [rbp + $68], rdx
        mov     [rbp + $70], r8
        mov     [rbp + $78], r9
        {$else}
        mov     [rbp + $10], rcx
        mov     [rbp + $18], rdx
        mov     [rbp + $20], r8
        mov     [rbp + $28], r9
        {$endif FPC}
        lea     rdx, sxmm0 // TFakeCallStack address as 2nd parameter
        {$endif LINUX}
        call    TInterfacedObjectFake.FakeCall
        // FakeCall should set Int64 result in method result,
        //and float in aCall.FPRegs["XMM0"]
        movsd   xmm0, qword ptr sxmm0 // movsd for zero extension
end;
{$endif CPUX64}

const
  STUB_SIZE = 65536; // 16*4 KB (4 KB = memory granularity)

{$ifdef FPC} // alf: multi platforms support
{$ifndef MSWINDOWS}
var
  StubCallAllocMemLastStart: PtrUInt; // avoid unneeded fpmmap() calls

function StubCallAllocMem(const Size, flProtect: DWORD): pointer;
{$ifdef CPUARM}
const
  STUB_RELJMP = {$ifdef CPUARM}$7fffff{$else}$7fffffff{$endif}; // relative jmp
  STUB_INTERV = STUB_RELJMP+1; // try to reserve in closed stub interval
  STUB_ALIGN = QWord($ffffffffffff0000); // align to STUB_SIZE
var start,stop,stub,dist: PtrUInt;
begin
  stub := PtrUInt(@TInterfacedObjectFake.ArmFakeStub);
  if StubCallAllocMemLastStart<>0 then
    start := StubCallAllocMemLastStart else begin
    start := stub-STUB_INTERV;
    if start>stub then
      start := 0; // avoid range overflow
    start := start and STUB_ALIGN;
  end;
  stop := stub+STUB_INTERV;
  if stop<stub then
    stop := high(PtrUInt);
  stop := stop and STUB_ALIGN;
  while start<stop do begin // try whole -STUB_INTERV..+STUB_INTERV range
    inc(start,STUB_SIZE);
    result := fpmmap(pointer(start),STUB_SIZE,flProtect,MAP_PRIVATE or MAP_ANONYMOUS,-1,0);
    if result<>MAP_FAILED then begin // close enough for a 24/32-bit relative jump?
      dist := abs(stub-PtrUInt(result));
      if dist<STUB_RELJMP then begin
        StubCallAllocMemLastStart := start;
        exit;
      end else
        fpmunmap(result,STUB_SIZE);
    end;
  end;
  result := MAP_FAILED; // error
end;
{$else} // other platforms (Intel+Arm64) use absolute call
begin
  result := fpmmap(nil,STUB_SIZE,flProtect,MAP_PRIVATE OR MAP_ANONYMOUS,-1,0);
end;
{$endif CPUARM}
{$endif MSWINDOWS}
{$endif FPC}

type
  // internal memory buffer created with PAGE_EXECUTE_READWRITE flags
  TFakeStubBuffer = class
  protected
    fStub: PByteArray;
    fStubUsed: cardinal;
  public
    constructor Create;
    destructor Destroy; override;
    // call shall be protected by InterfaceFactoryCache critical section
    class function Reserve(size: Cardinal): pointer;
  end;

var
  CurrentFakeStubBuffer: TFakeStubBuffer;
  {$ifdef UNIX}
  MemoryProtection: boolean = false;
  {$endif UNIX}

constructor TFakeStubBuffer.Create;
begin
  {$ifdef MSWINDOWS}
  fStub := VirtualAlloc(nil,STUB_SIZE,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  if fStub=nil then
  {$else MSWINDOWS}
  {$ifdef KYLIX3}
  fStub := mmap(nil,STUB_SIZE,PROT_READ or PROT_WRITE or PROT_EXEC,MAP_PRIVATE or MAP_ANONYMOUS,-1,0);
  {$else}
  if not MemoryProtection then
    fStub := StubCallAllocMem(STUB_SIZE,PROT_READ or PROT_WRITE or PROT_EXEC);
  if (fStub=MAP_FAILED) or MemoryProtection then begin
    // i.e. on OpenBSD, we can have w^x protection
    fStub := StubCallAllocMem(STUB_SIZE,PROT_READ OR PROT_WRITE);
    if fStub<>MAP_FAILED then 
      MemoryProtection := True;
  end;
  {$endif KYLIX3}
  if fStub=MAP_FAILED then
  {$endif MSWINDOWS}
    raise EServiceException.CreateUTF8('%.Create: OS memory allocation failed',[Self]);
end;

destructor TFakeStubBuffer.Destroy;
begin
  {$ifdef MSWINDOWS}
  VirtualFree(fStub,0,MEM_RELEASE);
  {$else}
  {$ifdef KYLIX3}
  munmap(fStub,STUB_SIZE);
  {$else}
  fpmunmap(fStub,STUB_SIZE);
  {$endif}
  {$endif}
  inherited;
end;

class function TFakeStubBuffer.Reserve(size: Cardinal): pointer;
begin
  if size>STUB_SIZE then
    raise EServiceException.CreateUTF8('%.Reserve(size=%>%)',[self,size,STUB_SIZE]);
  if CurrentFakeStubBuffer=nil then
    GarbageCollectorFreeAndNil(CurrentFakeStubBuffer,TFakeStubBuffer.Create) else
  if CurrentFakeStubBuffer.fStubUsed+size>STUB_SIZE then begin
    GarbageCollector.Add(CurrentFakeStubBuffer);
    CurrentFakeStubBuffer := TFakeStubBuffer.Create;
  end;
  with CurrentFakeStubBuffer do begin
    result := @fStub[fStubUsed];
    inc(fStubUsed,size);
  end;
end;

function TInterfaceFactory.GetMethodsVirtualTable: pointer;
var i, tmp: cardinal;
    P: PCardinal;
    {$ifdef UNIX}
    PageAlignedFakeStub: pointer;
    {$endif UNIX}
    {$ifdef CPUAARCH64}stub: PtrUInt;{$endif}
begin
  if fFakeVTable=nil then begin
    InterfaceFactoryCache.Safe.Lock;
    try
      if fFakeVTable=nil then begin // avoid race condition error
        SetLength(fFakeVTable,fMethodsCount+RESERVED_VTABLE_SLOTS);
        fFakeVTable[0] := @TInterfacedObjectFake.FakeQueryInterface;
        fFakeVTable[1] := @TInterfacedObjectFake.Fake_AddRef;
        fFakeVTable[2] := @TInterfacedObjectFake.Fake_Release;
        if fMethodsCount=0 then begin
          result := pointer(fFakeVTable);
          exit;
        end;
        tmp := {$ifdef CPUX86}fMethodsCount*24{$endif}
               {$ifdef CPUX64}fMethodsCount*16{$endif}
               {$ifdef CPUARM}fMethodsCount*12{$endif}
               {$ifdef CPUAARCH64}($120 shr 2)+fMethodsCount*28{$endif};
        fFakeStub := TFakeStubBuffer.Reserve(tmp);
        P := pointer(fFakeStub);
        {$ifdef CPUAARCH64}
        PtrUInt(P) := PtrUInt(P)+$120;
        {$endif};
        {$ifdef UNIX}
        if MemoryProtection then begin
          // Disable execution permission of memory to be able to write into memory
          PageAlignedFakeStub := Pointer((PtrUInt(P) DIV SystemInfo.dwPageSize) * SystemInfo.dwPageSize);
          if SynMProtect(PageAlignedFakeStub , (SystemInfo.dwPageSize shl 1), PROT_READ or PROT_WRITE)<0 then
             raise EServiceException.CreateUTF8('%.Create: SynMProtect write failure.',[self]);
        end;
        {$endif UNIX}
        for i := 0 to fMethodsCount-1 do begin
          fFakeVTable[i+RESERVED_VTABLE_SLOTS] := P;
          {$ifdef CPUX64}
          PWord(P)^ := $b848; inc(PWord(P)); // mov rax,offset x64FakeStub
          PPtrUInt(P)^ := PtrUInt(@x64FakeStub); inc(PPtrUInt(P));
          PByte(P)^ := $50; inc(PByte(P)); // push rax
          P^ := $b866+(i shl 16); inc(P);  // mov (r)ax,{MethodIndex}
          PByte(P)^ := $c3; inc(PByte(P)); // ret
          {$endif CPUX64}
          {$ifdef CPUARM}
          {$ifdef ASMORIG}
          P^ := ($e3a040 shl 8)+i;  inc(P); // mov r4 (v1),{MethodIndex} : store method index in register
          {$else}
          P^ := ($e3a0c0 shl 8)+i;  inc(P); // mov r12 (ip),{MethodIndex} : store method index in register
          {$endif}
          tmp := ((PtrUInt(@TInterfacedObjectFake.ArmFakeStub)-PtrUInt(P)) shr 2)-2;
          P^ := ($ea shl 24) + (tmp and $00ffffff); // branch ArmFakeStub (24bit relative, word aligned)
          inc(P);
          P^ := $e320f000; inc(P);
          {$endif CPUARM}
          {$ifdef CPUAARCH64}
          // store method index in register r16 [IP0]
          // $10 = r16 ... loop to $1F -> number shifted * $20
          P^ := ($d280 shl 16)+(i shl 5)+$10; inc(P);  // mov r16 ,{MethodIndex}
          // we are using a register branch here
          // fill register x10 with address
          stub := PtrUInt(@TInterfacedObjectFake.AArch64FakeStub);
          tmp := (stub shr 0) and $ffff;
          P^ := ($d280 shl 16)+(tmp shl 5)+$0a; inc(P);
          tmp := (stub shr 16) and $ffff;
          P^ := ($f2a0 shl 16)+(tmp shl 5)+$0a; inc(P);
          tmp := (stub shr 32) and $ffff;
          P^ := ($f2c0 shl 16)+(tmp shl 5)+$0a; inc(P);
          tmp := (stub shr 48) and $ffff;
          P^ := ($f2e0 shl 16)+(tmp shl 5)+$0a; inc(P);
          // branch to address in x10 register
          P^ := $d61f0140; inc(P);
          P^ := $d503201f; inc(P);
          {$endif CPUAARCH64}
          {$ifdef CPUX86}
          P^ := $68ec8b55; inc(P);                 // push ebp; mov ebp,esp
          P^ := i; inc(P);                         // push {MethodIndex}
          P^ := $e2895251; inc(P);                 // push ecx; push edx; mov edx,esp
          PByte(P)^ := $e8; inc(PByte(P));         // call FakeCall
          P^ := PtrUInt(@TInterfacedObjectFake.FakeCall)-PtrUInt(P)-4; inc(P);
          P^ := $c25dec89; inc(P);                 // mov esp,ebp; pop ebp
          {$ifdef DARWIN}
          P^ := $900000;  // ret; nop
          {$else}
          P^ := fMethods[i].ArgsSizeInStack or $900000;  // ret {StackSize}; nop
          {$endif DARWIN}
          inc(PByte(P),3);
          {$endif CPUX86}
        end;
        {$ifdef UNIX}
        if MemoryProtection then 
          // Enable execution permission of memory
          if SynMProtect(PageAlignedFakeStub , (SystemInfo.dwPageSize shl 1), PROT_READ OR PROT_EXEC)<0 then
             raise EServiceException.CreateUTF8('%.Create: SynMProtect exec failure.',[self]);
        {$endif UNIX}
      end;
    finally
      InterfaceFactoryCache.Safe.UnLock;
    end;
  end;
  result := pointer(fFakeVTable);
end;


{$ifdef HASINTERFACERTTI} // see http://bugs.freepascal.org/view.php?id=26774

{ TInterfaceFactoryRTTI }

type
  TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
    mkClassProcedure, mkClassFunction, mkClassConstructor, mkClassDestructor,
    mkOperatorOverload{$ifndef FPC},{ Obsolete } mkSafeProcedure, mkSafeFunction{$endif});
  {$ifndef FPC}
  TIntfMethodEntryTail =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif} record
    {$ifdef FPC_NEWRTTI}
    ResultType: PPTypeInfo;
    CC: TCallingConvention;
    Kind: TMethodKind;
    ParamCount: Word;
    StackSize: SizeInt;
    Name: PShortString;
    {$else}
    Kind: TMethodKind;
    CC: TCallingConvention;
    ParamCount: Byte;
    {Params: array[0..ParamCount - 1] of TVmtMethodParam;}
    {$endif FPC_NEWRTTI}
  end;
  {$endif FPC}

procedure TInterfaceFactoryRTTI.AddMethodsFromTypeInfo(aInterface: PTypeInfo);
const
  {$ifdef FPC}
  {$if defined(CPUI386) or defined(CPUI8086) or defined(CPUX86_64) or defined(CPUM68K)}
  DEFCC = ccRegister;
  {$else}
  DEFCC = ccStdCall;
  {$ifend}
  {$else}
  DEFCC = ccRegister;
  {$endif FPC}
var P: Pointer;
    {$ifdef FPC}
    PI: PFPCInterfaceData;  // low-level types redirected from SynFPCTypInfo
    VMP: PFPCVmtMethodParam;
    methtable: PFPCIntfMethodTable;
    PME: PFPCIntfMethodEntry;
    PW: PWord;
    aResultType: PTypeInfo;
    argsindex: word;
    {$else}
    PI: PInterfaceTypeData absolute P;
    PB: PByte absolute P;
    PS: PShortString absolute P;
    PME: ^TIntfMethodEntryTail absolute P;
    PF: ^TParamFlags absolute P;
    PP: ^PPTypeInfo absolute P;
    PW: PWord absolute P;
    {$endif FPC}
    Ancestor: PTypeInfo;
    Kind: TMethodKind;
    f: TParamFlags;
    m: integer;
    paramcounter: word;
    sm: PServiceMethod;
    n,na: cardinal;
    aURI: RawUTF8;

  procedure RaiseError(const Format: RawUTF8; const Args: array of const);
  begin
    raise EInterfaceFactoryException.CreateUTF8('%.AddMethodsFromTypeInfo(%.%) failed - %',
      [self,fInterfaceName,aURI,FormatUTF8(Format,Args)]);
  end;

begin
  // handle interface inheritance via recursive calls
  P := GetTypeDataClean(aInterface^);
  {$ifdef FPC}
  PI := P;
  if PI^.Parent<>nil then
    Ancestor := Deref(pointer(PI^.Parent)) else
  {$else}
  if PI^.IntfParent<>nil then
    Ancestor := Deref(PI^.IntfParent) else
  {$endif FPC}
    Ancestor := nil;
  if Ancestor<>nil then begin
    AddMethodsFromTypeInfo(Ancestor);
    inc(fAddMethodsLevel);
  end;
  {$ifdef FPC}
  if PI^.UnitName='System' then
    exit;
  methtable := PI^.MethodTable;
  n := methtable^.Count;
  PW := @methtable^.RttiCount;
  if (PW^=$ffff) or (n=0) then
    exit; // no RTTI or no method at this level of interface
  {$else}
  P := @PI^.IntfUnit[ord(PI^.IntfUnit[0])+1];
  n := PW^;
  inc(PW);
  if (PW^=$ffff) or (n=0) then
    exit; // no RTTI or no method at this level of interface
  inc(PW);
  {$endif FPC}
  for m := 0 to n-1 do begin
    // retrieve method name, and add to the methods list (with hashing)
    {$ifdef FPC}
    PME := methtable^.Method[m];
    ShortStringToAnsi7String(PME^.Name,aURI);
    {$else}
    ShortStringToAnsi7String(PS^,aURI);
    {$endif FPC}
    sm := fMethod.AddUniqueName(aURI,'%.% method: duplicated name for %',
      [fInterfaceTypeInfo^.Name,aURI,self]);
    sm^.HierarchyLevel := fAddMethodsLevel;
    {$ifndef FPC}
    PS := @PS^[ord(PS^[0])+1]; // skip method name in Delphi
    {$endif FPC}
    Kind := TMethodKind(PME^.Kind);
    if TCallingConvention(PME^.CC)<>DEFCC then
      RaiseError('unhandled calling convention %',[SynCommons.GetEnumName(
        TypeInfo(TCallingConvention),ord(PME^.CC))^]);
    // retrieve method call arguments from RTTI
    n := PME^.ParamCount;
    {$ifndef FPC}
    inc(PME); // PF now points to parameter flags for Delphi
    {$endif FPC}
    na := n;
    if Kind=mkFunction then
      inc(na); // function result is an additional output parameter
    if na>MAX_METHOD_ARGS then
       RaiseError('method has too many parameters: %>%',[na,MAX_METHOD_ARGS]);
    SetLength(sm^.Args,na);
    {$ifdef FPC}
    aResultType := Deref(pointer(PME^.ResultType));
    if aResultType<>nil then
      with sm^.Args[n] do begin
        ParamName := @PSEUDO_RESULT_NAME;
        ValueDirection := smdResult;
        ArgTypeInfo := aResultType;
        if ArgTypeInfo=TypeInfo(Integer) then // under FPC integer->'longint'
          ArgTypeName := @INTEGER_NAME else
          ArgTypeName := @ArgTypeInfo^.Name;
      end;
    argsindex := 0;
    {$endif FPC}
    paramcounter := 0;
    while paramcounter<n do
    {$ifdef FPC} begin // FPC has its own RTTI layout
      VMP := PME^.Param[paramcounter];
      f := mORMot.TParamFlags(VMP^.Flags);
      with sm^.Args[argsindex] do begin
        if pfVar in f then
          ValueDirection := smdVar else
        if pfOut in f then
          ValueDirection := smdOut;
          sm^.ArgsNotResultLast := argsindex;
        if ValueDirection<>smdConst then
            sm^.ArgsOutNotResultLast := argsindex;
        ArgTypeInfo := pointer(Deref(pointer(VMP^.ParamType)));
        ArgTypeName := @ArgTypeInfo^.Name;
        if paramcounter>0 then
        case TypeInfoToMethodValueType(ArgTypeInfo) of
        smvRecord,smvDynArray:
          if f*[pfConst,pfVar,pfOut{$IFDEF FPC_HAS_CONSTREF},pfConstRef{$endif}]=[] then
             RaiseError('%: % parameter should be declared as const, var or out',
               [ParamName^,ArgTypeName^]);
        smvInterface:
           if not(pfConst in f) then
             RaiseError('%: % parameter should be declared as const',
               [ParamName^,ArgTypeName^]);
        end;
        if pfSelf in f then
          ParamName := @PSEUDO_SELF_NAME else
          if pfResult in f then begin
            if (paramcounter<>n-1) or (High(sm^.Args)<>paramcounter+1) then begin
              // at least on ARM, function (result) is on paramcounter different position than on x86
              // so, cleanup and re-use array for next param entry
              FillCharFast(sm^.Args[argsindex],SizeOf(TServiceMethodArgument),0);
              // needed for re-use due to following Inc(argsindex) ... see below
              dec(argsindex);
            end;
            sm^.Args[n-1] := sm^.Args[n];
            SetLength(sm^.Args,n);
          end else
            { since https://svn.freepascal.org/cgi-bin/viewvc.cgi?view=revision&revision=39684
              TVmtMethodParam.Name is a local stack copy -> direct NamePtr use }
            ParamName := {$ifdef VER3_1}@VMP^.Name{$else}VMP^.NamePtr{$endif};
      end;
      inc(paramcounter);
      inc(argsindex);
    end;
    {$else FPC} // Delphi code:
    with sm^.Args[paramcounter] do begin
      f := PF^;
      inc(PF);
      if pfVar in f then
        ValueDirection := smdVar else
      if pfOut in f then
        ValueDirection := smdOut;
      sm^.ArgsNotResultLast := paramcounter;
      if ValueDirection<>smdConst then
        sm^.ArgsOutNotResultLast := paramcounter;
      ParamName := PS;
      PS := @PS^[ord(PS^[0])+1];
      SetFromRTTI(PB);
      {$ifdef ISDELPHIXE}
      inc(PB,PW^); // skip custom attributes
      {$endif ISDELPHIXE}
      if paramcounter>0 then
      case TypeInfoToMethodValueType(ArgTypeInfo) of
      smvRecord,smvDynArray:
        if f*[pfConst,pfVar,pfOut]=[] then
          RaiseError('%: % parameter should be declared as const, var or out',
            [ParamName^,ArgTypeName^]);
      smvInterface:
        if not(pfConst in f) then
          RaiseError('%: % parameter should be declared as const',
            [ParamName^,ArgTypeName^]);
      end;
      inc(paramcounter);
    end;
    // add a pseudo argument after all arguments for functions
    if Kind=mkFunction then
      with sm^.Args[n] do begin
        ParamName := @PSEUDO_RESULT_NAME;
        ValueDirection := smdResult;
        SetFromRTTI(PB);
      end;
    {$ifdef ISDELPHIXE}
    inc(PB,PW^); // skip custom attributes
    {$endif ISDELPHIXE}
    {$endif FPC}
  end; // go to next method
end;

{$endif HASINTERFACERTTI} // see http://bugs.freepascal.org/view.php?id=26774


{ TInterfaceFactoryGenerated }

procedure TInterfaceFactoryGenerated.AddMethod(
  const aName: RawUTF8; const aParams: array of const);
const ARGPERARG = 3; // [ 0,'n1',TypeInfo(Integer), ... ]
var meth: PServiceMethod;
    arg: ^TServiceMethodArgument;
    na,ns,a: integer;
    u: RawUTF8;
begin
  if Length(aParams) mod ARGPERARG<>0 then
    raise EInterfaceFactoryException.CreateUTF8(
      '%: invalid aParams count for %.AddMethod("%")',[fInterfaceName,self,aName]);
  meth := fMethod.AddUniqueName(aName,'%.% method: duplicated generated name for %',
    [fInterfaceName,aName,self]);
  na := length(aParams) div ARGPERARG;
  SetLength(meth^.Args,na+1); // leave Args[0]=self
  with meth^.Args[0] do begin
    ParamName := @PSEUDO_SELF_NAME;
    ArgTypeInfo := fInterfaceTypeInfo;
    ArgTypeName := @ArgTypeInfo^.Name;
  end;
  ns := length(fTempStrings);
  SetLength(fTempStrings,ns+na);
  for a := 0 to na-1 do begin
    arg := @meth^.Args[a+1];
    if aParams[a*ARGPERARG].VType<>vtInteger then
      raise EInterfaceFactoryException.CreateUTF8('%: invalid param type #% for %.AddMethod("%")',
        [fInterfaceTypeInfo^.Name,a,self,aName]);
    arg^.ValueDirection := TServiceMethodValueDirection(aParams[a*ARGPERARG].VInteger);
    VarRecToUTF8(aParams[a*ARGPERARG+1],u);
    if u='' then
      raise EInterfaceFactoryException.CreateUTF8('%: invalid param name #% for %.AddMethod("%")',
        [fInterfaceTypeInfo^.Name,a,self,aName]);
    insert(AnsiChar(Length(u)),u,1); // create fake PShortString
    arg^.ParamName := pointer(u);
    fTempStrings[ns+a] := u;
    if aParams[a*ARGPERARG+2].VType<>vtPointer then
      raise EInterfaceFactoryException.CreateUTF8('%: expect TypeInfo() at #% for %.AddMethod("%")',
        [fInterfaceTypeInfo^.Name,a,self,aName]);
    arg^.ArgTypeInfo := aParams[a*ARGPERARG+2].VPointer;
    {$ifdef FPC} // under FPC, TypeInfo(Integer/Cardinal)=TypeInfo(LongInt/LongWord)
    if arg^.ArgTypeInfo=TypeInfo(Integer) then
      arg^.ArgTypeName := @INTEGER_NAME else
    if arg^.ArgTypeInfo=TypeInfo(Cardinal) then
      arg^.ArgTypeName := @CARDINAL_NAME else
    {$endif FPC}
      arg^.ArgTypeName := @arg^.ArgTypeInfo^.Name;
  end;
end;

class procedure TInterfaceFactoryGenerated.RegisterInterface(aInterface: PTypeInfo);
var i: integer;
begin
  if (aInterface=nil) or (self=TInterfaceFactoryGenerated) then
    raise EInterfaceFactoryException.CreateUTF8('%.RegisterInterface(nil)',[self]);
  EnterInterfaceFactoryCache;
  try
    for i := 0 to InterfaceFactoryCache.Count-1 do
      if TInterfaceFactory(InterfaceFactoryCache.List[i]).fInterfaceTypeInfo=aInterface then
        raise EInterfaceFactoryException.CreateUTF8('Duplicated %.RegisterInterface(%)',
          [self,aInterface^.Name]);
    InterfaceFactoryCache.Add(Create(aInterface));
  finally
    InterfaceFactoryCache.Safe.UnLock;
  end;
end;


{ TInterfacedObjectFakeCallback }

type
  TInterfacedObjectFakeCallback = class(TInterfacedObjectFake)
  protected
    fRest: TSQLRest;
    fName: RawUTF8;
    function FakeInvoke(const aMethod: TServiceMethod; const aParams: RawUTF8;
      aResult, aErrorMsg: PRawUTF8; aClientDrivenID: PCardinal;
      aServiceCustomAnswer: PServiceCustomAnswer): boolean; virtual;
  end;

function TInterfacedObjectFakeCallback.FakeInvoke(const aMethod: TServiceMethod;
  const aParams: RawUTF8; aResult, aErrorMsg: PRawUTF8;
  aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean;
begin
  fRest.InternalLog('%.FakeInvoke %(%)',[ClassType,aMethod.InterfaceDotMethodName,aParams]);
  if aMethod.ArgsOutputValuesCount>0 then begin
    if aErrorMsg<>nil then
      FormatUTF8('%.FakeInvoke [%]: % has out parameters',
        [self,fName,aMethod.InterfaceDotMethodName], aErrorMsg^);
    result := false;
  end else
    result := true;
end;


{ TInterfacedObjectAsynch }

type
  TInterfacedObjectAsynch = class(TInterfacedObjectFakeCallback)
  protected
    fTimer: TSQLRestBackgroundTimer;
    fDest: IInvokable;
    fOnResult: TOnAsynchRedirectResult;
    function FakeInvoke(const aMethod: TServiceMethod; const aParams: RawUTF8;
      aResult, aErrorMsg: PRawUTF8; aClientDrivenID: PCardinal;
      aServiceCustomAnswer: PServiceCustomAnswer): boolean; override;
  public
    constructor Create(aTimer: TSQLRestBackgroundTimer; aFactory: TInterfaceFactory;
      const aDestinationInterface: IInvokable; out aCallbackInterface;
      const aOnResult: TOnAsynchRedirectResult);
  end;
  TInterfacedObjectAsynchCall = packed record
    Method: PServiceMethod;
    Instance: pointer; // weak IInvokable reference
    Params: RawUTF8;
    OnOutputParamsCopy: RawUTF8;
    OnOutput: TOnAsynchRedirectResult;
  end;

constructor TInterfacedObjectAsynch.Create(aTimer: TSQLRestBackgroundTimer;
  aFactory: TInterfaceFactory; const aDestinationInterface: IInvokable;
  out aCallbackInterface; const aOnResult: TOnAsynchRedirectResult);
begin
  fTimer := aTimer;
  fRest := fTimer.fRest;
  fName := fTimer.fThreadName;
  fDest := aDestinationInterface;
  fOnResult := aOnResult;
  inherited Create(aFactory,nil,[ifoJsonAsExtended,ifoDontStoreVoidJSON],FakeInvoke,nil);
  Get(aCallbackInterface);
end;

function TInterfacedObjectAsynch.FakeInvoke(const aMethod: TServiceMethod;
  const aParams: RawUTF8; aResult, aErrorMsg: PRawUTF8;
  aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean;
var msg: RawUTF8;
    call: TInterfacedObjectAsynchCall;
begin
  result := inherited FakeInvoke(aMethod,aParams,aResult,aErrorMsg,
    aClientDrivenID,aServiceCustomAnswer);
  if not result then
    exit;
  call.Method := @aMethod;
  call.Instance := pointer(fDest);
  call.Params := aParams;
  if Assigned(fOnResult) then begin
    FastSetString(call.OnOutputParamsCopy,pointer(aParams),length(aParams));
    call.OnOutput := fOnResult;
  end else
    call.OnOutput := nil;
  msg := RecordSave(call,TypeInfo(TInterfacedObjectAsynchCall));
  result := fTimer.EnQueue(fTimer.AsynchBackgroundExecute,msg,true);
end;


{ TSQLRestBackgroundTimer }

constructor TSQLRestBackgroundTimer.Create(aRest: TSQLRest;
  const aThreadName: RawUTF8; aStats: TSynMonitorClass);
var aName: RawUTF8;
begin
  if aRest=nil then
    raise EORMException.CreateUTF8('%.Create(aRest=nil,"%")',[self,aThreadName]);
  fRest := aRest;
  if aThreadName<>'' then
    aName := aThreadName else
    FormatUTF8('% %',[fRest.Model.Root, ClassType],aName);
  inherited Create(aName,fRest.BeginCurrentThread,fRest.EndCurrentThread,aStats);
end;

destructor TSQLRestBackgroundTimer.Destroy;
begin
  AsynchBatchStop(nil);
  inherited Destroy;
end;

function TSQLRestBackgroundTimer.AsynchBatchIndex(aTable: TSQLRecordClass): integer;
begin
  if (self=nil) or (fBackgroundBatch=nil) then
    result := -1 else begin
    result := fRest.Model.GetTableIndexExisting(aTable);
    if (result>=length(fBackgroundBatch)) or (fBackgroundBatch[result]=nil) then
      result := -1;
  end;
end;

function TSQLRestBackgroundTimer.AsynchBatchLocked(aTable: TSQLRecordClass;
  out aBatch: TSQLRestBatchLocked): boolean;
var b: integer;
begin
  b := AsynchBatchIndex(aTable);
  if b>=0 then begin
    aBatch := fBackgroundBatch[b];
    aBatch.Safe.Lock;
    result := true;
  end else
    result := false;
end;

procedure TSQLRestBackgroundTimer.AsynchBatchUnLock(aBatch: TSQLRestBatchLocked);
begin
  try
    if aBatch.Count>=aBatch.Threshold then
      ExecuteNow(AsynchBatchExecute);
  finally
    aBatch.Safe.UnLock;
  end;
end;

procedure TSQLRestBackgroundTimer.AsynchBatchExecute(Sender: TSynBackgroundTimer;
  Event: TWaitResult; const Msg: RawUTF8);
var data, tablename: RawUTF8;
    table: TSQLRecordClass;
    batch: TSQLRestBatchLocked;
    b, count, status: integer;
    res: TIDDynArray;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  try
    // send any pending data
    for b := 0 to high(fBackgroundBatch) do begin
      batch := fBackgroundBatch[b];
      if batch.Count=0 then
        continue;
      batch.Safe.Lock;
      try
        table := batch.Table;
        count := batch.Count;
        if count>0 then
        try
          {$ifdef WITHLOG}
          if log=nil then
            log := fRest.LogClass.Enter('AsynchBatchExecute % count=%',
              [table,count],self);
          {$endif}
          batch.PrepareForSending(data);
        finally
          batch.Reset;
        end;
      finally
        batch.Safe.UnLock;
      end;
      // inlined TSQLRest.BatchSend for lower contention
      if data<>'' then
      try
        status := fRest.EngineBatchSend(table,data,res,count); // may take a while
        fRest.InternalLog('AsynchBatchExecute % EngineBatchSend=%',[table,status]);
      except
        on E: Exception do
          fRest.InternalLog('% during AsynchBatchExecute %',[E.ClassType,table],sllWarning);
      end;
    end;
  finally
    if IdemPChar(pointer(Msg),'FREE@') then begin // from AsynchBatchStop()
      fRest.InternalLog('AsynchBatchExecute %',[Msg]);
      tablename := copy(Msg,6,127);
      if tablename='' then
        // AsynchBatchStop(nil)
        ObjArrayClear(fBackgroundBatch,true) else begin
        // AsynchBatchStop(table)
        b := fRest.Model.GetTableIndex(tablename);
        if b<length(fBackgroundBatch) then
          FreeAndNil(fBackgroundBatch[b]);
      end;
    end;
  end;
end;

function TSQLRestBackgroundTimer.AsynchBatchStart(Table: TSQLRecordClass;
  SendSeconds, PendingRowThreshold, AutomaticTransactionPerRow: integer;
  Options: TSQLRestBatchOptions): boolean;
var b: Integer;
begin
  result := false;
  if (self=nil) or (SendSeconds<=0) then
    exit;
  b := fRest.Model.GetTableIndexExisting(Table);
  if (fBackgroundBatch<>nil) and (fBackgroundBatch[b]<>nil) then
    exit; // already defined for this Table
  fRest.InternalLog('AsynchBatchStart(%,%,%)',[Table,SendSeconds,PendingRowThreshold],sllDebug);
  Enable(AsynchBatchExecute,SendSeconds);
  if fBackgroundBatch=nil then
    SetLength(fBackgroundBatch,fRest.Model.TablesMax+1);
  fBackgroundBatch[b] := TSQLRestBatchLocked.Create(
    fRest,Table,AutomaticTransactionPerRow,Options);
  fBackgroundBatch[b].Threshold := PendingRowThreshold;
  result := true;
end;

function TSQLRestBackgroundTimer.AsynchBatchStop(Table: TSQLRecordClass): boolean;
var b: integer;
    timeout: Int64;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  result := false;
  if (self=nil) or (fBackgroundBatch=nil) then
    exit;
  {$ifdef WITHLOG}
  log := fRest.LogClass.Enter('AsynchBatchStop(%)',[Table],self);
  {$endif}
  timeout := SynCommons.GetTickCount64+5000;
  if Table=nil then begin // e.g. from TSQLRest.Destroy
    if not EnQueue(AsynchBatchExecute,'free@',true) then
      exit;
    repeat
      SleepHiRes(1); // wait for all batchs to be released
    until (fBackgroundBatch=nil) or (SynCommons.GetTickCount64>timeout);
    result := Disable(AsynchBatchExecute);
  end else begin
    b := AsynchBatchIndex(Table);
    if (b<0) or not EnQueue(AsynchBatchExecute,'free@'+Table.SQLTableName,true) then
      exit;
    repeat
      SleepHiRes(1); // wait for all pending rows to be sent
    until (fBackgroundBatch[b]=nil) or (SynCommons.GetTickCount64>timeout);
    if ObjArrayCount(fBackgroundBatch)>0 then
      result := true else begin
      result := Disable(AsynchBatchExecute);
      if result then
        ObjArrayClear(fBackgroundBatch,true);
    end;
  end;
end;

function TSQLRestBackgroundTimer.AsynchBatchAdd(Value: TSQLRecord; SendData,ForceID: boolean;
  const CustomFields: TSQLFieldBits; DoNotAutoComputeFields: boolean): integer;
var b: TSQLRestBatchLocked;
begin
  result := -1;
  if (self=nil) or (fBackgroundBatch=nil) or (Value=nil) then
    exit;
  fRest.InternalLog('AsynchBatchAdd %',[Value],sllDebug);
  if AsynchBatchLocked(Value.RecordClass,b) then
    try
      result := b.Add(Value,SendData,ForceID,CustomFields,DoNotAutoComputeFields);
    finally
      AsynchBatchUnLock(b);
    end;
end;

function TSQLRestBackgroundTimer.AsynchBatchRawAdd(Table: TSQLRecordClass;
  const SentData: RawUTF8): integer;
var b: TSQLRestBatchLocked;
begin
  result := -1;
  if (self=nil) or (fBackgroundBatch=nil) or (Table=nil) then
    exit;
  fRest.InternalLog('AsynchBatchRawAdd % %',[Table,SentData],sllDebug);
  if AsynchBatchLocked(Table,b) then
    try
      result := b.RawAdd(SentData);
    finally
      AsynchBatchUnLock(b);
    end;
end;

procedure TSQLRestBackgroundTimer.AsynchBatchRawAppend(Table: TSQLRecordClass;
  SentData: TTextWriter);
var b: TSQLRestBatchLocked;
begin
  if (self=nil) or (fBackgroundBatch=nil) or (Table=nil) or (SentData=nil) then
    exit;
  fRest.InternalLog('AsynchBatchRawAppend %',[Table],sllDebug);
  if AsynchBatchLocked(Table,b) then
    try
      b.RawAppend.AddNoJSONEscape(SentData);
    finally
      AsynchBatchUnLock(b);
    end;
end;

function TSQLRestBackgroundTimer.AsynchBatchUpdate(Value: TSQLRecord;
  const CustomFields: TSQLFieldBits; DoNotAutoComputeFields: boolean): integer;
var b: TSQLRestBatchLocked;
begin
  result := -1;
  if (self=nil) or (fBackgroundBatch=nil) or (Value=nil) then
    exit;
  fRest.InternalLog('AsynchBatchUpdate %',[Value],sllDebug);
  if AsynchBatchLocked(Value.RecordClass,b) then
    try
      result := b.Update(Value,CustomFields,DoNotAutoComputeFields);
    finally
      AsynchBatchUnLock(b);
    end;
end;

function TSQLRestBackgroundTimer.AsynchBatchDelete(Table: TSQLRecordClass; ID: TID): integer;
var b: TSQLRestBatchLocked;
begin
  result := -1;
  if (self=nil) or (fBackgroundBatch=nil) then
    exit;
  fRest.InternalLog('AsynchBatchDelete % %',[Table,ID],sllDebug);
  if AsynchBatchLocked(Table,b) then
    try
      result := b.Delete(Table,ID);
    finally
      AsynchBatchUnLock(b);
    end;
end;

procedure TSQLRestBackgroundTimer.AsynchBackgroundExecute(Sender: TSynBackgroundTimer;
  Event: TWaitResult; const Msg: RawUTF8);
var exec: TServiceMethodExecute;
    call: TInterfacedObjectAsynchCall;
    o: PRawUTF8;
    output: RawUTF8;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  if not RecordLoad(call,Msg,TypeInfo(TInterfacedObjectAsynchCall)) then
    exit; // invalid message (e.g. periodic execution)
  {$ifdef WITHLOG}
  log := fRest.LogClass.Enter('AsynchBackgroundExecute % %',
    [call.Method^.InterfaceDotMethodName,call.Params],self);
  {$endif}
  exec := TServiceMethodExecute.Create(call.Method);
  try
    if Assigned(call.OnOutput) then
      o := @output else
      o := nil;
    if not exec.ExecuteJsonCallback(call.Instance,call.Params, o) then
      fRest.InternalLog('%.AsynchBackgroundExecute %: ExecuteJsonCallback failed',
        [ClassType,call.Method^.InterfaceDotMethodName],sllWarning) else
      if o<>nil then
        call.OnOutput(call.Method^,IInvokable(call.Instance),
          call.OnOutputParamsCopy,output);
  finally
    exec.Free;
  end;
end;

procedure TSQLRestBackgroundTimer.AsynchRedirect(const aGUID: TGUID;
  const aDestinationInterface: IInvokable; out aCallbackInterface;
  const aOnResult: TOnAsynchRedirectResult);
var factory: TInterfaceFactory;
begin
  factory := TInterfaceFactory.Get(aGUID);
  if factory=nil then
    raise EInterfaceFactoryException.CreateUTF8('%.AsynchRedirect: unknown %',
      [self,GUIDToShort(aGUID)]);
  if aDestinationInterface=nil then
    raise EInterfaceFactoryException.CreateUTF8('%.AsynchRedirect(nil)',[self]);
  fRest.InternalLog('AsynchRedirect % to % using %',[factory.InterfaceName,
    ObjectFromInterface(aDestinationInterface),self]);
  Enable(AsynchBackgroundExecute,3600);
  TInterfacedObjectAsynch.Create(self,factory,aDestinationInterface,aCallbackInterface,aOnResult);
end;

procedure TSQLRestBackgroundTimer.AsynchRedirect(const aGUID: TGUID;
  const aDestinationInstance: TInterfacedObject; out aCallbackInterface;
  const aOnResult: TOnAsynchRedirectResult);
var dest: IInvokable;
begin
  if aDestinationInstance=nil then
    raise EInterfaceFactoryException.CreateUTF8('%.AsynchRedirect(nil)',[self]);
  if not aDestinationInstance.GetInterface(aGUID,dest) then
    raise EInterfaceFactoryException.CreateUTF8('%.AsynchRedirect [%]: % is not a %',
      [self,fThreadName,aDestinationInstance,GUIDToShort(aGUID)]);
  AsynchRedirect(aGUID,dest,aCallbackInterface,aOnResult);
end;

procedure TSQLRestBackgroundTimer.AsynchBackgroundInterning(
  Sender: TSynBackgroundTimer; Event: TWaitResult; const Msg: RawUTF8);
var i, claimed, total: integer;
    timer: TPrecisionTimer;
begin
  timer.Start;
  claimed := 0;
  for i := 0 to high(fBackgroundInterning) do
    inc(claimed,fBackgroundInterning[i].Clean(fBackgroundInterningMaxRefCount));
  if claimed=0 then
    exit; // nothing to collect
  total := claimed;
  for i := 0 to high(fBackgroundInterning) do
    inc(total,fBackgroundInterning[i].Count);
  fRest.InternalLog('%.AsynchInterning: Clean(%) claimed %/% strings from % pools in %',
    [ClassType,fBackgroundInterningMaxRefCount,claimed,total,
     length(fBackgroundInterning),timer.Stop],sllDebug);
end;

procedure TSQLRestBackgroundTimer.AsynchInterning(Interning: TRawUTF8Interning;
  InterningMaxRefCount, PeriodMinutes: integer);
begin
  if (self=nil) or (Interning=nil) then
    exit;
  fTaskLock.Lock;
  try
    if (InterningMaxRefCount<=0) or (PeriodMinutes<=0) then
      ObjArrayDelete(fBackgroundInterning,Interning) else begin
      fBackgroundInterningMaxRefCount := InterningMaxRefCount;
      ObjArrayAddOnce(fBackgroundInterning,Interning);
      Enable(AsynchBackgroundInterning,PeriodMinutes*60);
    end;
  finally
    fTaskLock.UnLock;
  end;
end;


{ TInterfacedObjectMulti / TInterfacedObjectMultiList }

type
  TInterfacedObjectMultiDest = record
    instance: IInvokable;
    methods: TInterfaceFactoryMethodBits;
  end;
  TInterfacedObjectMultiDestDynArray = array of TInterfacedObjectMultiDest;
  TInterfacedObjectMulti = class;
  TInterfacedObjectMultiList = class(TInterfacedObjectLocked,
    IMultiCallbackRedirect)
  protected
    fDest: TInterfacedObjectMultiDestDynArray;
    fDestCount: integer;
    fDests: TDynArray;
    fFakeCallback: TInterfacedObjectMulti;
    procedure Redirect(const aCallback: IInvokable;
      const aMethodsNames: array of RawUTF8; aSubscribe: boolean); overload;
    procedure Redirect(const aCallback: TInterfacedObject;
      const aMethodsNames: array of RawUTF8; aSubscribe: boolean); overload;
    procedure CallBackUnRegister;
    function GetInstances(aMethod: integer; var aInstances: TPointerDynArray): integer;
    constructor Create; override;
    destructor Destroy; override;
  end;
  TInterfacedObjectMulti = class(TInterfacedObjectFakeCallback)
  protected
    fList: TInterfacedObjectMultiList;
    fCallBackUnRegisterNeeded: boolean;
    function FakeInvoke(const aMethod: TServiceMethod; const aParams: RawUTF8;
      aResult, aErrorMsg: PRawUTF8; aClientDrivenID: PCardinal;
      aServiceCustomAnswer: PServiceCustomAnswer): boolean; override;
  public
    constructor Create(aRest: TSQLRest; aFactory: TInterfaceFactory;
      aCallBackUnRegisterNeeded: boolean; out aCallbackInterface);
    destructor Destroy; override;
    procedure CallBackUnRegister;
  end;

constructor TInterfacedObjectMultiList.Create;
begin
  inherited Create;
  fDests.InitSpecific(TypeInfo(TInterfacedObjectMultiDestDynArray),
    fDest,djInterface,@fDestCount);
end;

procedure TInterfacedObjectMultiList.Redirect(const aCallback: IInvokable;
  const aMethodsNames: array of RawUTF8; aSubscribe: boolean);
var ndx: integer;
    new: TInterfacedObjectMultiDest;
const NAM: array[boolean] of string[11] = ('Unsubscribe','Subscribe');
begin
  if (self=nil) or (fFakeCallback=nil) then
    exit;
  fFakeCallback.fRest.InternalLog('%.Redirect: % % using %',[ClassType,NAM[aSubscribe],
    fFakeCallback.fFactory.fInterfaceName,ObjectFromInterface(aCallback)],sllDebug);
  fFakeCallback.fFactory.CheckMethodIndexes(aMethodsNames,true,new.methods);
  new.instance := aCallback;
  fSafe.Lock;
  try
    ndx := fDests.Find(aCallback);
    if aSubscribe then
      if ndx<0 then
        fDests.Add(new) else
        fDest[ndx] := new else
      fDests.Delete(ndx);
  finally
    fSafe.UnLock;
  end;
end;

procedure TInterfacedObjectMultiList.Redirect(const aCallback: TInterfacedObject;
  const aMethodsNames: array of RawUTF8; aSubscribe: boolean);
var dest: IInvokable;
begin
  if (self=nil) or (fFakeCallback=nil) then
    exit;
  if aCallback=nil then
    raise EInterfaceFactoryException.CreateUTF8('%.Redirect(nil)',[self]);
  if not aCallback.GetInterface(fFakeCallback.fFactory.fInterfaceIID,dest) then
    raise EInterfaceFactoryException.CreateUTF8('%.Redirect [%]: % is not a %',
      [self,fFakeCallback.fName,aCallback,fFakeCallback.fFactory.fInterfaceName]);
  Redirect(dest,aMethodsNames,aSubscribe);
end;

procedure TInterfacedObjectMultiList.CallBackUnRegister;
begin
  fSafe.Lock;
  try
    fDests.ClearSafe;
  finally
    fSafe.UnLock;
  end;
  if fFakeCallback<>nil then begin
    fFakeCallback.CallBackUnRegister;
    fFakeCallback := nil; // disable any further Redirect()
  end;
end;

destructor TInterfacedObjectMultiList.Destroy;
begin
  CallBackUnRegister;
  inherited Destroy;
end;

function TInterfacedObjectMultiList.GetInstances(aMethod: integer;
  var aInstances: TPointerDynArray): integer;
var i: integer;
    dest: ^TInterfacedObjectMultiDest;
begin
  result := 0;
  dec(aMethod,RESERVED_VTABLE_SLOTS);
  if aMethod<0 then
    exit;
  SetLength(aInstances,fDestCount);
  dest := pointer(fDest);
  for i := 1 to fDestCount do begin
    if aMethod in dest^.methods then begin
      aInstances[result] := pointer(dest^.instance);
      inc(result);
    end;
    inc(dest);
  end;
  if result<>fDestCount then
    SetLength(aInstances,result);
end;

procedure TInterfacedObjectMulti.CallBackUnRegister;
begin
  if fCallBackUnRegisterNeeded then begin
    fRest.InternalLog('%.Destroy -> Services.CallbackUnRegister(%)',
      [fList.ClassType,fFactory.fInterfaceTypeInfo.Name],sllDebug);
    fRest.Services.CallBackUnRegister(IInvokable(pointer(@fVTable)));
  end;
end;

constructor TInterfacedObjectMulti.Create(aRest: TSQLRest; aFactory: TInterfaceFactory;
  aCallBackUnRegisterNeeded: boolean; out aCallbackInterface);
begin
  if aRest=nil then
    raise EServiceException.CreateUTF8('%.Create(aRest=nil)',[self]);
  fRest := aRest;
  fName := fRest.Model.Root;
  fCallBackUnRegisterNeeded := aCallBackUnRegisterNeeded;
  fList := TInterfacedObjectMultiList.Create;
  fList.fFakeCallback := self;
  inherited Create(aFactory,nil,[ifoJsonAsExtended,ifoDontStoreVoidJSON],FakeInvoke,nil);
  Get(aCallbackInterface);
end;

destructor TInterfacedObjectMulti.Destroy;
begin
  fList.CallBackUnRegister;
  inherited Destroy;
end;

function TInterfacedObjectMulti.FakeInvoke(const aMethod: TServiceMethod;
  const aParams: RawUTF8; aResult, aErrorMsg: PRawUTF8;
  aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean;
var i: integer;
    exec: TServiceMethodExecute;
    instances: TPointerDynArray;
begin
  result := inherited FakeInvoke(aMethod,aParams,aResult,aErrorMsg,
    aClientDrivenID,aServiceCustomAnswer);
  if not result or (fList.fDestCount=0) then
    exit;
  fList.fSafe.Lock;
  try
    if fList.GetInstances(aMethod.ExecutionMethodIndex,instances)=0 then
      exit;
    exec := TServiceMethodExecute.Create(@aMethod);
    try
      exec.Options := [optIgnoreException]; // use exec.ExecutedInstancesFailed
      result := exec.ExecuteJson(instances,pointer('['+aParams+']'),nil);
      if exec.ExecutedInstancesFailed<>nil then
        for i := high(exec.ExecutedInstancesFailed) downto 0 do
          if exec.ExecutedInstancesFailed[i]<>'' then
          try
            fRest.InternalLog('%.FakeInvoke % failed due to % -> unsubscribe',
              [ClassType,aMethod.InterfaceDotMethodName,exec.ExecutedInstancesFailed[i]],sllDebug);
            fList.fDests.FindAndDelete(instances[i]);
          except // ignore any exception when releasing the (unstable?) callback
          end;
    finally
      exec.Free;
    end;
  finally
    fList.fSafe.UnLock;
  end;
end;

function TSQLRest.MultiRedirect(const aGUID: TGUID; out aCallbackInterface;
  aCallBackUnRegisterNeeded: boolean): IMultiCallbackRedirect;
var factory: TInterfaceFactory;
begin
  factory := TInterfaceFactory.Get(aGUID);
  if factory=nil then
    raise EInterfaceFactoryException.CreateUTF8('%.MultiRedirect: unknown %',
      [self,GUIDToShort(aGUID)]);
   result := TInterfacedObjectMulti.Create(self,factory,aCallBackUnRegisterNeeded,
     aCallbackInterface).fList;
end;


{ TInterfaceStubRules }

function TInterfaceStubRules.FindRuleIndex(const aParams: RawUTF8): integer;
begin
  for result := 0 to length(Rules)-1 do
    if Rules[result].Params=aParams then
      exit;
  result := -1;
end;

function TInterfaceStubRules.FindStrongRuleIndex(const aParams: RawUTF8): integer;
begin
  for result := 0 to length(Rules)-1 do
    if (Rules[result].Kind<>isUndefined) and (Rules[result].Params=aParams) then
      exit;
  result := -1;
end;

procedure TInterfaceStubRules.AddRule(Sender: TInterfaceStub;
  aKind: TInterfaceStubRuleKind; const aParams, aValues: RawUTF8;
  const aEvent: TNotifyEvent; aExceptionClass: ExceptClass;
  aExpectedPassCountOperator: TSQLQueryOperator; aValue: cardinal);
var n,ndx: integer;
begin
  ndx := FindRuleIndex(aParams);
  n := length(Rules);
  if ndx<0 then
    SetLength(Rules,n+1) else
    n := ndx;
  if (aParams='') and (aKind<>isUndefined) then
    DefaultRule := n;
  with Rules[n] do begin
    Params := aParams;
    case aKind of
    isUndefined:
      ; // do not overwrite Values for weak rules like ExpectsCount/ExpectsTrace
    isReturns:
      Values := '['+AValues+']';
    isFails:
      Values := ToText(Sender.ClassType)+' returned error: '+aValues;
    else
      Values := aValues;
    end;
    if aKind=isUndefined then
      if aExpectedPassCountOperator=qoContains then
        ExpectedTraceHash := aValue else begin
        ExpectedPassCountOperator := aExpectedPassCountOperator;
        ExpectedPassCount := aValue;
      end else begin
      Kind := aKind;
      Execute := TMethod(aEvent);
      ExceptionClass := aExceptionClass;
    end;
  end;
end;


{ EInterfaceStub }

constructor EInterfaceStub.Create(Sender: TInterfaceStub;
  const Method: TServiceMethod; const Error: RawUTF8);
begin
  inherited CreateUTF8('Error in % for %.% - %',
    [Sender,Sender.fInterface.fInterfaceName,Method.URI,Error]);
end;

constructor EInterfaceStub.Create(Sender: TInterfaceStub;
  const Method: TServiceMethod; const Format: RawUTF8; const Args: array of const);
begin
  Create(Sender,Method,FormatUTF8(Format,Args));
end;


{ TInterfaceStubLog }

function TInterfaceStubLog.Results: RawUTF8;
begin
  if CustomResults='' then
    result := Method^.DefaultResult else
    result := CustomResults;
end;

procedure TInterfaceStubLog.AddAsText(WR: TTextWriter; aScope: TInterfaceStubLogLayouts;
  SepChar: AnsiChar=',');
begin
  if wName in aScope then
    WR.AddString(Method^.URI);
  if wParams in aScope then begin
    WR.Add('(');
    WR.AddString(Params);
    WR.Add(')');
  end;
  if WasError then begin
    WR.AddShort(' error "');
    WR.AddString(CustomResults);
    WR.Add('"');
  end else
  if (wResults in aScope) and (Method^.ArgsResultIndex>=0) then begin
    if (wName in aScope) or (wParams in aScope) then
      WR.Add('=');
    if CustomResults='' then
      WR.AddString(Method^.DefaultResult) else
      WR.AddString(CustomResults);
  end;
  WR.Add(SepChar);
end;


{ TOnInterfaceStubExecuteParamsAbstract }

constructor TOnInterfaceStubExecuteParamsAbstract.Create(aSender: TInterfaceStub;
  aMethod: PServiceMethod; const aParams,aEventParams: RawUTF8);
begin
  fSender := aSender;
  fMethod := aMethod;
  fParams := aParams;
  fEventParams := aEventParams;
end;

procedure TOnInterfaceStubExecuteParamsAbstract.Error(
  const Format: RawUTF8; const Args: array of const);
begin
  Error(FormatUTF8(Format,Args));
end;

procedure TOnInterfaceStubExecuteParamsAbstract.Error(const aErrorMessage: RawUTF8);
begin
  fFailed := true;
  fResult := aErrorMessage;
end;

function TOnInterfaceStubExecuteParamsAbstract.GetSenderAsMockTestCase: TSynTestCase;
begin
  result := (fSender as TInterfaceMock).TestCase;
end;

{ TOnInterfaceStubExecuteParamsJSON }

procedure TOnInterfaceStubExecuteParamsJSON.Returns(const Values: array of const);
begin
  JSONEncodeArrayOfConst(Values,false,fResult);
end;

procedure TOnInterfaceStubExecuteParamsJSON.Returns(const ValuesJsonArray: RawUTF8);
begin
  fResult := ValuesJsonArray;
end;

{$ifndef NOVARIANTS}

{ TOnInterfaceStubExecuteParamsVariant }

constructor TOnInterfaceStubExecuteParamsVariant.Create(aSender: TInterfaceStub;
  aMethod: PServiceMethod; const aParams, aEventParams: RawUTF8);
var i: integer;
    P: PUTF8Char;
    tmp: TSynTempBuffer;
begin
  inherited;
  SetLength(fInput,fMethod^.ArgsInputValuesCount);
  tmp.Init(aParams);
  try
    P := tmp.buf;
    for i := 0 to fMethod^.ArgsInputValuesCount-1 do
      P := VariantLoadJSON(fInput[i],P,nil,@aSender.fInterface.DocVariantOptions);
  finally
    tmp.Done;
  end;
  SetLength(fOutput,fMethod^.ArgsOutputValuesCount);
end;

function TOnInterfaceStubExecuteParamsVariant.GetInput(Index: Integer): variant;
begin
  if cardinal(Index)>=fMethod^.ArgsInputValuesCount then
    raise EInterfaceStub.Create(fSender,fMethod^,'Input[%>=%]',
      [Index,fMethod^.ArgsInputValuesCount]) else
    result := fInput[Index];
end;

procedure TOnInterfaceStubExecuteParamsVariant.SetOutput(Index: Integer;
  const Value: variant);
begin
  if cardinal(Index)>=fMethod^.ArgsOutputValuesCount then
    raise EInterfaceStub.Create(fSender,fMethod^,'Output[%>=%]',
      [Index,fMethod^.ArgsOutputValuesCount]) else
    fOutput[Index] := Value;
end;

function TOnInterfaceStubExecuteParamsVariant.GetInNamed(const aParamName: RawUTF8): variant;
var L,a,ndx: integer;
begin
  L := Length(aParamName);
  ndx := 0;
  if (L>0) and (fInput<>nil) then
    for a := fMethod^.ArgsInFirst to fMethod^.ArgsInLast do
      with fMethod^.Args[a] do
      if ValueDirection in [smdConst,smdVar] then begin
        if IdemPropName(ParamName^,pointer(aParamName),L) then begin
          result := fInput[ndx];
          exit;
        end;
        inc(ndx);
        if cardinal(ndx)>=cardinal(fMethod^.ArgsInputValuesCount) then
          break;
      end;
  raise EInterfaceStub.Create(fSender,fMethod^,'unknown input parameter [%]',[aParamName]);
end;

function TOnInterfaceStubExecuteParamsVariant.GetInUTF8(const ParamName: RawUTF8): RawUTF8;
var wasString: boolean;
begin
  result := '';
  VariantToUTF8(GetInNamed(ParamName),result,wasString);
end;

procedure TOnInterfaceStubExecuteParamsVariant.SetOutNamed(const aParamName: RawUTF8;
  const Value: variant);
var L,a,ndx: integer;
begin
  L := Length(aParamName);
  ndx := 0;
  if (L>0) and (fOutput<>nil) then
    for a := fMethod^.ArgsOutFirst to fMethod^.ArgsOutLast do
      with fMethod^.Args[a] do
      if ValueDirection<>smdConst then begin
        if IdemPropName(ParamName^,pointer(aParamName),L) then begin
          fOutput[ndx] := Value;
          exit;
        end;
        inc(ndx);
        if cardinal(ndx)>=cardinal(fMethod^.ArgsOutputValuesCount) then
          break;
      end;
  raise EInterfaceStub.Create(fSender,fMethod^,'unknown output parameter [%]',[aParamName]);
end;

procedure TOnInterfaceStubExecuteParamsVariant.SetResultFromOutput;
var a,ndx: integer;
    W: TJSONSerializer;
    temp: TTextWriterStackBuffer;
begin
  fResult := '';
  if fOutput=nil then
    exit;
  W := TJSONSerializer.CreateOwnedStream(temp);
  try
    W.Add('[');
    ndx := 0;
    for a := fMethod^.ArgsOutFirst to fMethod^.ArgsOutLast do
    with fMethod^.Args[a] do
    if ValueDirection<>smdConst then begin
      if TVarData(fOutput[ndx]).VType=varEmpty then
        AddDefaultJSON(W) else begin
        W.AddVariant(fOutput[ndx],twJSONEscape);
        W.Add(',');
      end;
      inc(ndx);
      if cardinal(ndx)>=cardinal(fMethod^.ArgsOutputValuesCount) then
        break;
    end;
    W.CancelLastComma;
    W.Add(']');
    W.SetText(fResult);
  finally
    W.Free;
  end;
end;

function TOnInterfaceStubExecuteParamsVariant.InputAsDocVariant(
  Kind: TServiceMethodParamsDocVariantKind; Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  fMethod^.ArgsValuesAsDocVariant(Kind,TDocVariantData(Result),fInput,true,Options);
end;

function TOnInterfaceStubExecuteParamsVariant.OutputAsDocVariant(
  Kind: TServiceMethodParamsDocVariantKind; Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  fMethod^.ArgsValuesAsDocVariant(Kind,TDocVariantData(Result),fOutput,false,Options);
end;

{$ifdef WITHLOG}
procedure TOnInterfaceStubExecuteParamsVariant.AddLog(aLog: TSynLogClass;
  aOutput: boolean; aLevel: TSynLogInfo);
var val: variant;
begin
  if aLog=nil then
    exit;
  with aLog.Family do
    if aLevel in Level then begin
      if aOutput then
        val := OutputAsDocVariant(pdvObjectFixed) else
        val := InputAsDocVariant(pdvObjectFixed);
      SynLog.Log(aLevel,'%(%)',[fMethod^.InterfaceDotMethodName,
        _Safe(val)^.ToTextPairs('=',',',twJSONEscape)],self);
    end;
end;
{$endif}

{$endif NOVARIANTS}

{ TInterfaceStub }

constructor TInterfaceStub.Create(aFactory: TInterfaceFactory;
  const aInterfaceName: RawUTF8);
var i: integer;
begin
  if aFactory=nil then
    raise EInterfaceStub.CreateUTF8(
      '%.Create(%): Interface not registered - you could use '+
      'TInterfaceFactory.RegisterInterfaces()',[self,aInterfaceName]);
  fInterface := aFactory;
  SetLength(fRules,fInterface.MethodsCount);
  for i := 0 to fInterface.MethodsCount-1 do
    fRules[i].DefaultRule := -1;
  fLog.Init(TypeInfo(TInterfaceStubLogDynArray),fLogs,@fLogCount);
end;

procedure TInterfaceStub.InternalGetInstance(out aStubbedInterface);
var fake: TInterfacedObjectFake;
begin
  fake := TInterfacedObjectFake.Create(fInterface,nil,[ifoJsonAsExtended,ifoDontStoreVoidJSON],
    Invoke,InstanceDestroyed);
  pointer(aStubbedInterface) := @fake.fVTable;
  fake._AddRef;
  fLastInterfacedObjectFake := fake;
end;

function TInterfaceStub.InternalCheck(aValid,aExpectationFailed: boolean;
  const aErrorMsgFmt: RawUTF8; const aErrorMsgArgs: array of const): boolean;
begin
  result := aValid;
  if aExpectationFailed and not aValid then
    raise EInterfaceStub.CreateUTF8('%.InternalCheck(%) failed: %',
      [self,fInterface.fInterfaceName,FormatUTF8(aErrorMsgFmt,aErrorMsgArgs)]);
end;

constructor TInterfaceStub.Create(const aInterfaceName: RawUTF8; out aStubbedInterface);
begin
  Create(TInterfaceFactory.Get(aInterfaceName),aInterfaceName);
  InternalGetInstance(aStubbedInterface);
end;

constructor TInterfaceStub.Create(const aGUID: TGUID; out aStubbedInterface);
begin
  Create(TInterfaceFactory.Get(aGUID),GUIDToRawUTF8(aGUID));
  InternalGetInstance(aStubbedInterface);
end;

constructor TInterfaceStub.Create(aInterface: PTypeInfo; out aStubbedInterface);
begin
  Create(aInterface);
  InternalGetInstance(aStubbedInterface);
end;

constructor TInterfaceStub.Create(aInterface: PTypeInfo);
begin
  Create(TInterfaceFactory.Get(aInterface),ToUTF8(aInterface^.Name));
end;

constructor TInterfaceStub.Create(const aGUID: TGUID);
begin
  Create(TInterfaceFactory.Get(aGUID),ToUTF8(aGUID));
end;

procedure TInterfaceStub.IntSetOptions(Options: TInterfaceStubOptions);
begin
  if Options=fOptions then
    exit;
  fOptions := Options;
end;

procedure TInterfaceStub.IntCheckCount(aMethodIndex, aComputed: cardinal;
  aOperator: TSQLQueryOperator; aCount: cardinal);
var ok: boolean;
begin
  case aOperator of
  qoEqualTo:              ok := aComputed=aCount;
  qoNotEqualTo:           ok := aComputed<>aCount;
  qoLessThan:             ok := aComputed<aCount;
  qoLessThanOrEqualTo:    ok := aComputed<=aCount;
  qoGreaterThan:          ok := aComputed>aCount;
  qoGreaterThanOrEqualTo: ok := aComputed>=aCount;
  else raise EInterfaceStub.CreateUTF8('%.IntCheckCount(): Unexpected % operator',
    [self,Ord(aOperator)]);
  end;
  InternalCheck(ok,True,'ExpectsCount(''%'',%,%) failed: count=%',
    [fInterface.Methods[aMethodIndex].URI,ToText(aOperator)^,aCount,aComputed]);
end;

procedure TInterfaceStub.InstanceDestroyed(aClientDrivenID: cardinal);
var m,r,asmndx: integer;
    num: cardinal;
begin
  if self<>nil then
  try
    if eCount in fHasExpects then
      for m := 0 to fInterface.MethodsCount-1 do
      with fRules[m] do
        for r := 0 to high(Rules) do
        with Rules[r] do
          if ExpectedPassCountOperator<>qoNone then begin
            if Params='' then
              num := MethodPassCount else
              num := RulePassCount;
            IntCheckCount(m,num,ExpectedPassCountOperator,ExpectedPassCount);
          end;
    if fInterfaceExpectedTraceHash<>0 then
      InternalCheck(LogHash=fInterfaceExpectedTraceHash,True,
        'ExpectsTrace(%) returned %',[fInterfaceExpectedTraceHash,LogHash]);
    if eTrace in fHasExpects then
      for m := 0 to fInterface.MethodsCount-1 do
      with fRules[m] do begin
        asmndx := m+RESERVED_VTABLE_SLOTS;
        for r := 0 to high(Rules) do
        with Rules[r] do
        if ExpectedTraceHash<>0 then
          InternalCheck(ExpectedTraceHash=Hash32(IntGetLogAsText(
             asmndx,Params,[wName,wParams,wResults],',')),True,
            'ExpectsTrace(''%'') failed',[fInterface.Methods[m].URI]);
      end;
  finally
    if not (imoFakeInstanceWontReleaseTInterfaceStub in Options) then
      Free; // creature will release its creator
  end;
end;

function TInterfaceStub.SetOptions(Options: TInterfaceStubOptions): TInterfaceStub;
begin
  IntSetOptions(Options);
  result := self;
end;

function TInterfaceStub.Executes(const aMethodName, aParams: RawUTF8;
  aEvent: TOnInterfaceStubExecuteJSON; const aEventParams: RawUTF8): TInterfaceStub;
begin
  fRules[fInterface.CheckMethodIndex(aMethodName)].
    AddRule(self,isExecutesJSON,aParams,aEventParams,TNotifyEvent(aEvent));
  result := self;
end;

function TInterfaceStub.Executes(const aMethodName: RawUTF8;
  aEvent: TOnInterfaceStubExecuteJSON; const aEventParams: RawUTF8): TInterfaceStub;
begin
  result := Executes(aMethodName,'',aEvent,aEventParams);
end;

function TInterfaceStub.Executes(const aMethodName: RawUTF8;
  const aParams: array of const; aEvent: TOnInterfaceStubExecuteJSON;
  const aEventParams: RawUTF8): TInterfaceStub;
begin
  result := Executes(aMethodName,JSONEncodeArrayOfConst(aParams,true),
    aEvent,aEventParams);
end;

{$ifndef NOVARIANTS}

function TInterfaceStub.Executes(const aMethodName, aParams: RawUTF8;
  aEvent: TOnInterfaceStubExecuteVariant; const aEventParams: RawUTF8): TInterfaceStub;
begin
  fRules[fInterface.CheckMethodIndex(aMethodName)].
    AddRule(self,isExecutesVariant,aParams,aEventParams,TNotifyEvent(aEvent));
  result := self;
end;

function TInterfaceStub.Executes(const aMethodName: RawUTF8;
  aEvent: TOnInterfaceStubExecuteVariant; const aEventParams: RawUTF8): TInterfaceStub;
begin
  result := Executes(aMethodName,'',aEvent,aEventParams);
end;

function TInterfaceStub.Executes(const aMethodName: RawUTF8;
  const aParams: array of const; aEvent: TOnInterfaceStubExecuteVariant;
  const aEventParams: RawUTF8): TInterfaceStub;
begin
  result := Executes(aMethodName,JSONEncodeArrayOfConst(aParams,true),
    aEvent,aEventParams);
end;

function TInterfaceStub.Executes(aEvent: TOnInterfaceStubExecuteVariant;
  const aEventParams: RawUTF8): TInterfaceStub;
var i: integer;
begin
  for i := 0 to fInterface.MethodsCount-1 do
    fRules[i].AddRule(self,isExecutesVariant,'',aEventParams,TNotifyEvent(aEvent));
  result := self;
end;

type
  TInterfaceStubExecutesToLog = packed record
    Log: TSynLogClass;
    LogLevel: TSynLogInfo;
    Kind: TServiceMethodParamsDocVariantKind;
  end;
  PInterfaceStubExecutesToLog = ^TInterfaceStubExecutesToLog;

procedure TInterfaceStub.OnExecuteToLog(Ctxt: TOnInterfaceStubExecuteParamsVariant);
begin
  if length(Ctxt.EventParams)=SizeOf(TInterfaceStubExecutesToLog) then
    with PInterfaceStubExecutesToLog(Ctxt.EventParams)^ do
      Log.Add.Log(LogLevel,'% %',[Ctxt.Method^.InterfaceDotMethodName,
        Ctxt.InputAsDocVariant(Kind,JSON_OPTIONS_FAST_EXTENDED)]);
end;

function TInterfaceStub.Executes(aLog: TSynLogClass; aLogLevel: TSynLogInfo;
   aKind: TServiceMethodParamsDocVariantKind): TInterfaceStub;
var tmp: RawUTF8;
begin
  SetLength(tmp,SizeOf(TInterfaceStubExecutesToLog));
  with PInterfaceStubExecutesToLog(tmp)^ do begin
    Log := aLog;
    LogLevel := aLogLevel;
    Kind := aKind;
  end;
  Executes(OnExecuteToLog,tmp);
  result := self;
end;

{$endif NOVARIANTS}

function TInterfaceStub.ExpectsCount(const aMethodName: RawUTF8; aOperator: TSQLQueryOperator;
  aValue: cardinal): TInterfaceStub;
begin
  result := ExpectsCount(aMethodName,'',aOperator,aValue);
end;

function TInterfaceStub.ExpectsCount(const aMethodName, aParams: RawUTF8; aOperator: TSQLQueryOperator;
  aValue: cardinal): TInterfaceStub;
var ndx: integer;
begin
  ndx := fInterface.CheckMethodIndex(aMethodName);
  if aOperator in [qoEqualTo..qoGreaterThanOrEqualTo] then
    with fRules[ndx] do
      AddRule(self,isUndefined,aParams,'',nil,nil,aOperator,aValue) else
    raise EInterfaceStub.Create(self,fInterface.fMethods[ndx],
      'ExpectsCount(aOperator=%)',[ord(aOperator)]);
  include(fHasExpects,eCount);
  result := self;
end;

function TInterfaceStub.ExpectsCount(const aMethodName: RawUTF8;
  const aParams: array of const; aOperator: TSQLQueryOperator; aValue: cardinal): TInterfaceStub;
begin
  result := ExpectsCount(aMethodName,JSONEncodeArrayOfConst(aParams,true),aOperator,aValue);
end;

function TInterfaceStub.ExpectsTrace(aValue: cardinal): TInterfaceStub;
begin
  include(fOptions,imoLogMethodCallsAndResults);
  fInterfaceExpectedTraceHash := aValue;
  result := self;
end;

function TInterfaceStub.ExpectsTrace(const aMethodName: RawUTF8; aValue: cardinal): TInterfaceStub;
begin
  result := ExpectsTrace(aMethodName,'',aValue);
end;

function TInterfaceStub.ExpectsTrace(const aMethodName, aParams: RawUTF8;
  aValue: cardinal): TInterfaceStub;
begin
  fRules[fInterface.CheckMethodIndex(aMethodName)].
    AddRule(self,isUndefined,aParams,'',nil,nil,qoContains,aValue);
  include(fOptions,imoLogMethodCallsAndResults);
  include(fHasExpects,eTrace);
  result := self;
end;

function TInterfaceStub.ExpectsTrace(const aMethodName: RawUTF8;
  const aParams: array of const; aValue: cardinal): TInterfaceStub;
begin
  result := ExpectsTrace(aMethodName,JSONEncodeArrayOfConst(aParams,true),aValue);
end;

function TInterfaceStub.ExpectsTrace(const aValue: RawUTF8): TInterfaceStub;
begin
  result := ExpectsTrace(Hash32(aValue));
end;

function TInterfaceStub.ExpectsTrace(const aMethodName, aValue: RawUTF8): TInterfaceStub;
begin
  result := ExpectsTrace(aMethodName,Hash32(aValue));
end;

function TInterfaceStub.ExpectsTrace(const aMethodName, aParams, aValue: RawUTF8): TInterfaceStub;
begin
  result := ExpectsTrace(aMethodName,aParams,Hash32(aValue));
end;

function TInterfaceStub.ExpectsTrace(const aMethodName: RawUTF8; const aParams: array of const;
  const aValue: RawUTF8): TInterfaceStub;
begin
  result := ExpectsTrace(aMethodName,aParams,Hash32(aValue));
end;

function TInterfaceStub.Fails(const aMethodName, aErrorMsg: RawUTF8): TInterfaceStub;
begin
  result := Fails(aMethodName,'',aErrorMsg);
end;

function TInterfaceStub.Fails(const aMethodName, aParams, aErrorMsg: RawUTF8): TInterfaceStub;
begin
  fRules[fInterface.CheckMethodIndex(aMethodName)].
    AddRule(self,isFails,aParams,aErrorMsg);
  result := self;
end;

function TInterfaceStub.Fails(const aMethodName: RawUTF8; const aParams: array of const;
  const aErrorMsg: RawUTF8): TInterfaceStub;
begin
  result := Fails(aMethodName,JSONEncodeArrayOfConst(aParams,true),aErrorMsg);
end;

function TInterfaceStub.Raises(const aMethodName, aParams: RawUTF8;
  aException: ExceptClass; const aMessage: string): TInterfaceStub;
begin
  fRules[fInterface.CheckMethodIndex(aMethodName)].
    AddRule(self,isRaises,aParams,StringToUTF8(aMessage),nil,aException);
  result := self;
end;

function TInterfaceStub.Raises(const aMethodName: RawUTF8;
  const aParams: array of const; aException: ExceptClass;
  const aMessage: string): TInterfaceStub;
begin
  result := Raises(aMethodName,JSONEncodeArrayOfConst(aParams,true),
    aException,aMessage);
end;

function TInterfaceStub.Raises(const aMethodName: RawUTF8;
  aException: ExceptClass; const aMessage: string): TInterfaceStub;
begin
  result := Raises(aMethodName,'',aException,aMessage);
end;

function TInterfaceStub.Returns(const aMethodName, aParams,
  aExpectedResults: RawUTF8): TInterfaceStub;
begin
  fRules[fInterface.CheckMethodIndex(aMethodName)].
    AddRule(self,isReturns,aParams,aExpectedResults);
  result := self;
end;

function TInterfaceStub.Returns(const aMethodName: RawUTF8; const aParams,
  aExpectedResults: array of const): TInterfaceStub;
begin
  result := Returns(aMethodName,JSONEncodeArrayOfConst(aParams,true),
    JSONEncodeArrayOfConst(aExpectedResults,true));
end;

function TInterfaceStub.Returns(const aMethodName,
  aExpectedResults: RawUTF8): TInterfaceStub;
begin
  result := Returns(aMethodName,'',aExpectedResults);
end;

function TInterfaceStub.Returns(const aMethodName: RawUTF8;
  const aExpectedResults: array of const): TInterfaceStub;
begin
  result := Returns(aMethodName,'',JSONEncodeArrayOfConst(aExpectedResults,true));
end;

function TInterfaceStub.Invoke(const aMethod: TServiceMethod;
  const aParams: RawUTF8; aResult, aErrorMsg: PRawUTF8;
  aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean;
var ndx: cardinal;
    rule: integer;
    ExecutesCtxtJSON: TOnInterfaceStubExecuteParamsJSON;
    ExecutesCtxtVariant: TOnInterfaceStubExecuteParamsVariant;
    log: TInterfaceStubLog;
begin
  ndx := aMethod.ExecutionMethodIndex-RESERVED_VTABLE_SLOTS;
  if ndx>=fInterface.MethodsCount then
    result := false else
    with fRules[ndx] do begin
      inc(MethodPassCount);
      rule := FindStrongRuleIndex(aParams);
      if rule<0 then begin
        rule := FindRuleIndex(aParams);
        if (rule>=0) and (DefaultRule>=0) then
          inc(Rules[rule].RulePassCount);
        rule := DefaultRule;
      end;
      if rule<0 then
        if imoRaiseExceptionIfNoRuleDefined in Options then
          raise EInterfaceStub.Create(self,aMethod,'No rule defined') else begin
        rule := FindRuleIndex(aParams);
        if rule>=0 then
          inc(Rules[rule].RulePassCount);
        if imoReturnErrorIfNoRuleDefined in Options then begin
          result := false;
          FormatUTF8('No stubbing rule defined for %.%',
            [fInterface.fInterfaceName,aMethod.URI],log.CustomResults);
        end else
          result := true;
      end else
      with Rules[rule] do begin
        inc(RulePassCount);
        case Kind of
        isExecutesJSON: begin
          ExecutesCtxtJSON := TOnInterfaceStubExecuteParamsJSON.Create(
            self,@aMethod,aParams,Values);
          try
            TOnInterfaceStubExecuteJSON(Execute)(ExecutesCtxtJSON);
            result := not ExecutesCtxtJSON.Failed;
            log.CustomResults := ExecutesCtxtJSON.Result;
          finally
            ExecutesCtxtJSON.Free;
          end;
        end;
        {$ifndef NOVARIANTS}
        isExecutesVariant: begin
          ExecutesCtxtVariant := TOnInterfaceStubExecuteParamsVariant.Create(
            self,@aMethod,aParams,Values);
          try
            TOnInterfaceStubExecuteVariant(Execute)(ExecutesCtxtVariant);
            result := not ExecutesCtxtVariant.Failed;
            if result then begin
              ExecutesCtxtVariant.SetResultFromOutput;
              log.CustomResults := ExecutesCtxtVariant.Result;
            end;
          finally
            ExecutesCtxtVariant.Free;
          end;
        end;
        {$endif}
        isRaises:
          raise ExceptionClass.Create(UTF8ToString(Values));
        isReturns: begin
          result := true;
          log.CustomResults := Values;
        end;
        isFails: begin
          result := InternalCheck(false,false,'%',[Values]);
          if not result then
            log.CustomResults := Values;
        end;
        else
          result := true; // ignore isUndefined (ExpectsCount only) rules
        end;
      end;
      if result then begin
        if aResult<>nil then // make unique due to JSONDecode() by caller
          if log.CustomResults='' then
            FastSetString(aResult^,pointer(aMethod.DefaultResult),length(aMethod.DefaultResult)) else
            FastSetString(aResult^,pointer(log.CustomResults),length(log.CustomResults));
      end else
      if aErrorMsg<>nil then
        aErrorMsg^ := log.CustomResults;
      if imoLogMethodCallsAndResults in Options then begin
        log.Timestamp64 := GetTickCount64;
        log.WasError := not result;
        log.Method := @aMethod;
        log.Params := aParams;
        fLog.Add(log);
      end;
    end;
end;

function TInterfaceStub.LogAsText(SepChar: AnsiChar): RawUTF8;
begin
  result := IntGetLogAsText(0,'',[wName,wParams,wResults],SepChar);
end;

procedure TInterfaceStub.ClearLog;
begin
  fLog.Clear;
end;

function TInterfaceStub.IntGetLogAsText(asmndx: integer; const aParams: RawUTF8;
  aScope: TInterfaceStubLogLayouts; SepChar: AnsiChar): RawUTF8;
var i: integer;
    WR: TTextWriter;
    temp: TTextWriterStackBuffer;
    log: ^TInterfaceStubLog;
begin
  if fLogCount=0 then
    result := '' else begin
    WR := TTextWriter.CreateOwnedStream(temp);
    try
      log := Pointer(fLogs);
      if asmndx<RESERVED_VTABLE_SLOTS then
        for i := 1 to fLogCount do begin
          log^.AddAsText(WR,aScope,SepChar);
          inc(log);
        end else
        for i := 1 to fLogCount do begin
          if log^.Method^.ExecutionMethodIndex=asmndx then
            if (aParams='') or (log^.Params=aParams) then
              log^.AddAsText(WR,aScope,SepChar);
          inc(log);
        end;
      WR.CancelLastChar(SepChar);
      WR.SetText(result);
    finally
      WR.Free;
    end;
  end;
end;

function TInterfaceStub.GetLogHash: cardinal;
begin
  result := Hash32(LogAsText);
end;

function TInterfaceStub.TryResolve(aInterface: PTypeInfo; out Obj): boolean;
begin
  if aInterface<>fInterface.fInterfaceTypeInfo then
    result := false else begin
    InternalGetInstance(Obj);
    result := true;
  end;
end;

function TInterfaceStub.Implements(aInterface: PTypeInfo): boolean;
begin
  result := fInterface.fInterfaceTypeInfo=aInterface;
end;


{ TInterfaceMock }

constructor TInterfaceMock.Create(aInterface: PTypeInfo;
  out aMockedInterface; aTestCase: TSynTestCase);
begin
  inherited Create(aInterface,aMockedInterface);
  fTestCase := aTestCase;
end;

constructor TInterfaceMock.Create(const aGUID: TGUID; out aMockedInterface;
  aTestCase: TSynTestCase);
begin
  inherited Create(aGUID,aMockedInterface);
  fTestCase := aTestCase;
end;

constructor TInterfaceMock.Create(const aInterfaceName: RawUTF8;
  out aMockedInterface; aTestCase: TSynTestCase);
begin
  inherited Create(aInterfaceName,aMockedInterface);
  fTestCase := aTestCase;
end;

constructor TInterfaceMock.Create(aInterface: PTypeInfo; aTestCase: TSynTestCase);
begin
  inherited Create(aInterface);
  fTestCase := aTestCase;
end;

constructor TInterfaceMock.Create(const aGUID: TGUID; aTestCase: TSynTestCase);
begin
  inherited Create(aGUID);
  fTestCase := aTestCase;
end;

function TInterfaceMock.InternalCheck(aValid,aExpectationFailed: boolean;
  const aErrorMsgFmt: RawUTF8; const aErrorMsgArgs: array of const): boolean;
begin
  if fTestCase=nil then
    result := inherited InternalCheck(aValid,aExpectationFailed,aErrorMsgFmt,aErrorMsgArgs) else begin
    if aValid xor (imoMockFailsWillPassTestCase in Options) then
      fTestCase.Check(true) else
      fTestCase.Check(false,UTF8ToString(FormatUTF8(aErrorMsgFmt,aErrorMsgArgs)));
    result := true; // do not raise any exception at this stage for TInterfaceMock
  end;
end;


{ TInterfaceMockSpy }

constructor TInterfaceMockSpy.Create(aFactory: TInterfaceFactory;
  const aInterfaceName: RawUTF8);
begin
  inherited Create(aFactory,aInterfaceName);
  include(fOptions,imoLogMethodCallsAndResults);
end;

procedure TInterfaceMockSpy.IntSetOptions(Options: TInterfaceStubOptions);
begin
  include(Options,imoLogMethodCallsAndResults);
  inherited IntSetOptions(Options);
end;

procedure TInterfaceMockSpy.Verify(const aMethodName: RawUTF8;
  const aParams: array of const; aOperator: TSQLQueryOperator;
  aCount: cardinal);
begin
  Verify(aMethodName,JSONEncodeArrayOfConst(aParams,true),aOperator,aCount);
end;

procedure TInterfaceMockSpy.Verify(const aMethodName: RawUTF8;
  const aParams: array of const; const aTrace: RawUTF8);
begin
  Verify(aMethodName,JSONEncodeArrayOfConst(aParams,true),aTrace);
end;

procedure TInterfaceMockSpy.Verify(const aMethodName: RawUTF8;
  aOperator: TSQLQueryOperator; aCount: cardinal);
var m: integer;
begin
  m := fInterface.CheckMethodIndex(aMethodName);
  IntCheckCount(m,fRules[m].MethodPassCount,aOperator,aCount);
end;

procedure TInterfaceMockSpy.Verify(const aMethodName, aParams: RawUTF8;
  aOperator: TSQLQueryOperator; aCount: cardinal);
var asmndx, i: integer;
    c: cardinal;
begin
  asmndx := fInterface.CheckMethodIndex(aMethodName)+RESERVED_VTABLE_SLOTS;
  if aParams='' then
    c := fRules[asmndx-RESERVED_VTABLE_SLOTS].MethodPassCount else begin
    c := 0;
    for i := 0 to fLogCount-1 do
      with fLogs[i] do
      if (Method.ExecutionMethodIndex=asmndx) and (Params=aParams) then
        inc(c);
  end;
  IntCheckCount(asmndx-RESERVED_VTABLE_SLOTS,c,aOperator,aCount);
end;

procedure TInterfaceMockSpy.Verify(const aTrace: RawUTF8;
  aScope: TInterfaceMockSpyCheck);
const
  VERIFY_SCOPE: array[TInterfaceMockSpyCheck] of TInterfaceStubLogLayouts = (
    [wName], [wName, wParams], [wName, wParams, wResults]);
begin
  InternalCheck(IntGetLogAsText(0,'',VERIFY_SCOPE[aScope],',')=aTrace,true,
    'Verify(''%'',%) failed',[aTrace,ToText(aScope)^]);
end;

procedure TInterfaceMockSpy.Verify(const aMethodName, aParams, aTrace: RawUTF8);
var m: integer;
begin
  m := fInterface.CheckMethodIndex(aMethodName);
  InternalCheck(
    IntGetLogAsText(m+RESERVED_VTABLE_SLOTS,aParams,[wResults],',')=aTrace,True,
    'Verify(''%'',''%'',''%'') failed',[aMethodName,aParams,aTrace]);
end;

procedure TInterfaceMockSpy.Verify(const aMethodName, aTrace: RawUTF8;
  aScope: TInterfaceMockSpyCheck);
const
  VERIFY_SCOPE: array[TInterfaceMockSpyCheck] of TInterfaceStubLogLayouts = (
    [], [wParams], [wParams, wResults]);
var m: integer;
begin
  m := fInterface.CheckMethodIndex(aMethodName);
  if aScope=chkName then
    raise EInterfaceStub.Create(self,fInterface.Methods[m],'Invalid scope for Verify()');
  InternalCheck(
    IntGetLogAsText(m+RESERVED_VTABLE_SLOTS,'',VERIFY_SCOPE[aScope],',')=aTrace,True,
    'Verify(''%'',''%'',%) failed',[aMethodName,aTrace,ToText(aScope)^]);
end;


{ TInterfaceResolverForSingleInterface }

constructor TInterfaceResolverForSingleInterface.Create(
  aInterface: PTypeInfo; aImplementation: TInterfacedObjectClass);
var guid: PGUID;
begin
  fInterfaceTypeInfo := aInterface;
  guid := aInterface^.InterfaceGUID;
  if guid=nil then
    raise EInterfaceResolverException.CreateUTF8('%.Create expects an Interface',[self]);
  fImplementationEntry := aImplementation.GetInterfaceEntry(guid^);
  if fImplementationEntry=nil then
    raise EInterfaceResolverException.CreateUTF8('%.Create: % does not implement %',
      [self,aImplementation,fInterfaceTypeInfo^.Name]);
  aInterface^.InterfaceAncestors(fInterfaceAncestors,aImplementation,
    fInterfaceAncestorsImplementationEntry);
  fImplementation.Init(aImplementation);
end;

constructor TInterfaceResolverForSingleInterface.Create(const aInterface: TGUID;
  aImplementation: TInterfacedObjectClass);
begin
  Create(TInterfaceFactory.GUID2TypeInfo(aInterface),aImplementation);
end;

function TInterfaceResolverForSingleInterface.CreateInstance: TInterfacedObject;
begin
  result := TInterfacedObject(fImplementation.CreateNew);
end;

function TInterfaceResolverForSingleInterface.GetImplementationName: string;
begin
  if (self=nil) or (fImplementation.ItemClass=nil) then
    result := '' else
    result := string(fImplementation.ItemClass.ClassName);
end;

function TInterfaceResolverForSingleInterface.GetOneInstance(out Obj): boolean;
begin
  if (self=nil) or (fImplementation.ItemClass=nil) then
    result := false else
    // here we now that CreateInstance will implement the interface
    result := GetInterfaceFromEntry(CreateInstance,fImplementationEntry,Obj);
end;

function TInterfaceResolverForSingleInterface.TryResolve(
  aInterface: PTypeInfo; out Obj): boolean;
var i: integer;
begin
  if fImplementation.ItemClass=nil then
    result := false else
  if fInterfaceTypeInfo=aInterface then
    result := GetInterfaceFromEntry(
      CreateInstance,fImplementationEntry,Obj) else begin
    // if not found exact interface, try any parent/ancestor interface
    for i := 0 to length(fInterfaceAncestors)-1 do
      if fInterfaceAncestors[i]=aInterface then begin
        // here we know that CreateInstance will implement fInterfaceAncestors[]
        result := GetInterfaceFromEntry(
          CreateInstance,fInterfaceAncestorsImplementationEntry[i],Obj);
        exit;
      end;
    result := false;
  end;
end;

function TInterfaceResolverForSingleInterface.Implements(aInterface: PTypeInfo): boolean;
var i: integer;
begin
  result := true;
  if fInterfaceTypeInfo=aInterface then
    exit; // found exact interface
  for i := 0 to length(fInterfaceAncestors)-1 do
    if fInterfaceAncestors[i]=aInterface then
      exit; // found any parent/ancestor interface
  result := false;
end;


{ TInterfaceResolverInjected }

var
  GlobalInterfaceResolutionLock: TRTLCriticalSection;
  GlobalInterfaceResolution: array of record
    TypeInfo: PTypeInfo;
    ImplementationClass: TClassInstance;
    InterfaceEntry: PInterfaceEntry;
    Instance: IInterface;
  end;

class function TInterfaceResolverInjected.RegisterGlobalCheck(aInterface: PTypeInfo;
  aImplementationClass: TClass): PInterfaceEntry;
var i: integer;
begin
  if (aInterface=nil) or (aImplementationClass=nil) then
    raise EInterfaceResolverException.CreateUTF8('%.RegisterGlobal(nil)',[self]);
  if aInterface^.Kind<>tkInterface then
    raise EInterfaceResolverException.CreateUTF8('%.RegisterGlobal(%): % is not an interface',
      [self,aInterface^.Name]);
  result := aImplementationClass.GetInterfaceEntry(aInterface^.InterfaceGUID^);
  if result=nil then
    raise EInterfaceResolverException.CreateUTF8('%.RegisterGlobal(): % does not implement %',
      [self,aImplementationClass,aInterface^.Name]);
  EnterCriticalSection(GlobalInterfaceResolutionLock);
  for i := 0 to length(GlobalInterfaceResolution)-1 do
    if GlobalInterfaceResolution[i].TypeInfo=aInterface then begin
      LeaveCriticalSection(GlobalInterfaceResolutionLock); // release fSafe.Lock now
      raise EInterfaceResolverException.CreateUTF8('%.RegisterGlobal(%): % already registered',
        [self,aImplementationClass,aInterface^.Name]);
    end;
end; // caller should explicitly call finally LeaveCriticalSection(...) end;

class procedure TInterfaceResolverInjected.RegisterGlobal(
  aInterface: PTypeInfo; aImplementationClass: TInterfacedObjectClass);
var aInterfaceEntry: PInterfaceEntry;
    n: integer;
begin
  aInterfaceEntry := RegisterGlobalCheck(aInterface,aImplementationClass);
  try // here we are protected within a EnterCriticalSection() call
    n := length(GlobalInterfaceResolution);
    SetLength(GlobalInterfaceResolution,n+1);
    with GlobalInterfaceResolution[n] do begin
      TypeInfo := aInterface;
      ImplementationClass.Init(aImplementationClass);
      InterfaceEntry := aInterfaceEntry;
    end;
  finally
    LeaveCriticalSection(GlobalInterfaceResolutionLock);
  end;
end;

class procedure TInterfaceResolverInjected.RegisterGlobal(
  aInterface: PTypeInfo; aImplementation: TInterfacedObject);
var aInterfaceEntry: PInterfaceEntry;
    n: integer;
begin
  aInterfaceEntry := RegisterGlobalCheck(aInterface,aImplementation.ClassType);
  try // here we are protected within a EnterCriticalSection() call
    n := length(GlobalInterfaceResolution);
    SetLength(GlobalInterfaceResolution,n+1);
    with GlobalInterfaceResolution[n] do begin
      if not GetInterfaceFromEntry(aImplementation,aInterfaceEntry,Instance) then
        raise EInterfaceResolverException.CreateUTF8('Unexcepted %.RegisterGlobal(%,%)',
          [self,aInterface^.Name,aImplementation]);
      TypeInfo := aInterface;
      InterfaceEntry := aInterfaceEntry;
    end;
  finally
    LeaveCriticalSection(GlobalInterfaceResolutionLock);
  end;
end;

class procedure TInterfaceResolverInjected.RegisterGlobalDelete(aInterface: PTypeInfo);
var i,n: integer;
begin
  if (aInterface=nil) or (aInterface^.Kind<>tkInterface) then
    raise EInterfaceResolverException.CreateUTF8('%.RegisterGlobalDelete(?)',[self]);
  EnterCriticalSection(GlobalInterfaceResolutionLock);
  try
    n := length(GlobalInterfaceResolution)-1;
    for i := 0 to n do
      with GlobalInterfaceResolution[i] do
      if TypeInfo=aInterface then begin
        if Instance=nil then
          raise EInterfaceResolverException.CreateUTF8(
            '%.RegisterGlobalDelete(%) does not match an instance, but a class',
            [self,aInterface^.Name]);
        Instance := nil; // avoid GPF
        if n>i then
          MoveFast(GlobalInterfaceResolution[i+1],GlobalInterfaceResolution[i],
            (n-i)*SizeOf(GlobalInterfaceResolution[i]));
        SetLength(GlobalInterfaceResolution,n);
        exit;
      end;
  finally
    LeaveCriticalSection(GlobalInterfaceResolutionLock);
  end;
end;

procedure FinalizeGlobalInterfaceResolution;
begin
  GlobalInterfaceResolution := nil; // also cleanup Instance fields
  DeleteCriticalSection(GlobalInterfaceResolutionLock);
  DeleteCriticalSection(vmtAutoTableLock);
end;

function TInterfaceResolverInjected.TryResolve(aInterface: PTypeInfo; out Obj): boolean;
var i: integer;
begin
  if aInterface<>nil then begin
    result := true;
    if self<>nil then begin // first check local DI/IoC
      if fResolvers<>nil then
      for i := 0 to length(fResolvers)-1 do
        if fResolvers[i].TryResolve(aInterface,Obj) then
          exit;
      if fDependencies<>nil then
      for i := 0 to Length(fDependencies)-1 do
        if fDependencies[i].GetInterface(aInterface^.InterfaceGUID^,Obj) then
          exit;
    end;
    EnterCriticalSection(GlobalInterfaceResolutionLock); // shared DI/IoC
    try
      for i := 0 to length(GlobalInterfaceResolution)-1 do
        with GlobalInterfaceResolution[i] do
        if TypeInfo=aInterface then
          if Instance<>nil then begin
            IInterface(Obj) := Instance;
            exit;
          end else
            if GetInterfaceFromEntry(ImplementationClass.CreateNew,InterfaceEntry,Obj) then
              exit;
    finally
      LeaveCriticalSection(GlobalInterfaceResolutionLock);
    end;
  end;
  result := false;
end;

function TInterfaceResolverInjected.TryResolveInternal(aInterface: PTypeInfo; out Obj): boolean;
var i: integer;
begin
  result := true;
  if (self<>nil) and (aInterface<>nil) and (fResolvers<>nil) then
    for i := 0 to length(fResolvers)-1 do
      if fResolvers[i].TryResolve(aInterface,Obj) then
        exit;
  result := false;
end;

function TInterfaceResolverInjected.Implements(aInterface: PTypeInfo): boolean;
var i: integer;
begin
  result := true;
  if (self<>nil) and (aInterface<>nil) and (fResolvers<>nil) then
    for i := 0 to length(fResolvers)-1 do
      if fResolvers[i].Implements(aInterface) then
        exit;
  result := false;
end;

procedure TInterfaceResolverInjected.InjectStub(const aStubsByGUID: array of TGUID);
var i: integer;
begin
  for i := 0 to high(aStubsByGUID) do
    InjectResolver([TInterfaceStub.Create(aStubsByGUID[i])]);
end;

procedure TInterfaceResolverInjected.InjectResolver(
  const aOtherResolvers: array of TInterfaceResolver; OwnOtherResolvers: boolean);
var i: integer;
begin
  for i := 0 to high(aOtherResolvers) do
  if aOtherResolvers[i]<>nil then begin
    if aOtherResolvers[i].InheritsFrom(TInterfaceStub) then begin
      include(TInterfaceStub(aOtherResolvers[i]).fOptions,
        imoFakeInstanceWontReleaseTInterfaceStub);
      ObjArrayAdd(fResolversToBeReleased,aOtherResolvers[i]);
    end else
    if OwnOtherResolvers then
      ObjArrayAdd(fResolversToBeReleased,aOtherResolvers[i]);
    ObjArrayAddOnce(fResolvers,aOtherResolvers[i]);
  end;
end;

procedure TInterfaceResolverInjected.InjectInstance(
  const aDependencies: array of TInterfacedObject);
var i: integer;
begin
  for i := 0 to high(aDependencies) do
  if aDependencies[i]<>nil then begin
    IInterface(aDependencies[i])._AddRef; // Destroy will do _Release
    ObjArrayAdd(fDependencies,aDependencies[i]);
  end;
end;

destructor TInterfaceResolverInjected.Destroy;
var i: integer;
begin
  try
    ObjArrayClear(fResolversToBeReleased);
    for i := 0 to length(fDependencies)-1 do
      IInterface(fDependencies[i])._Release;
  finally
    inherited Destroy;
  end;
end;

function TInterfaceResolverInjected.Resolve(aInterface: PTypeInfo; out Obj): boolean;
begin
  if self=nil then
    result := false else
    result := TryResolve(aInterface,Obj);
end;

function TInterfaceResolverInjected.Resolve(const aGUID: TGUID; out Obj): boolean;
var known: TInterfaceFactory;
begin
  if self=nil then
    result := false else begin
    known := TInterfaceFactory.Get(aGUID);
    if known<>nil then
      result := Resolve(known.fInterfaceTypeInfo,Obj) else
      result := false;
  end;
end;

procedure TInterfaceResolverInjected.ResolveByPair(
  const aInterfaceObjPairs: array of pointer; aRaiseExceptionIfNotFound: boolean);
var n,i: integer;
begin
  n := length(aInterfaceObjPairs);
  if (n=0) or (n and 1=1) then
    raise EServiceException.CreateUTF8('%.Resolve([odd])',[self]);
  for i := 0 to (n shr 1)-1 do
    if not Resolve(aInterfaceObjPairs[i*2],aInterfaceObjPairs[i*2+1]^) then
      if aRaiseExceptionIfNotFound then
        raise EServiceException.CreateUTF8('%.ResolveByPair(%) unsatisfied',
          [self,PTypeInfo(aInterfaceObjPairs[i*2])^.Name]);
end;

procedure TInterfaceResolverInjected.Resolve(const aInterfaces: array of TGUID;
  const aObjs: array of pointer; aRaiseExceptionIfNotFound: boolean);
var n,i: integer;
    info: PTypeInfo;
begin
  n := length(aInterfaces);
  if (n=0) or (n<>length(aObjs)) then
    raise EServiceException.CreateUTF8('%.Resolve([?,?])',[self]);
  for i := 0 to n-1 do
  if PPointer(aObjs[i])^=nil then begin
    info := TInterfaceFactory.GUID2TypeInfo(aInterfaces[i]);
    if not Resolve(info,aObjs[i]^) then
      if aRaiseExceptionIfNotFound then
        raise EServiceException.CreateUTF8('%.Resolve(%) unsatisfied',[self,info^.Name]);
  end;
end;


{ TInjectableObject }

function TInjectableObject.TryResolve(aInterface: PTypeInfo; out Obj): boolean;
begin
  if (self<>nil) and (aInterface<>nil) and (fResolver<>nil) then
    result := fResolver.TryResolve(aInterface,Obj) else
    result := false;
end;

procedure TInjectableObject.Resolve(aInterface: PTypeInfo; out Obj);
begin
  if not TryResolve(aInterface,Obj) then
    raise EServiceException.CreateUTF8('%.Resolve(%) unsatisfied',[self,aInterface^.Name]);
end;

procedure TInjectableObject.Resolve(const aGUID: TGUID; out Obj);
var info: PTypeInfo;
begin
  info := TInterfaceFactory.GUID2TypeInfo(aGUID);
  if not TryResolve(info,Obj) then
    raise EServiceException.CreateUTF8(
      '%.Resolve(%): Interface not registered',[self,info^.Name]);
end;

procedure TInjectableObject.ResolveByPair(const aInterfaceObjPairs: array of pointer);
begin
  if fResolver.InheritsFrom(TInterfaceResolverInjected) then
    TInterfaceResolverInjected(fResolver).ResolveByPair(aInterfaceObjPairs) else
  if high(aInterfaceObjPairs)=1 then
    Resolve(aInterfaceObjPairs[0],aInterfaceObjPairs[1]^) else
    raise EServiceException.CreateUTF8('%.ResolveByPair(?)',[self]);
end;

procedure TInjectableObject.Resolve(const aInterfaces: array of TGUID;
  const aObjs: array of pointer);
begin
  if fResolver.InheritsFrom(TInterfaceResolverInjected) then
    TInterfaceResolverInjected(fResolver).Resolve(aInterfaces,aObjs) else
  if (high(aInterfaces)=0) and (high(aObjs)=0) then
    Resolve(aInterfaces[0],aObjs[0]^) else
    raise EServiceException.CreateUTF8('%.Resolve(?,?)',[self]);
end;

procedure TInjectableObject.AutoResolve(aRaiseEServiceExceptionIfNotFound: boolean);
var i: integer;
    CT: TClass;
    P: PPropInfo;
    addr: pointer;
begin
  if (self=nil) or (fResolver=nil) then
    raise EServiceException.CreateUTF8('%.AutoResolve with no prior registration',[self]);
  CT := ClassType;
  if CT<>TInjectableObject then
  repeat
    for i := 1 to InternalClassPropInfo(CT,P) do begin
      if P^.PropType^.Kind=tkInterface then
        if P^.GetterIsField then begin
          addr := P^.GetterAddr(self);
          if not TryResolve(P^.TypeInfo,addr^) then
            if aRaiseEServiceExceptionIfNotFound then
              raise EServiceException.CreateUTF8(
                '%.AutoResolve: impossible to resolve published property %: %',
                [self,P^.Name,P^.PropType^.Name]);
        end else
          raise EServiceException.CreateUTF8(
            '%.AutoResolve: published property %: % should directly read the field',
            [self,P^.Name,P^.PropType^.Name]);
      P := P^.Next;
    end;
    CT := GetClassParent(CT);
  until CT=TInjectableObject;
end;

constructor TInjectableObject.CreateInjected(const aStubsByGUID: array of TGUID;
  const aOtherResolvers: array of TInterfaceResolver;
  const aDependencies: array of TInterfacedObject;
  aRaiseEServiceExceptionIfNotFound: boolean);
begin
  fResolver := TInterfaceResolverInjected.Create;
  fResolverOwned := true;
  TInterfaceResolverInjected(fResolver).InjectStub(aStubsByGUID);
  TInterfaceResolverInjected(fResolver).InjectResolver(aOtherResolvers);
  TInterfaceResolverInjected(fResolver).InjectInstance(aDependencies);
  Create;
  AutoResolve(aRaiseEServiceExceptionIfNotFound);
end;

constructor TInjectableObject.CreateWithResolver(aResolver: TInterfaceResolver;
  aRaiseEServiceExceptionIfNotFound: boolean);
begin
  if fResolver<>nil then
    exit; // inject once!
  if aResolver=nil then
    raise EServiceException.CreateUTF8('%.CreateWithResolver(nil)',[self]);
  fResolver := aResolver; // may be needed by overriden Create
  Create;
  AutoResolve(aRaiseEServiceExceptionIfNotFound);
end;

destructor TInjectableObject.Destroy;
begin
  inherited Destroy;
  CleanupInstance; // ensure creatures are released before their creator
  if fResolverOwned then
    FreeAndNil(fResolver); // let the creator move away
end;


{ TInjectableObjectRest }

constructor TInjectableObjectRest.CreateWithResolverAndRest(
  aResolver: TInterfaceResolver; aFactory: TServiceFactoryServer;
  aServer: TSQLRestServer; aRaiseEServiceExceptionIfNotFound: boolean);
begin
  fFactory := aFactory; // may be needed by overriden Create
  fServer := aServer;
  CreateWithResolver(aResolver,aRaiseEServiceExceptionIfNotFound);
end;


{ TServiceFactory }

constructor TServiceFactory.Create(aRest: TSQLRest;
  aInterface: PTypeInfo; aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8);
begin
  // check supplied interface
  if (aRest=nil) or (aInterface=nil) then
    raise EServiceException.CreateUTF8('Invalid %.Create(%,%)',[self,aRest,aInterface]);
  inherited Create;
  fInterface := TInterfaceFactory.Get(aInterface);
  fRest := aRest;
  fInstanceCreation := aInstanceCreation;
  fInterfaceMangledURI := BinToBase64URI(@fInterface.fInterfaceIID,SizeOf(TGUID));
  fInterfaceURI := ToUTF8(aInterface^.Name);
  if fInterfaceURI[1] in ['I','i'] then
    delete(fInterfaceURI,1,1);
  if fRest.Model.GetTableIndex(fInterfaceURI)>=0 then
    raise EServiceException.CreateUTF8('%.Create: I% routing name is '+
      'already used by a % SQL table name',[self,fInterfaceURI,fInterfaceURI]);
  SetLength(fExecution,fInterface.fMethodsCount);
  // compute interface signature (aka "contract"), serialized as a JSON object
  FormatUTF8('{"contract":"%","implementation":"%","methods":%}',
    [InterfaceURI,LowerCase(TrimLeftLowerCaseShort(ToText(InstanceCreation))),
     fInterface.fContract],fContract);
  fContractHash := '"'+CardinalToHex(Hash32(fContract))+
    CardinalToHex(CRC32string(fContract))+'"'; // 2 hashes to avoid collision
  if aContractExpected<>'' then // override default contract
    if aContractExpected[1]<>'"' then // stored as JSON string
      fContractExpected := '"'+aContractExpected+'"' else
      fContractExpected := aContractExpected else
    fContractExpected := fContractHash; // for security
end;

function TServiceFactory.GetInterfaceTypeInfo: PTypeInfo;
begin
  if (Self<>nil) and (fInterface<>nil) then
    result := fInterface.fInterfaceTypeInfo else
    result := nil;
end;

function TServiceFactory.GetInterfaceIID: TGUID;
begin
  result := fInterface.fInterfaceIID;
end;

procedure TServiceFactory.ExecutionAction(const aMethod: array of RawUTF8;
  aOptions: TServiceMethodOptions; aAction: TServiceMethodOptionsAction);
  procedure SetAction(var exec: TServiceFactoryExecution);
  begin
    case aAction of
    moaReplace:
      exec.Options := aOptions;
    moaInclude:
      exec.Options := exec.Options + aOptions;
    moaExclude:
      exec.Options := exec.Options - aOptions;
    end;
  end;
var i,m: integer;
begin
  if high(aMethod)<0 then
    for i := 0 to fInterface.fMethodsCount-1 do
      SetAction(fExecution[i]) else
    for m := 0 to high(aMethod) do
      SetAction(fExecution[fInterface.CheckMethodIndex(aMethod[m])]);
  fAnyOptions := [];
  for i := 0 to fInterface.fMethodsCount-1 do
    fAnyOptions := fAnyOptions+fExecution[i].Options;
end;


{ TServiceContainerServer }

function TServiceContainerServer.AddImplementation(
  aImplementationClass: TInterfacedClass; const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  aSharedImplementation: TInterfacedObject; const aContractExpected: RawUTF8): TServiceFactoryServer;
var C: TClass;
    T: PInterfaceTable;
    i, j: PtrInt;
    UID: array of PGUID;
    F: TServiceFactoryServer;
begin
  result := nil;
  // check input parameters
  if (self=nil) or (aImplementationClass=nil) or (high(aInterfaces)<0) then
    exit;
  if aSharedImplementation<>nil then
    if (aSharedImplementation.ClassType<>aImplementationClass) or
       (aInstanceCreation<>sicShared) then
      raise EServiceException.CreateUTF8('%.AddImplementation: invalid % class',
        [self,aSharedImplementation]);
  CheckInterface(aInterfaces);
  SetLength(UID,length(aInterfaces));
  for j := 0 to high(aInterfaces) do
    UID[j] := pointer(aInterfaces[j]^.InterfaceGUID);
  // check all interfaces available in aSharedImplementation/aImplementationClass
  if (aSharedImplementation<>nil) and
     aSharedImplementation.InheritsFrom(TInterfacedObjectFake) then begin
    if IsEqualGUID(UID[0],@TInterfacedObjectFake(aSharedImplementation).
        fFactory.fInterfaceIID) then
      UID[0] := nil; // mark TGUID implemented by this fake interface
  end else begin
    C := aImplementationClass; // search all implemented TGUID for this class
    repeat
      T := C.GetInterfaceTable;
      if T<>nil then
        for i := 0 to T^.EntryCount-1 do
          with T^.Entries[i] do
          for j := 0 to high(aInterfaces) do
            if (UID[j]<>nil) and
               IsEqualGUID(UID[j],{$ifdef FPC}IID{$else}@IID{$endif}) then begin
              UID[j] := nil; // mark TGUID found
              break;
            end;
      C := GetClassParent(C);
    until C=nil;
  end;
  for j := 0 to high(aInterfaces) do
    if UID[j]<>nil then
      raise EServiceException.CreateUTF8('%.AddImplementation: % not found in %',
        [self,aInterfaces[j]^.Name,aImplementationClass]);
  // register this implementation class
  for j := 0 to high(aInterfaces) do begin
    F := TServiceFactoryServer.Create(Rest as TSQLRestServer,aInterfaces[j],
      aInstanceCreation,aImplementationClass,aContractExpected,
      fSessionTimeout,aSharedImplementation);
    if result=nil then begin
      result := F; // returns the first registered interface
      if (aInstanceCreation=sicShared) and (aSharedImplementation=nil) then
        aSharedImplementation := F.fSharedInstance; // re-use existing instance
    end;
    AddServiceInternal(F);
  end;
end;

procedure TServiceContainerServer.OnCloseSession(aSessionID: cardinal);
var i,j: Integer;
    P: ^TServiceFactoryServerInstance;
    fact: TServiceFactoryServer;
    inst: TServiceFactoryServerInstance;
begin
  for i := 0 to high(fInterface) do begin
    fact := TServiceFactoryServer(fInterface[i].Service);
    if fact.fInstanceCount>0 then
    case fact.InstanceCreation of
    sicPerSession: begin
      inst.InstanceID := aSessionID;
      fact.InternalInstanceRetrieve(inst,ord(imFree),aSessionID);
    end;
    sicClientDriven: begin // release ASAP if was not notified by client
      EnterCriticalSection(fact.fInstanceLock);
      try
        P := pointer(fact.fInstances);
        for j := 1 to fact.fInstanceCapacity do begin
          if P^.Session=aSessionID then
            P^.SafeFreeInstance(fact);
          inc(P);
        end;
      finally
        LeaveCriticalSection(fact.fInstanceLock);
      end;
    end;
    end;
  end;
end;

constructor TServiceContainerServer.Create(aRest: TSQLRest);
begin
  inherited Create(aRest);
  fSessionTimeout := 30*60; // 30 minutes by default
end;

destructor TServiceContainerServer.Destroy;
var i: integer;
begin
  if fFakeCallbacks<>nil then begin
    for i := 0 to fFakeCallbacks.Count-1 do // prevent GPF in Destroy
      TInterfacedObjectFakeServer(fFakeCallbacks.List[i]).fServer := nil;
    FreeAndNil(fFakeCallbacks); // do not own objects
  end;
  fRecordVersionCallback := nil; // to be done after fFakeCallbacks[].fServer := nil
  inherited Destroy;
end;

procedure TServiceContainerServer.FakeCallbackAdd(aFakeInstance: TObject);
begin
  if self=nil then
    exit;
  if fFakeCallbacks=nil then
    fFakeCallbacks := TSynObjectListLocked.Create(false);
  fFakeCallbacks.Add(aFakeInstance);
end;

procedure TServiceContainerServer.FakeCallbackRemove(aFakeInstance: TObject);
var i,callbackID: integer;
    connectionID: Int64;
    fake: TInterfacedObjectFakeServer;
    server: TSQLRestServer;
begin
  if (self=nil) or (fFakeCallbacks=nil) then
    exit;
  connectionID := 0;
  callbackID := 0;
  fFakeCallbacks.Safe.Lock;
  try
    i := fFakeCallbacks.IndexOf(aFakeInstance);
    if i>=0 then begin
      fake := fFakeCallbacks.List[i];
      if not fake.fReleasedOnClientSide then begin
        connectionID := fake.fLowLevelConnectionID;
        callbackID := fake.ClientDrivenID;
        if Assigned(OnCallbackReleasedOnServerSide) then
          OnCallbackReleasedOnServerSide(self,fake,fake.fFakeInterface);
      end;
      fFakeCallbacks.Delete(i);
    end;
  finally
    fFakeCallbacks.Safe.UnLock;
  end;
  if connectionID<>0 then begin
    server := fRest as TSQLRestServer;
    if Assigned(server.OnNotifyCallback) then
      server.OnNotifyCallback(server,SERVICE_PSEUDO_METHOD[imFree],'',
        connectionID,callbackID,nil,nil);
  end;
end;

procedure TServiceContainerServer.FakeCallbackRelease(Ctxt: TSQLRestServerURIContext);
var i: integer;
    fake: TInterfacedObjectFakeServer;
    connectionID: Int64;
    fakeID: PtrUInt;
    Values: TNameValuePUTF8CharDynArray;
    withLog: boolean; // avoid stack overflow
begin
  if (self=nil) or (fFakeCallbacks=nil) or (Ctxt=nil) then
    exit;
  connectionID := Ctxt.Call^.LowLevelConnectionID;
  JSONDecode(pointer(Ctxt.Call^.InBody),Values);
  if length(Values)<>1 then
    exit;
  fakeID := GetCardinal(Values[0].Value);
  if (fakeID=0) or (connectionID=0) or (Values[0].Name=nil) then
    exit;
  withLog := not IdemPropNameU('ISynLogCallback',Values[0].Name,Values[0].NameLen);
  if withLog then // avoid stack overflow ;)
    fRest.InternalLog('%.FakeCallbackRelease(%,"%") remote call',
      [ClassType,fakeID,Values[0].Name],sllDebug);
  try
    fFakeCallbacks.Safe.Lock;
    for i := 0 to fFakeCallbacks.Count-1 do begin
      fake := fFakeCallbacks.List[i];
      if (fake.fLowLevelConnectionID=connectionID) and
         (fake.ClientDrivenID=fakeID) then begin
        fake.fReleasedOnClientSide := true;
        if Assigned(OnCallbackReleasedOnClientSide) then
          OnCallbackReleasedOnClientSide(self,fake,fake.fFakeInterface);
        if fake.fService.fInterface.MethodIndexCallbackReleased>=0 then begin
          // emulate a call to CallbackReleased(callback,'ICallbackName')
          Ctxt.ServiceMethodIndex := fake.fService.fInterface.MethodIndexCallbackReleased;
          Ctxt.ServiceMethod := @fake.fService.fInterface.fMethods[Ctxt.ServiceMethodIndex];
          Ctxt.ServiceExecution := @fake.fService.fExecution[Ctxt.ServiceMethodIndex];
          Ctxt.ServiceExecutionOptions := Ctxt.ServiceExecution.Options;
          Ctxt.Service := fake.fService;
          inc(Ctxt.ServiceMethodIndex,SERVICE_PSEUDO_METHOD_COUNT);
          fake._AddRef; // IInvokable=pointer in Ctxt.ExecuteCallback
          Ctxt.ServiceParameters := pointer(FormatUTF8('[%,"%"]',
              [PtrInt(PtrUInt(fake.fFakeInterface)),Values[0].Name]));
          fake.fService.ExecuteMethod(Ctxt);
          if withLog then
            fRest.InternalLog('I%() returned %',[PServiceMethod(Ctxt.ServiceMethod)^.
              InterfaceDotMethodName, Ctxt.Call^.OutStatus],sllDebug);
        end else
          Ctxt.Success;
        exit;
      end;
    end;
  finally
    fFakeCallbacks.Safe.UnLock;
  end;
end;

function TServiceContainerServer.RecordVersionSynchronizeSubscribeMaster(
  TableIndex: integer; RecordVersion: TRecordVersion;
  const SlaveCallback: IServiceRecordVersionCallback): boolean;
var instance: TObject;
begin
  result := false;
  if (self=nil) or (cardinal(TableIndex)>cardinal(fRest.Model.TablesMax)) then
    exit;
  fRest.fAcquireExecution[execORMWrite].fSafe.Lock;
  try
    if RecordVersion<>(fRest as TSQLRestServer).fRecordVersionMax then
      exit; // there are some missing items on the client side
    if fRecordVersionCallback=nil then
      SetLength(fRecordVersionCallback,fRest.Model.TablesMax+1);
    InterfaceArrayAdd(fRecordVersionCallback[TableIndex],SlaveCallback);
    instance := ObjectFromInterface(SlaveCallback);
    if (instance<>nil) and (instance.ClassType=TInterfacedObjectFakeServer) then
      TInterfacedObjectFakeServer(instance).fRaiseExceptionOnInvokeError := True;
  finally
    fRest.fAcquireExecution[execORMWrite].Safe.UnLock;
  end;
  result := true;
end;

class function TServiceContainerServer.CallbackReleasedOnClientSide(
  const callback: IInterface; callbacktext: PShortString): boolean;
  procedure Append(var dest: shortstring; const source: shortstring);
  var d,s: integer;
  begin
    d := ord(dest[0]);
    s := ord(source[0]);
    if d+s<254 then begin
      dest[d+1] := ' ';
      MoveFast(source[1],dest[d+2],s);
      inc(dest[0],s+1);
    end;
  end;
var instance: TObject;
begin
  instance := ObjectFromInterface(callback);
  if instance=nil then
    result := false else begin
    if callbacktext<>nil then
      Append(callbacktext^,ClassNameShort(instance)^);
    result := (instance.ClassType=TInterfacedObjectFakeServer) and
              TInterfacedObjectFakeServer(instance).fReleasedOnClientSide;
  end;
end;

procedure TServiceContainerServer.RecordVersionCallbackNotify(TableIndex: integer;
  Occasion: TSQLOccasion; const DeletedID: TID; const DeletedRevision: TRecordVersion;
  const AddUpdateJson: RawUTF8);
var i: integer;
    arr: ^IServiceRecordVersionCallbackDynArray;
begin
  try
    fRest.fAcquireExecution[execORMWrite].fSafe.Lock;
    try
      arr := @fRecordVersionCallback[TableIndex];
      for i := length(arr^)-1 downto 0 do // downto: InterfaceArrayDelete() below
        if CallbackReleasedOnClientSide(arr^[i]) then
          // automatic removal of any released callback
          InterfaceArrayDelete(arr^,i) else
          try
            case Occasion of
            soInsert: arr^[i].Added(AddUpdateJson);
            soUpdate: arr^[i].Updated(AddUpdateJson);
            soDelete: arr^[i].Deleted(DeletedID,DeletedRevision);
            end;
          except // on notification error -> delete this entry
            InterfaceArrayDelete(arr^,i);
          end;
    finally
      fRest.fAcquireExecution[execORMWrite].Safe.UnLock;
    end;
  except // ignore any exception here
  end;
end;

procedure TServiceContainerServer.RecordVersionNotifyAddUpdate(
  Occasion: TSQLOccasion; TableIndex: integer; const Document: TDocVariantData);
var json: RawUTF8;
begin
  if (Occasion in [soInsert,soUpdate]) and
     (fRecordVersionCallback<>nil) and
     (fRecordVersionCallback[TableIndex]<>nil) then begin
    json := Document.ToJSON;
    RecordVersionCallbackNotify(TableIndex,Occasion,0,0,json);
   end;
end;

procedure TServiceContainerServer.RecordVersionNotifyAddUpdate(
  Occasion: TSQLOccasion; TableIndex: integer; const Decoder: TJSONObjectDecoder);
var json: RawUTF8;
begin
  if (Occasion in [soInsert,soUpdate]) and
     (fRecordVersionCallback<>nil) and
     (fRecordVersionCallback[TableIndex]<>nil) then begin
    Decoder.EncodeAsJSON(json);
    RecordVersionCallbackNotify(TableIndex,Occasion,0,0,json);
   end;
end;

procedure TServiceContainerServer.RecordVersionNotifyDelete(
  TableIndex: integer; const ID: TID; const Revision: TRecordVersion);
begin
  if (fRecordVersionCallback<>nil) and
     (fRecordVersionCallback[TableIndex]<>nil) then
    RecordVersionCallbackNotify(TableIndex,soDelete,ID,Revision,'');
end;

procedure TServiceContainerServer.SetServiceLog(aLogRest: TSQLRest;
  aLogClass: TSQLRecordServiceLogClass; const aExcludedMethodNamesCSV: RawUTF8);
var i,n: integer;
    fact: TServiceFactory;
    excluded: TServiceContainerInterfaceMethodBits;
    methods: TInterfaceFactoryMethodBits;
    somemethods: boolean;
begin
  somemethods := aExcludedMethodNamesCSV<>'';
  if somemethods then
    SetInterfaceMethodBits(pointer(aExcludedMethodNamesCSV),true,excluded) else
    FillcharFast(methods,SizeOf(methods),255);
  n := length(fInterfaceMethod);
  i := 0;
  while i<n do begin
    fact := fInterfaceMethod[i].InterfaceService;
    if somemethods then begin
      FillcharFast(methods,SizeOf(methods),0);
      somemethods := false;
    end;
    repeat
      if (aExcludedMethodNamesCSV<>'') and not (i in excluded) then begin
        include(methods,fInterfaceMethod[i].InterfaceMethodIndex-SERVICE_PSEUDO_METHOD_COUNT);
        somemethods := true;
      end;
      inc(i);
    until (i>=n) or (fInterfaceMethod[i].InterfaceService<>fact);
    if (aExcludedMethodNamesCSV='') or somemethods then
      TServiceFactoryServer(fact).SetServiceLogByIndex(methods,aLogRest,aLogClass);
  end;
end;


{ TServiceFactoryServer }

type
  PCallMethodArgs = ^TCallMethodArgs;
  {$ifdef FPC}
  {$push}
  {$PACKRECORDS 16}
  {$endif}
  TCallMethodArgs = record
    StackSize: PtrInt;
    StackAddr, method: PtrInt;
    ParamRegs: array[PARAMREG_FIRST..PARAMREG_LAST] of PtrInt;
    {$ifdef HAS_FPREG}
    FPRegs: array[FPREG_FIRST..FPREG_LAST] of Double;
    {$endif}
    res64: Int64Rec;
    resKind: TServiceMethodValueType;
  end;
  {$ifdef FPC}
  {$pop}
  {$endif}

// ARM/AARCH64 code below provided by ALF, greatly inspired by pascalscript
{$ifdef CPUARM}
procedure CallMethod(var Args: TCallMethodArgs); assembler; nostackframe;
label stack_loop,load_regs,asmcall_end,float_result;
asm
   //name  r#(normally, darwin can differ)
   //a1    0           argument 1 / integer result / scratch register
   //a2    1           argument 2 / scratch register
   //a3    2           argument 3 / scratch register
   //a4    3           argument 4 / scratch register
   //v1    4           register variable
   //v2    5           register variable
   //v3    6           register variable
   //v4    7           register variable
   //v5    8           register variable
   //sb    9           static base / register variable
   //sl    10          stack limit / stack chunk handle / reg. variable
   //fp    11          frame pointer
   //ip    12          scratch register / new-sb in inter-link-unit calls
   //sp    13          lower end of current stack frame
   //lr    14          link address / scratch register
   //pc    15          program counter

   // sometimes, the entry-point is not exact ... give some room for errors
   nop
   nop
   // prolog
   mov	 ip, sp // sp is the stack pointer ; ip is the Intra-Procedure-call scratch register
   stmfd sp!, {v1, v2, sb, sl, fp, ip, lr, pc}
   sub	 fp, ip, #4
   // make space on stack
   sub	 sp, sp, #MAX_EXECSTACK
   mov   v2, Args
   // copy (push) stack content (if any)
   ldr   a1, [v2,#TCallMethodArgs.StackSize]
   // if there is no stack content, do nothing
   cmp  a1, #0
   beq  load_regs
   // point a2 to bottom of stack.
   mov  a2, sp
   // load a3 with CallMethod stack address
   ldr  a3, [v2,#TCallMethodArgs.StackAddr]
stack_loop:
   // copy a3 to a4 and increment a3 (a3 = StackAddr)
   ldmia a3!, {a4}
   // copy a4 to a2 and increment a2 (a2 = StackPointer)
   stmia a2!, {a4}
   // decrement stacksize counter, with update of flags for loop
   subs  a1, a1, #1
   bne  stack_loop
load_regs:
   ldr   r0, [v2,#TCallMethodArgs.ParamRegs+REGR0*4-4]
   ldr   r1, [v2,#TCallMethodArgs.ParamRegs+REGR1*4-4]
   ldr   r2, [v2,#TCallMethodArgs.ParamRegs+REGR2*4-4]
   ldr   r3, [v2,#TCallMethodArgs.ParamRegs+REGR3*4-4]
   vldr  d0, [v2,#TCallMethodArgs.FPRegs+REGD0*8-8]
   vldr  d1, [v2,#TCallMethodArgs.FPRegs+REGD1*8-8]
   vldr  d2, [v2,#TCallMethodArgs.FPRegs+REGD2*8-8]
   vldr  d3, [v2,#TCallMethodArgs.FPRegs+REGD3*8-8]
   vldr  d4, [v2,#TCallMethodArgs.FPRegs+REGD4*8-8]
   vldr  d5, [v2,#TCallMethodArgs.FPRegs+REGD5*8-8]
   vldr  d6, [v2,#TCallMethodArgs.FPRegs+REGD6*8-8]
   vldr  d7, [v2,#TCallMethodArgs.FPRegs+REGD7*8-8]
   ldr   v1, [v2,#TCallMethodArgs.method]
   {$ifdef CPUARM_HAS_BLX}
   blx   v1
   {$else}
   mov lr, pc
   {$ifdef CPUARM_HAS_BX}
   bx  v1
   {$else}
   mov pc, v1
   {$endif}
   {$endif}
   str   a1, [v2,#TCallMethodArgs.res64.Lo]
   str   a2, [v2,#TCallMethodArgs.res64.Hi]
   ldr   a3, [v2,#TCallMethodArgs.resKind]
   cmp   a3, smvDouble
   beq   float_result
   cmp   a3, smvDateTime
   beq   float_result
   cmp   a3, smvCurrency
   bne   asmcall_end
   // store double result in res64
float_result:
   vstr  d0, [v2,#TCallMethodArgs.res64]
asmcall_end:
   // epilog
   ldmea fp, {v1, v2, sb, sl, fp, sp, pc}
end;
{$endif CPUARM}

{$ifdef CPUAARCH64}
procedure CallMethod(var Args: TCallMethodArgs); assembler; nostackframe;
label stack_loop,load_regs,asmcall_end,float_result;
asm
   // inspired by pascal script
   // fp       x29
   // lr       x30
   // sp       sp

   // sometimes, the entry-point is not exact ... give some room for errors
   nop
   nop
   // prolog
   stp  x29, x30, [sp, #-16]!
   mov  x29, sp
   stp  x19, x19, [sp, #-16]!
   // make space on stack
   sub	sp, sp, #MAX_EXECSTACK
   //and  sp, sp, #-16   // Always align sp.
   mov  x19, Args
   // prepare to copy (push) stack content (if any)
   ldr  x2, [x19,#TCallMethodArgs.StackSize]
   // if there is no stack content, do nothing
   cmp	x2, #0
   b.eq	load_regs
   // point x3 to bottom of stack.
   mov	x3, sp
   // load x4 with CallMethod stack address
   ldr	x4, [x19,#TCallMethodArgs.StackAddr]
stack_loop:
   // load x5 and x6 with stack contents
   ldr  x5, [x4]
   ldr  x6, [x4,#8]
   // store contents at "real" stack and increment address counter x3
   stp	x5, x6, [x3], #16
   // with update of flags for loop
   // (mandatory: stacksize must be a multiple of 2 [16 bytes] !!)
   // inc stackaddr counter by 16 (2 registers are pushed every loop)
   add	x4, x4, #16
   // decrement stacksize counter by 2 (2 registers are pushed every loop),
   // with update of flags for loop
   subs	x2, x2, #2
   b.ne stack_loop
load_regs:
   ldr  x0, [x19,#TCallMethodArgs.ParamRegs+REGX0*8-8]
   ldr  x1, [x19,#TCallMethodArgs.ParamRegs+REGX1*8-8]
   ldr  x2, [x19,#TCallMethodArgs.ParamRegs+REGX2*8-8]
   ldr  x3, [x19,#TCallMethodArgs.ParamRegs+REGX3*8-8]
   ldr  x4, [x19,#TCallMethodArgs.ParamRegs+REGX4*8-8]
   ldr  x5, [x19,#TCallMethodArgs.ParamRegs+REGX5*8-8]
   ldr  x6, [x19,#TCallMethodArgs.ParamRegs+REGX6*8-8]
   ldr  x7, [x19,#TCallMethodArgs.ParamRegs+REGX7*8-8]
   ldr  d0, [x19,#TCallMethodArgs.FPRegs+REGD0*8-8]
   ldr  d1, [x19,#TCallMethodArgs.FPRegs+REGD1*8-8]
   ldr  d2, [x19,#TCallMethodArgs.FPRegs+REGD2*8-8]
   ldr  d3, [x19,#TCallMethodArgs.FPRegs+REGD3*8-8]
   ldr  d4, [x19,#TCallMethodArgs.FPRegs+REGD4*8-8]
   ldr  d5, [x19,#TCallMethodArgs.FPRegs+REGD5*8-8]
   ldr  d6, [x19,#TCallMethodArgs.FPRegs+REGD6*8-8]
   ldr  d7, [x19,#TCallMethodArgs.FPRegs+REGD7*8-8]
   // call TCallMethodArgs.method
   ldr  x15, [x19,#TCallMethodArgs.method]
   blr  x15
   // store normal result
   str  x0, [x19, #TCallMethodArgs.res64]
   ldr  x15, [x19, #TCallMethodArgs.resKind]
   cmp  x15, smvDouble
   b.eq float_result
   cmp  x15, smvDateTime
   b.eq float_result
   cmp  x15, smvCurrency
   b.ne asmcall_end
   // store double result in res64
float_result:
   str  d0, [x19,#TCallMethodArgs.res64]
asmcall_end:
   add  sp, sp, #MAX_EXECSTACK
   ldr  x19,[sp], #16
   ldp  x29,x30,[sp], #16
   ret
end;
{$endif CPUAARCH64}

{$ifdef CPUX64}
procedure CallMethod(var Args: TCallMethodArgs); assembler;
{$ifdef FPC} nostackframe;
asm
        push    rbp
        push    r12
        mov     rbp, rsp
        // simulate .params 60 ... size for 60 parameters
        lea     rsp, [rsp - MAX_EXECSTACK]
        // align stack to 16 bytes
        and     rsp, -16
{$else DELPHI} // ensure we use regular .params command for easier debugging
asm
        .params 64     // size for 64 parameters
        .pushnv r12   // generate prolog+epilog to save and restore non-volatile r12
{$endif FPC}
        // get Args
        mov     r12, Args
        // copy (push) stack content (if any)
        mov     rcx, [r12].TCallMethodArgs.StackSize
        mov     rdx, [r12].TCallMethodArgs.StackAddr
        jmp     @checkstack
@addstack:
        dec     ecx
        push    qword ptr[rdx]
        sub     rdx, 8
@checkstack:
        test    ecx, ecx
        jnz     @addstack
        // fill registers and call method
        {$ifdef LINUX}
        // Linux/BSD System V AMD64 ABI
        mov     rdi, [r12 + TCallMethodArgs.ParamRegs + REGRDI * 8 - 8]
        mov     rsi, [r12 + TCallMethodArgs.ParamRegs + REGRSI * 8 - 8]
        mov     rdx, [r12 + TCallMethodArgs.ParamRegs + REGRDX * 8 - 8]
        mov     rcx, [r12 + TCallMethodArgs.ParamRegs + REGRCX * 8 - 8]
        mov     r8, [r12 + TCallMethodArgs.ParamRegs + REGR8 * 8 - 8]
        mov     r9, [r12 + TCallMethodArgs.ParamRegs + REGR9 * 8 - 8]
        movsd   xmm0, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM0 * 8 - 8]
        movsd   xmm1, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM1 * 8 - 8]
        movsd   xmm2, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM2 * 8 - 8]
        movsd   xmm3, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM3 * 8 - 8]
        movsd   xmm4, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM4 * 8 - 8]
        movsd   xmm5, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM5 * 8 - 8]
        movsd   xmm6, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM6 * 8 - 8]
        movsd   xmm7, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM7 * 8 - 8]
        call    [r12].TCallMethodArgs.method
        {$else}
        // Win64 ABI
        mov     rcx, [r12 + TCallMethodArgs.ParamRegs + REGRCX * 8 - 8]
        mov     rdx, [r12 + TCallMethodArgs.ParamRegs + REGRDX * 8 - 8]
        mov     r8, [r12 + TCallMethodArgs.ParamRegs + REGR8 * 8 - 8]
        mov     r9, [r12 + TCallMethodArgs.ParamRegs + REGR9 * 8 - 8]
        movsd   xmm0, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM0 * 8 - 8]
        movsd   xmm1, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM1 * 8 - 8]
        movsd   xmm2, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM2 * 8 - 8]
        movsd   xmm3, qword ptr[r12 + TCallMethodArgs.FPRegs + REGXMM3 * 8 - 8]
        sub     rsp, 8 * 4   // reserve shadow-space for RCX,RDX,R8,R9 registers
        call    [r12].TCallMethodArgs.method
        add     rsp, 8 * 4
        {$endif LINUX}
        // retrieve result
        mov     [r12].TCallMethodArgs.res64, rax
        mov     cl, [r12].TCallMethodArgs.resKind
        cmp     cl, smvDouble
        je      @d
        cmp     cl, smvDateTime
        je      @d
        cmp     cl, smvCurrency
        jne     @e
@d:     movlpd  qword ptr[r12].TCallMethodArgs.res64, xmm0
        // movlpd to ignore upper 64-bit of 128-bit xmm0 reg
@e:     {$ifdef FPC}
        mov     rsp, rbp
        pop     r12
        pop     rbp
        {$endif}
end;
{$endif CPUX64}

{$ifdef CPUX86}

procedure CallMethod(var Args: TCallMethodArgs);
  {$ifdef FPC}nostackframe; assembler;{$endif}
asm
        push    esi
        push    ebp
        push    eax // keep stack aligned on 16 bytes - required on DARWIN
        mov     ebp, esp
        mov     esi, Args
        // copy stack content (if any)
        mov     eax, [esi].TCallMethodArgs.StackSize
        mov     edx, dword ptr[esi].TCallMethodArgs.StackAddr
        add     edx, eax // pascal/register convention = left-to-right
        shr     eax, 2
        jz      @z
@n:     sub     edx, 4
        mov     ecx, [edx]
        push    ecx
        dec     eax
        jnz     @n
        // before a call instruction, esp should be divisible by 16:
        // mandatory on Darwin, and also on Linux i386 as stated by Florian in
        // https://www.mail-archive.com/fpc-devel@lists.freepascal.org/msg38885.html
@z:     mov     eax, [esi + TCallMethodArgs.ParamRegs + REGEAX * 4 - 4]
        mov     edx, [esi + TCallMethodArgs.ParamRegs + REGEDX * 4 - 4]
        mov     ecx, [esi + TCallMethodArgs.ParamRegs + REGECX * 4 - 4]
        call    [esi].TCallMethodArgs.method
        // retrieve result
        mov     cl, [esi].TCallMethodArgs.resKind
        cmp     cl, smvDouble
        je      @d
        cmp     cl, smvDateTime
        je      @d
        cmp     cl, smvCurrency
        jne     @i
        fistp   qword [esi].TCallMethodArgs.res64
        jmp     @e
@d:     fstp    qword [esi].TCallMethodArgs.res64
        jmp     @e
@i:     mov     [esi].TCallMethodArgs.res64.Lo, eax
        mov     [esi].TCallMethodArgs.res64.Hi, edx
@e:     mov     esp, ebp
        pop     eax
        pop     ebp
        pop     esi
end;
{$endif CPUX86}

{$ifdef ISDELPHI7ANDUP}{$WARN COMPARING_SIGNED_UNSIGNED ON}{$endif}

procedure BackgroundExecuteProc(Call: pointer);
var synch: PBackgroundLauncher absolute Call;
    threadContext: PServiceRunningContext;
    backup: TServiceRunningContext;
begin
  threadContext := @ServiceContext; // faster to use a pointer than GetTls()
  backup := threadContext^;
  threadContext^.Factory := synch^.Context^.Factory;
  threadContext^.Request := synch^.Context^.Request;
  try
    case synch^.Action of
    doCallMethod:
      CallMethod(PCallMethodArgs(synch^.CallMethodArgs)^);
    doInstanceRelease:
      synch^.Instance.InternalRelease;
    doThreadMethod:
      synch^.ThreadMethod;
    end;
  finally
    threadContext^ := backup;
  end;
end;

constructor TServiceFactoryServer.Create(aRestServer: TSQLRestServer;
  aInterface: PTypeInfo; aInstanceCreation: TServiceInstanceImplementation;
  aImplementationClass: TInterfacedClass; const aContractExpected: RawUTF8;
  aTimeOutSec: cardinal; aSharedInstance: TInterfacedObject);
begin
  // extract RTTI from the interface
  InitializeCriticalSection(fInstanceLock);
  inherited Create(aRestServer,aInterface,aInstanceCreation,aContractExpected);
  if fRest.MethodAddress(ShortString(InterfaceURI))<>nil then
    raise EServiceException.CreateUTF8('%.Create: I% already exposed as % published method',
      [self,InterfaceURI,fRest]) else
  fImplementationClass := aImplementationClass;
  if fImplementationClass.InheritsFrom(TInterfacedObjectFake) then begin
    fImplementationClassKind := ickFake;
    if aSharedInstance=nil then
      raise EServiceException.CreateUTF8('%.Create: no Shared Instance for %/I%',
        [self,fImplementationClass,fInterfaceURI]);
    if (aSharedInstance as TInterfacedObjectFake).Factory.fInterfaceTypeInfo<>aInterface then
      raise EServiceException.CreateUTF8('%.Create: shared % instance does not implement I%',
        [self,fImplementationClass,fInterfaceURI]) else
  end else begin
    if aRestServer.Services.Implements(fInterface.fInterfaceTypeInfo) then
      fImplementationClassKind := ickFromInjectedResolver else
    if fImplementationClass.InheritsFrom(TInjectableObjectRest) then
      fImplementationClassKind := ickInjectableRest else
    if fImplementationClass.InheritsFrom(TInjectableObject) then
      fImplementationClassKind := ickInjectable else
    if fImplementationClass.InheritsFrom(TInterfacedObjectWithCustomCreate) then
      fImplementationClassKind := ickWithCustomCreate;
    fImplementationClassInterfaceEntry :=
      fImplementationClass.GetInterfaceEntry(fInterface.fInterfaceIID);
    if fImplementationClassInterfaceEntry=nil then
      raise EServiceException.CreateUTF8('%.Create: % does not implement I%',
        [self,fImplementationClass,fInterfaceURI]) else
  end;
  if (fInterface.MethodIndexCallbackReleased>=0) and
     (InstanceCreation<>sicShared) then
    raise EServiceException.CreateUTF8('%.Create: I%() should be run as sicShared',
      [self,fInterface.fMethods[fInterface.MethodIndexCallbackReleased].
       InterfaceDotMethodName]);
  // initialize the shared instance or client driven parameters
  case InstanceCreation of
  sicShared: begin
    if aSharedInstance=nil then
      fSharedInstance := CreateInstance(false) else
      if aSharedInstance.InheritsFrom(fImplementationClass) then
        fSharedInstance := aSharedInstance else
        raise EServiceException.CreateUTF8('%.Create: % shared instance '+
          'does not inherit from %',[self,aSharedInstance,fImplementationClass]);
    if fImplementationClassKind<>ickFake then
      if (fSharedInstance=nil) or
         not GetInterfaceFromEntry(
           fSharedInstance,fImplementationClassInterfaceEntry,fSharedInterface) then
        raise EServiceException.CreateUTF8('%.Create: % is no implementation of I%',
          [self,fSharedInstance,fInterfaceURI]);
  end;
  sicClientDriven, sicPerSession, sicPerUser, sicPerGroup, sicPerThread:
    if (aTimeOutSec=0) and (InstanceCreation<>sicPerThread) then
      fInstanceCreation := sicSingle else begin
      // only instances list is protected, since client calls shall be pipelined
      fInstance.InitSpecific(TypeInfo(TServiceFactoryServerInstanceDynArray),
        fInstances,djCardinal,@fInstanceCapacity); // sort by InstanceID: cardinal
      fInstanceTimeOut := aTimeOutSec*1000;
    end;
  end;
  SetLength(fStats,fInterface.MethodsCount);
end;

procedure TServiceFactoryServer.SetTimeoutSecInt(value: cardinal);
begin
  if (self=nil) or not (InstanceCreation in [
     sicClientDriven,sicPerSession,sicPerUser,sicPerGroup,sicPerThread]) then
    raise EServiceException.CreateUTF8('%.SetTimeoutSecInt() with %',
      [self,ToText(InstanceCreation)^]);
  fInstanceTimeOut := value*1000;
end;

function TServiceFactoryServer.GetTimeoutSec: cardinal;
begin
  if (self=nil) or not (InstanceCreation in [
     sicClientDriven,sicPerSession,sicPerUser,sicPerGroup,sicPerThread]) then
    result := 0 else
    result := fInstanceTimeout div 1000;
end;

function TServiceFactoryServer.GetStat(const aMethod: RawUTF8): TSynMonitorInputOutput;
begin
  result := fStats[fInterface.CheckMethodIndex(aMethod)];
end;

destructor TServiceFactoryServer.Destroy;
var i: integer;
begin
  if fInstanceCount>0 then
    Rest.InternalLog('%.Destroy for I% %: fInstanceCount=%',[ClassType,fInterfaceURI,
      ToText(InstanceCreation)^,fInstanceCount],sllDebug);
  try
    EnterCriticalSection(fInstanceLock);
    try // release any internal instance (should have been done by client)
      try
        for i := 0 to fInstanceCapacity-1 do
          if fInstances[i].Instance<>nil then
            fInstances[i].SafeFreeInstance(self);
      finally
        {$ifndef LVCL}
        FreeAndNil(fBackgroundThread);
        {$endif}
      end;
    except
      ; // better ignore any error in business logic code
    end;
  finally
    LeaveCriticalSection(fInstanceLock);
  end;
  DeleteCriticalSection(fInstanceLock);
  ObjArrayClear(fStats,true);
  inherited Destroy;
end;

function TServiceFactoryServer.Get(out Obj): Boolean;
var Inst: TServiceFactoryServerInstance;
begin
  result := false;
  if self=nil then
    exit;
  case fInstanceCreation of
  sicShared:
  if fSharedInterface<>nil then begin
    IInterface(Obj) := fSharedInterface; // copy implementation interface
    result := true;
  end;
  sicPerThread: begin
    Inst.Instance := nil;
    Inst.InstanceID := PtrUInt(GetCurrentThreadId);
    if (InternalInstanceRetrieve(Inst,SERVICE_PSEUDO_METHOD_COUNT,0)>=0) and
       (Inst.Instance<>nil) then
      result := GetInterfaceFromEntry(Inst.Instance,fImplementationClassInterfaceEntry,Obj);
  end;
  else begin // no user/group/session on pure server-side -> always sicSingle
    Inst.Instance := CreateInstance(false);
    if Inst.Instance<>nil then
      result := GetInterfaceFromEntry(Inst.Instance,fImplementationClassInterfaceEntry,Obj);
  end;
  end;
  if result then
    with PServiceRunningContext(@ServiceContext)^ do
      if Factory=nil then
        Factory := self;
end;

function TServiceFactoryServer.RetrieveSignature: RawUTF8;
begin
  if self=nil then
    result := '' else
    result := Contract; // just return the current value
end;

function TServiceFactoryServer.RenewSession(aSession: cardinal): integer;
var tix: Int64;
    i: integer;
    P: ^TServiceFactoryServerInstance;
begin
  result := 0;
  if (self=nil) or (fInstanceCount=0) or (aSession<=CONST_AUTHENTICATION_NOT_USED) or
     not(fInstanceCreation in [sicClientDriven,sicPerSession]) then
    exit;
  tix := GetTickCount64;
  EnterCriticalSection(fInstanceLock);
  try
    P := pointer(fInstances);
    for i := 1 to fInstanceCapacity do begin
      if P^.Session=aSession then begin
        P^.LastAccess64 := tix;
        inc(result);
      end;
      inc(P);
    end;
  finally
    LeaveCriticalSection(fInstanceLock);
  end;
end;

function TServiceFactoryServer.RunOnAllInstances(const aEvent: TOnServiceFactoryServerOne;
  var aOpaque): integer;
var i: integer;
    P: ^TServiceFactoryServerInstance;
begin
  result := 0;
  if (self = nil) or not Assigned(aEvent) or (fInstanceCount=0) then
    exit;
  EnterCriticalSection(fInstanceLock);
  try
    P := pointer(fInstances);
    for i := 1 to fInstanceCapacity do begin
      if (P^.InstanceID<>0) and (P^.Instance<>nil) then
        inc(result,aEvent(self,P^,aOpaque));
      inc(P);
    end;
  finally
    LeaveCriticalSection(fInstanceLock);
  end;
end;

procedure TServiceFactoryServerInstance.SafeFreeInstance(Factory: TServiceFactoryServer);
var Obj: TInterfacedObject;
begin
  if Instance=nil then
    exit; // nothing to release
  dec(Factory.fInstanceCount);
  InstanceID := 0;
  Session := 0;
  Obj := Instance;
  Instance := nil;
  try
    {$ifndef LVCL}
    if (optFreeInMainThread in Factory.fAnyOptions) and
       (GetCurrentThreadID<>MainThreadID) then
      BackgroundExecuteInstanceRelease(Obj,nil) else
    {$endif}
    if (optFreeInPerInterfaceThread in Factory.fAnyOptions) and
       Assigned(Factory.fBackgroundThread) then
      BackgroundExecuteInstanceRelease(Obj,Factory.fBackgroundThread) else
      IInterface(Obj)._Release;
  except
    on E: Exception do
      Factory.fRest.Internallog('SafeFreeInstance: Ignored % exception '+
        'during %._Release',[E.ClassType,Factory.InterfaceURI],sllDebug);
  end;
end;

function TServiceFactoryServer.InternalInstanceRetrieve(
  var Inst: TServiceFactoryServerInstance; aMethodIndex,aSession: integer): integer;
  procedure AddNew;
  var i: integer;
      P: ^TServiceFactoryServerInstance;
  begin
    Inst.Session := aSession;
    Inst.Instance := CreateInstance(true);
    if Inst.Instance=nil then
      exit;
    result := aMethodIndex; // notify caller
    inc(fInstanceCount);
    fRest.InternalLog('%.InternalInstanceRetrieve: Adding %(%) instance (id=%) count=%',
      [ClassType,fInterfaceURI,pointer(Inst.Instance),Inst.InstanceID,fInstanceCount],sllDebug);
    P := pointer(fInstances);
    for i := 1 to fInstanceCapacity do
      if P^.InstanceID=0 then begin
        P^ := Inst; // found an empty entry -> re-use it
        exit;
      end else
        inc(P);
    fInstance.Add(Inst); // append a new entry
  end;
var i: integer;
    P: ^TServiceFactoryServerInstance;
begin
  result := -1;
  EnterCriticalSection(fInstanceLock);
  try
    Inst.LastAccess64 := GetTickCount64;
    // first release any deprecated instances
    if (fInstanceTimeout<>0) and (fInstanceCount>0) then begin
      P := pointer(fInstances);
      for i := 1 to fInstanceCapacity do begin
        if (P^.InstanceID<>0) and
           (Inst.LastAccess64>P^.LastAccess64+fInstanceTimeOut) then begin
          fRest.InternalLog('%.InternalInstanceRetrieve: Delete %(%) instance '+
            '(id=%) after % minutes timeout (max % minutes)',[ClassType,fInterfaceURI,
             pointer(Inst.Instance),P^.InstanceID,(Inst.LastAccess64-P^.LastAccess64)div 60000,
             fInstanceTimeOut div 60000],sllInfo);
          P^.SafeFreeInstance(self);
        end;
        inc(P);
      end;
    end;
    if Inst.InstanceID=0 then begin
      // initialize a new sicClientDriven instance
      if (InstanceCreation<>sicClientDriven) or
         ((cardinal(aMethodIndex-SERVICE_PSEUDO_METHOD_COUNT)>=fInterface.fMethodsCount) and
          (aMethodIndex<>ord(imInstance))) then
        exit;
      inc(fInstanceCurrentID);
      Inst.InstanceID := fInstanceCurrentID;
      AddNew;
    end else begin
      // search the instance corresponding to Inst.InstanceID
      if fInstanceCount>0 then begin
        P := pointer(fInstances);
        for i := 1 to fInstanceCapacity do
          if P^.InstanceID=Inst.InstanceID then begin
            result := aMethodIndex; // notify caller
            if aMethodIndex=ord(imFree) then begin
              P^.SafeFreeInstance(self); // {"method":"_free_", "params":[], "id":1234}
              exit;
            end;
            P^.LastAccess64 := Inst.LastAccess64;
            Inst.Instance := P^.Instance;
            exit;
          end else
            inc(P);
      end;
      // add any new session/user/group/thread instance if necessary
      if (InstanceCreation<>sicClientDriven) and
         (cardinal(aMethodIndex-SERVICE_PSEUDO_METHOD_COUNT)<fInterface.fMethodsCount) then
        AddNew;
    end;
  finally
    LeaveCriticalSection(fInstanceLock);
  end;
end;

function TServiceFactoryServer.RestServer: TSQLRestServer;
begin
  if self<>nil then
    result := TSQLRestServer(fRest) else
    result := nil;
end;

function TServiceFactoryServer.CreateInstance(AndIncreaseRefCount: boolean): TInterfacedObject;
var dummyObj: pointer;
begin
  case fImplementationClassKind of
  ickWithCustomCreate:
    result := TInterfacedObjectWithCustomCreateClass(fImplementationClass).Create;
  ickInjectable:
    result := TInjectableObjectClass(fImplementationClass).
      CreateWithResolver(Rest.Services,true);
  ickInjectableRest:
    result := TInjectableObjectRestClass(fImplementationClass).
      CreateWithResolverAndRest(Rest.Services,self,RestServer,true);
  ickFromInjectedResolver: begin
    dummyObj := nil;
    if not TSQLRestServer(Rest).Services.
       TryResolveInternal(fInterface.fInterfaceTypeInfo,dummyObj) then
      raise EInterfaceFactoryException.CreateUTF8(
        'ickFromInjectedResolver: TryResolveInternal(%)=false',[fInterface.fInterfaceName]);
    result := TInterfacedObject(ObjectFromInterface(IInterface(dummyObj)));
    if AndIncreaseRefCount then // RefCount=1 after TryResolveInternal()
      AndIncreaseRefCount := false else
      dec(TInterfacedObjectHooked(result).FRefCount);
  end;
  else
    result := fImplementationClass.Create;
  end;
  if Assigned(TSQLRestServer(Rest).OnServiceCreateInstance) then
    TSQLRestServer(Rest).OnServiceCreateInstance(self,result);
  if AndIncreaseRefCount then
    IInterface(result)._AddRef; // allow passing self to sub-methods
end;

procedure TServiceFactoryServer.OnLogRestExecuteMethod(Sender: TServiceMethodExecute;
  Step: TServiceMethodExecuteEventStep);
var W: TTextWriter;
    a, len: integer;
begin
  W := Sender.TempTextWriter;
  with Sender.Method^ do
    case Step of
    smsBefore: begin
      W.CancelAll;
      W.AddShort('"POST",{Method:"');
      W.AddString(InterfaceDotMethodName);
      W.AddShort('",Input:{'); // as TSQLPropInfoRTTIVariant.GetJSONValues
      if not (optNoLogInput in Sender.fOptions) then begin
        for a := ArgsInFirst to ArgsInLast do
        with Args[a] do
        if (ValueDirection<>smdOut) and (ValueType<>smvInterface) and
           not IsDefault(Sender.Values[a]) then begin
          W.AddShort(ParamName^); // in JSON_OPTIONS_FAST_EXTENDED format
          W.Add(':');
          if vIsSPI in ValueKindAsm then
            W.AddShort('"****",') else
            AddJSON(W,Sender.Values[a],SERVICELOG_WRITEOPTIONS);
        end;
        W.CancelLastComma;
      end;
    end;
    smsAfter: begin
      W.AddShort('},Output:{');
      if not (optNoLogOutput in Sender.fOptions) then
        if ArgsResultIsServiceCustomAnswer then
          with PServiceCustomAnswer(Sender.Values[ArgsResultIndex])^ do begin
            len := length(Content);
            W.AddShort('len:');
            W.AddU(len);
            if (Status<>0) and (Status<>HTTP_SUCCESS) then begin
              W.AddShort(',status:');
              W.AddU(Status);
            end;
            if not fExcludeServiceLogCustomAnswer and (len>0) and (len<=1024) then begin
              W.AddShort(',result:"');
              W.WrBase64(pointer(content),len,false); // up to 1KB of base-64
              W.Add('"');
            end;
          end else begin
          for a := ArgsOutFirst to ArgsOutLast do
            with Args[a] do
              if (ValueDirection in [smdVar,smdOut,smdResult]) and
                 not IsDefault(Sender.Values[a]) then begin
                W.AddShort(ParamName^);
                W.Add(':');
                if vIsSPI in ValueKindAsm then
                  W.AddShort('"****",') else
                  AddJSON(W,Sender.Values[a],SERVICELOG_WRITEOPTIONS);
              end;
          W.CancelLastComma;
        end;
    end;
    smsError: begin
      W.AddShort('},Output:{');
      W.AddClassName(Sender.LastException.ClassType);
      W.Add(':','"');
      W.AddJSONEscapeString(Sender.LastException.Message);
      W.Add('"');
    end;
    end;
end;

procedure TServiceFactoryServer.ExecuteMethod(Ctxt: TSQLRestServerURIContext);
var Inst: TServiceFactoryServerInstance;
    WR: TJSONSerializer;
    entry: PInterfaceEntry;
    instancePtr: pointer; // weak IInvokable reference
    dolock, execres: boolean;
    opt: TServiceMethodOptions;
    exec: TServiceMethodExecute;
    timeStart,timeEnd: Int64;
    stats: TSynMonitorInputOutput;
    m: integer;
    err: shortstring;
    temp: TTextWriterStackBuffer;

  function GetFullMethodName: RawUTF8;
  begin
    if Ctxt.ServiceMethod<>nil then
      result := PServiceMethod(Ctxt.ServiceMethod)^.InterfaceDotMethodName else
      result := fInterface.fInterfaceName;
  end;
  procedure Error(const Msg: RawUTF8; Status: integer);
  begin
    Ctxt.Error('% % for %',[ToText(InstanceCreation)^,Msg,GetFullMethodName],Status);
  end;
  function StatsCreate: TSynMonitorInputOutput;
  begin
    result := TSynMonitorInputOutput.Create(GetFullMethodName);
  end;
  procedure FinalizeLogRest;
  var W: TTextWriter;
  begin
    W := exec.TempTextWriter;
    if exec.CurrentStep<smsBefore then begin
      W.CancelAll;
      W.Add('"POST",{Method:"%",Input:{',[exec.Method^.InterfaceDotMethodName]);
    end;
    if exec.CurrentStep<smsAfter then
      W.AddShort('},Output:{Failed:"Probably due to wrong input"');
    W.Add('},Session:%,User:%,Time:%,MicroSec:%',
      [integer(Ctxt.Session),Ctxt.SessionUser,TimeLogNowUTC,timeEnd]);
    if Ctxt.RemoteIPIsLocalHost then
      W.Add('}',',') else
      W.Add(',IP:"%"},',[Ctxt.fRemoteIP]);
    with Ctxt.ServiceExecution^ do
      LogRest.AsynchBatchRawAppend(LogClass,W);
  end;

begin
  if mlInterfaces in TSQLRestServer(Rest).StatLevels then
    {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(timeStart);
  // 1. initialize Inst.Instance and Inst.InstanceID
  Inst.InstanceID := 0;
  Inst.Instance := nil;
  case InstanceCreation of
    sicSingle:
      Inst.Instance := CreateInstance(true);
    sicShared:
      Inst.Instance := fSharedInstance;
    sicClientDriven, sicPerSession, sicPerUser, sicPerGroup, sicPerThread: begin
      case InstanceCreation of
      sicClientDriven:
        Inst.InstanceID := Ctxt.ServiceInstanceID;
      sicPerThread:
        Inst.InstanceID := PtrUInt(GetCurrentThreadId);
      else
        if Ctxt.Session>CONST_AUTHENTICATION_NOT_USED then
          case InstanceCreation of // authenticated user -> handle context
          sicPerSession: Inst.InstanceID := Ctxt.Session;
          sicPerUser:    Inst.InstanceID := Ctxt.SessionUser;
          sicPerGroup:   Inst.InstanceID := Ctxt.SessionGroup;
          end else begin
            Error('mode expects an authenticated session',HTTP_UNAUTHORIZED);
            exit;
          end;
      end;
      case InternalInstanceRetrieve(Inst,Ctxt.ServiceMethodIndex,Ctxt.Session) of
      ord(imFree): begin
        Ctxt.Success; // {"method":"_free_", "params":[], "id":1234}
        exit;
      end;
      ord(imInstance): begin // from TServiceFactoryClient.CreateFakeInstance
        Ctxt.Results([Inst.InstanceID],HTTP_SUCCESS);
        exit;
      end;
      end;
    end;
  end;
  if Inst.Instance=nil then begin
    Error('instance not found or deprecated',HTTP_UNAUTHORIZED);
    exit;
  end;
  Ctxt.ServiceInstanceID := Inst.InstanceID;
  // 2. call method implementation
  if (Ctxt.ServiceExecution=nil) or (Ctxt.ServiceMethod=nil) then begin
    Error('ServiceExecution=nil',HTTP_SERVERERROR);
    exit;
  end;
  stats := nil;
  if (mlInterfaces in TSQLRestServer(Rest).StatLevels) then begin
    m := Ctxt.ServiceMethodIndex-SERVICE_PSEUDO_METHOD_COUNT;
    if m>=0 then begin
      stats := fStats[m];
      if stats=nil then begin
        EnterCriticalSection(fInstanceLock);
        try
          stats := fStats[m];
          if stats=nil then begin
            stats := StatsCreate;
            fStats[m] := stats;
          end;
        finally
          LeaveCriticalSection(fInstanceLock);
        end;
      end;
      stats.Processing := true;
    end;
  end;
  err := '';
  exec := nil;
  try
    if fImplementationClassKind=ickFake then
      if Inst.Instance<>fSharedInstance then
        exit else
        instancePtr := @TInterfacedObjectFake(Inst.Instance).fVTable else begin
      if PClass(Inst.Instance)^=fImplementationClass then
        entry := fImplementationClassInterfaceEntry else begin
        entry := Inst.Instance.GetInterfaceEntry(fInterface.fInterfaceIID);
        if entry=nil then
          exit;
      end;
      instancePtr := PAnsiChar(Inst.Instance)+entry^.IOffset;
    end;
    opt := Ctxt.ServiceExecution^.Options;
    if optExecInPerInterfaceThread in opt then
      if fBackgroundThread=nil then
        fBackgroundThread := Rest.NewBackgroundThreadMethod(
          '% %',[self,fInterface.fInterfaceName]);
    WR := TJSONSerializer.CreateOwnedStream(temp);
    try
      Ctxt.fThreadServer^.Factory := self;
      if not(optForceStandardJSON in opt) and
         ((Ctxt.Call.InHead='') or (Ctxt.ClientKind=ckFramework)) then
        include(WR.fCustomOptions,twoForceJSONExtended) else
        include(WR.fCustomOptions,twoForceJSONStandard); // AJAX
      if optDontStoreVoidJSON in opt then
        include(WR.fCustomOptions,twoIgnoreDefaultInRecord);
      // root/calculator {"method":"add","params":[1,2]} -> {"result":[3],"id":0}
      Ctxt.ServiceResultStart(WR);
      dolock := optExecLockedPerInterface in opt;
      if dolock then
        EnterCriticalSection(fInstanceLock);
      exec := TServiceMethodExecute.Create(Ctxt.ServiceMethod);
      try
        exec.fOptions := opt;
        {$ifndef LVCL}
        exec.fBackgroundExecutionThread := fBackgroundThread;
        {$endif}
        exec.fOnCallback := Ctxt.ExecuteCallback;
        if fOnExecute<>nil then
          MultiEventMerge(exec.fOnExecute,fOnExecute);
        if Ctxt.ServiceExecution^.LogRest<>nil then
          exec.AddInterceptor(OnLogRestExecuteMethod);
        if (fImplementationClassKind=ickFake) and
           ((Ctxt.ServiceParameters=nil) or (Ctxt.ServiceParameters^='[')) and
           {$ifndef LVCL}not ((optExecInMainThread in exec.fOptions) or
             (optExecInPerInterfaceThread in exec.fOptions)) and {$endif}
           (exec.fMethod^.ArgsOutputValuesCount=0) then // bypass JSON marshalling
          execres := exec.ExecuteJsonFake(Inst.Instance,Ctxt.ServiceParameters) else
          execres := exec.ExecuteJson([instancePtr],Ctxt.ServiceParameters,WR,
            @err,Ctxt.ForceServiceResultAsJSONObject);
        if not execres then begin
          if err<>'' then
            Ctxt.Error('%',[err],HTTP_NOTACCEPTABLE) else
            Error('execution failed (probably due to bad input parameters)',HTTP_NOTACCEPTABLE);
          exit; // wrong request
        end;
        Ctxt.Call.OutHead := exec.ServiceCustomAnswerHead;
        Ctxt.Call.OutStatus := exec.ServiceCustomAnswerStatus;
      finally
        if dolock then
          LeaveCriticalSection(fInstanceLock);
      end;
      if Ctxt.Call.OutHead='' then begin // <>'' for TServiceCustomAnswer
        Ctxt.ServiceResultEnd(WR,Inst.InstanceID);
        Ctxt.Call.OutHead := JSON_CONTENT_TYPE_HEADER_VAR;
        Ctxt.Call.OutStatus := HTTP_SUCCESS;
      end;
      WR.SetText(Ctxt.Call.OutBody);
    finally
      Ctxt.fThreadServer^.Factory := nil;
      WR.Free;
    end;
  finally
    try
      if InstanceCreation=sicSingle then
        Inst.SafeFreeInstance(self); // always release single shot instance
      if stats<>nil then begin
        {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(timeEnd);
        dec(timeEnd,timeStart);
        Ctxt.StatsFromContext(stats,timeEnd,false);
        if Ctxt.Server.StatUsage<>nil then
          Ctxt.Server.StatUsage.Modified(stats,[]);
        if (mlSessions in TSQLRestServer(Rest).StatLevels) and (Ctxt.fSession<>nil) then begin
          if Ctxt.fSession.fInterfaces=nil then begin
            EnterCriticalSection(fInstanceLock);
            try
              if Ctxt.fSession.fInterfaces=nil then
                SetLength(Ctxt.fSession.fInterfaces,length(Rest.Services.fInterfaceMethod));
            finally
              LeaveCriticalSection(fInstanceLock);
            end;
          end;
          m := Ctxt.fServiceListInterfaceMethodIndex;
          if m<0 then
            m := Rest.Services.fInterfaceMethods.FindHashed(
              PServiceMethod(Ctxt.ServiceMethod)^.InterfaceDotMethodName);
          if m>=0 then
          with Ctxt.fSession do begin
            stats := fInterfaces[m];
            if stats=nil then begin
              EnterCriticalSection(fInstanceLock);
              try
                stats := fInterfaces[m];
                if stats=nil then begin
                  stats := StatsCreate;
                  fInterfaces[m] := stats;
                end;
              finally
                LeaveCriticalSection(fInstanceLock);
              end;
            end;
            Ctxt.StatsFromContext(stats,timeEnd,true);
            // mlSessions stats are not yet tracked per Client
          end;
        end;
      end else
        timeEnd := 0;
    finally
      if exec<>nil then begin
        if Ctxt.ServiceExecution^.LogRest<>nil then
          FinalizeLogRest;
        exec.Free;
      end;
    end;
  end;
end;

function TServiceFactoryServer.AllowAll: TServiceFactoryServer;
var m: integer;
begin
  if self<>nil then
    for m := 0 to fInterface.fMethodsCount-1 do
      FillcharFast(fExecution[m].Denied,SizeOf(fExecution[m].Denied),0);
  result := self;
end;

function TServiceFactoryServer.AllowAllByID(const aGroupID: array of TID): TServiceFactoryServer;
var m,g: integer;
begin
  if self<>nil then
    for m := 0 to fInterface.fMethodsCount-1 do
    with fExecution[m] do
      for g := 0 to high(aGroupID) do
        exclude(Denied,aGroupID[g]-1);
  result := self;
end;

function TServiceFactoryServer.AllowAllByName(const aGroup: array of RawUTF8): TServiceFactoryServer;
var IDs: TIDDynArray;
begin
  if self<>nil then
    if RestServer.MainFieldIDs(RestServer.fSQLAuthGroupClass,aGroup,IDs) then
      AllowAllByID(IDs);
  result := self;
end;

function TServiceFactoryServer.DenyAll: TServiceFactoryServer;
var m: integer;
begin
  if self<>nil then
    for m := 0 to fInterface.fMethodsCount-1 do
      FillcharFast(fExecution[m].Denied,SizeOf(fExecution[m].Denied),255);
  result := self;
end;

function TServiceFactoryServer.DenyAllByID(const aGroupID: array of TID): TServiceFactoryServer;
var m,g: integer;
begin
  if self<>nil then
    for m := 0 to fInterface.fMethodsCount-1 do
    with fExecution[m] do
      for g := 0 to high(aGroupID) do
        include(Denied,aGroupID[g]-1);
  result := self;
end;

function TServiceFactoryServer.DenyAllByName(const aGroup: array of RawUTF8): TServiceFactoryServer;
var IDs: TIDDynArray;
begin
  if self<>nil then
    if RestServer.MainFieldIDs(RestServer.fSQLAuthGroupClass,aGroup,IDs) then
      DenyAllByID(IDs);
  result := self;
end;

function TServiceFactoryServer.Allow(const aMethod: array of RawUTF8): TServiceFactoryServer;
var m: integer;
begin
  if self<>nil then
    for m := 0 to high(aMethod) do
      FillcharFast(fExecution[fInterface.CheckMethodIndex(aMethod[m])].Denied,
        SizeOf(fExecution[0].Denied),0);
  result := self;
end;

function TServiceFactoryServer.AllowByID(const aMethod: array of RawUTF8;
  const aGroupID: array of TID): TServiceFactoryServer;
var m,g: integer;
begin
  if self<>nil then
    if high(aGroupID)>=0 then
    for m := 0 to high(aMethod) do
      with fExecution[fInterface.CheckMethodIndex(aMethod[m])] do
        for g := 0 to high(aGroupID) do
          exclude(Denied,aGroupID[g]-1);
  result := self;
end;

function TServiceFactoryServer.AllowByName(const aMethod: array of RawUTF8; const aGroup: array of RawUTF8): TServiceFactoryServer;
var IDs: TIDDynArray;
begin
  if self<>nil then
    if RestServer.MainFieldIDs(RestServer.fSQLAuthGroupClass,aGroup,IDs) then
      AllowByID(aMethod,IDs);
  result := self;
end;

function TServiceFactoryServer.Deny(const aMethod: array of RawUTF8): TServiceFactoryServer;
var m: integer;
begin
  if self<>nil then
    for m := 0 to high(aMethod) do
      FillcharFast(fExecution[fInterface.CheckMethodIndex(aMethod[m])].Denied,
        SizeOf(fExecution[0].Denied),255);
  result := self;
end;

function TServiceFactoryServer.DenyByID(const aMethod: array of RawUTF8;
  const aGroupID: array of TID): TServiceFactoryServer;
var m,g: integer;
begin
  if self<>nil then
    for m := 0 to high(aMethod) do
      with fExecution[fInterface.CheckMethodIndex(aMethod[m])] do
        for g := 0 to high(aGroupID) do
          include(Denied,aGroupID[g]-1);
  result := self;
end;

function TServiceFactoryServer.DenyByName(const aMethod: array of RawUTF8; const aGroup: array of RawUTF8): TServiceFactoryServer;
var IDs: TIDDynArray;
begin
  if self<>nil then
    if RestServer.MainFieldIDs(RestServer.fSQLAuthGroupClass,aGroup,IDs) then
      DenyByID(aMethod,IDs);
  result := self;
end;

function TServiceFactoryServer.SetOptions(const aMethod: array of RawUTF8;
  aOptions: TServiceMethodOptions; aAction: TServiceMethodOptionsAction): TServiceFactoryServer;
begin
  if self<>nil then begin
    if (fInstanceCreation=sicPerThread) and (optExecLockedPerInterface in aOptions) then
      raise EServiceException.CreateUTF8('%.SetOptions(I%,optExecLockedPerInterface)'+
        ' not compatible with sicPerThread',[self,fInterfaceURI]);
    if (fInstanceCreation=sicPerThread) and
       ([{$ifndef LVCL}optExecInMainThread,optFreeInMainThread,{$endif}
         optExecInPerInterfaceThread,optFreeInPerInterfaceThread]*aOptions<>[]) then
      raise EServiceException.CreateUTF8('%.SetOptions(I%,opt*In*Thread) '+
        'not compatible with sicPerThread',[self,fInterfaceURI]);
    {$ifndef LVCL}
    if (optExecLockedPerInterface in aOptions) and
       ([optExecInMainThread,optFreeInMainThread,
         optExecInPerInterfaceThread,optFreeInPerInterfaceThread]*aOptions<>[]) then
      raise EServiceException.CreateUTF8('%.SetOptions(I%,optExecLockedPerInterface)'+
        ' with opt*In*Thread options',[self,fInterfaceURI]);
    {$endif}
    ExecutionAction(aMethod,aOptions,aAction);
    if (optFreeInPerInterfaceThread in fAnyOptions) and
       not (optExecInPerInterfaceThread in fAnyOptions) then
      raise EServiceException.CreateUTF8('%.SetOptions(I%,optFreeInPerInterfaceThread)'+
        ' without optExecInPerInterfaceThread',[self,fInterfaceURI]);
    {$ifndef LVCL}
    if ([optExecInMainThread,optFreeInMainThread]*fAnyOptions<>[]) and
       ([optExecInPerInterfaceThread,optFreeInPerInterfaceThread]*fAnyOptions<>[]) then
      raise EServiceException.CreateUTF8('%.SetOptions(I%): concurrent '+
        'opt*InMainThread and opt*InPerInterfaceThread',[self,fInterfaceURI]);
    {$endif}
  end;
  result := self;
end;

function TServiceFactoryServer.SetTimeoutSec(value: cardinal): TServiceFactoryServer;
begin
  SetTimeoutSecInt(value);
  result := self;
end;

function TServiceFactoryServer.SetServiceLog(const aMethod: array of RawUTF8;
  aLogRest: TSQLRest; aLogClass: TSQLRecordServiceLogClass): TServiceFactoryServer;
var bits: TInterfaceFactoryMethodBits;
begin
  if self<>nil then begin
    fInterface.CheckMethodIndexes(aMethod,true,bits);
    SetServiceLogByIndex(bits,aLogRest,aLogClass);
  end;
  result := self;
end;

procedure TServiceFactoryServer.SetServiceLogByIndex(
  const aMethods: TInterfaceFactoryMethodBits; aLogRest: TSQLRest;
  aLogClass: TSQLRecordServiceLogClass);
var m: integer;
begin
  if aLogRest=nil then
    aLogClass := nil else begin
    if aLogClass=nil then
      aLogClass := TSQLRecordServiceLog;
    aLogRest.Model.GetTableIndexExisting(aLogClass);
  end;
  for m := 0 to fInterface.fMethodsCount-1 do
    if m in aMethods then
    with fExecution[m] do begin
      LogRest := aLogRest;
      LogClass := aLogClass;
    end;
  if aLogRest<>nil then // write every second or after 500 rows in background
    aLogRest.AsynchBatchStart(aLogClass,1,500,1000); // do nothing if already set
end;

procedure TServiceFactoryServer.AddInterceptor(const Hook: TServiceMethodExecuteEvent);
begin
  MultiEventAdd(fOnExecute,TMethod(Hook));
end;


{ TServiceRecordVersion }

function TServiceRecordVersion.Subscribe(const SQLTableName: RawUTF8;
  const revision: TRecordVersion; const callback: IServiceRecordVersionCallback): boolean;
var tableIndex: integer;
    tableRemote: TSQLRest;
    tableServer: TSQLRestServer;
begin
  if Server<>nil then begin
     tableIndex := Server.Model.GetTableIndex(SQLTableName);
     if tableIndex>=0 then begin
       tableRemote := Server.GetRemoteTable(tableIndex);
       if (tableRemote=nil) or not tableRemote.InheritsFrom(TSQLRestServer) then
         tableServer := Server else
         tableServer := TSQLRestServer(tableRemote);
       result := tableServer.RecordVersionSynchronizeSubscribeMaster(
         Server.Model.Tables[tableindex],revision,callback);
       exit;
     end;
  end;
  result := false;
end;


{ TServiceMethodArgument }

{$ifndef FPC}
procedure TServiceMethodArgument.SetFromRTTI(var P: PByte);
var PS: PShortString absolute P;
    PP: ^PPTypeInfo absolute P;
begin
  ArgTypeName := PS;
  P := @PS^[ord(PS^[0])+1];
  if PP^=nil then
    {$ifndef ISDELPHI2010}
    if IdemPropName(ArgTypeName^,'TGUID') then
      ArgTypeInfo := @GUID_FAKETYPEINFO else
    {$endif}
      raise EInterfaceFactoryException.CreateUTF8(
       '"%: %" parameter has no RTTI',[ParamName^,ArgTypeName^]) else
    ArgTypeInfo := PP^^;
  inc(PP);
end;
{$endif FPC}

procedure TServiceMethodArgument.SerializeToContract(WR: TTextWriter);
const
  ARGDIRTOJSON: array[TServiceMethodValueDirection] of string[4] = (
    // convert into generic in/out direction (assume result is out)
    'in','both','out','out');
  // AnsiString (Delphi <2009) may loose data depending on the client
  ARGTYPETOJSON: array[TServiceMethodValueType] of string[8] = (
    '??','self','boolean', '', '','integer','cardinal','int64',
    'double','datetime','currency','utf8','utf8','utf8','utf8','utf8','',
    {$ifndef NOVARIANTS}'variant',{$endif}'','json','','');
begin
  WR.AddShort('{"argument":"');
  WR.AddShort(ParamName^);
  WR.AddShort('","direction":"');
  WR.AddShort(ARGDIRTOJSON[ValueDirection]);
  WR.AddShort('","type":"');
  if ARGTYPETOJSON[ValueType]='' then
    WR.AddShort(ArgTypeInfo^.Name) else
    WR.AddShort(ARGTYPETOJSON[ValueType]);
{$ifdef SOA_DEBUG}
  WR.Add('"',',');
  WR.AddPropJSONInt64('index',IndexVar);
  WR.AddPropJSONString('var',GetEnumNameTrimed(TypeInfo(TServiceMethodValueVar),ValueVar));
  WR.AddPropJSONInt64('stackoffset',InStackOffset);
  WR.AddPropJSONInt64('reg',RegisterIdent);
  WR.AddPropJSONInt64('fpreg',FPRegisterIdent);
  WR.AddPropJSONInt64('stacksize',SizeInStack);
  WR.AddPropJSONInt64('storsize',SizeInStorage);
  if ValueType=smvBinary then
    WR.AddPropJSONInt64('binsize',SizeInBinary);
  WR.AddPropName('asm');
  WR.AddString(GetSetNameCSV(TypeInfo(TServiceMethodValueAsm),ValueKindAsm));
  WR.AddShort('},');
{$else}
  WR.AddShort('"},');
{$endif SOA_DEBUG}
end;

function TServiceMethodArgument.IsDefault(V: pointer): boolean;
begin
  result := false;
  case ValueType of
  smvBoolean..smvCurrency:
    case SizeInStorage of
      1: result := PByte(V)^=0;
      2: result := PWord(V)^=0;
      4: result := PInteger(V)^=0;
      8: result := PInt64(V)^=0;
    end;
  smvRawUTF8..smvWideString, smvObject..smvInterface:
    result := PPointer(V)^=nil;
  smvBinary, smvRecord:
    result := IsZeroSmall(V,SizeInStorage);
  {$ifndef NOVARIANTS}
  smvVariant: result := PVarData(V)^.vtype<=varNull;
  {$endif}
  end;
end;

function TServiceMethodArgument.FromJSON(const MethodName: RawUTF8; var R: PUTF8Char;
  V: pointer; Error: PShortString{$ifndef NOVARIANTS}; DVO: TDocVariantOptions{$endif}): boolean;
  procedure RaiseError(const msg: RawUTF8);
  var tmp: shortstring;
  begin
    FormatShort('I% failed on %:% [%]',[MethodName,ParamName^,ArgTypeName^,msg],tmp);
    if Error=nil then
      raise EInterfaceFactoryException.CreateUTF8('%',[tmp]);
    result := false;
    Error^ := tmp;
  end;
var parser: TJSONToObject; // inlined JSONToObject()
    Val: PUTF8Char;
    ValLen: integer;
    wasString: boolean;
    wrapper: TDynArray;
label doint;
begin
  result := true;
  case ValueType of
  smvObject: begin
    if PInteger(R)^=NULL_LOW then
      inc(R,4) else begin // null from TInterfacedStub -> stay untouched
      parser.From := R; // inlined JSONToObject()
      parser.Options := JSONTOOBJECT_TOLERANTOPTIONS;
      parser.TObjectListItemClass := nil;
      parser.Value := PObject(V)^;
      parser.Parse;
      if parser.Valid then
        R := parser.Dest else
        RaiseError('returned object');
    end;
    IgnoreComma(R);
  end;
  smvInterface:
    RaiseError('unexpected var/out interface');
  smvRawJSON:
    if (R<>nil) and (R^=']') then
      PRawUTF8(V)^ := '' else begin
      GetJSONItemAsRawJSON(R,PRawJSON(V)^);
      if R=nil then
        RaiseError('returned RawJSON');
    end;
  smvDateTime: begin
    Val := GetJSONField(R,R,@wasString,nil,@ValLen);
    if (Val=nil) or (ValLen=0) then
      PInt64(V)^ := 0 else
      if wasString then
        Iso8601ToDateTimePUTF8CharVar(Val,ValLen,PDateTime(V)^) else
        unaligned(PDouble(V)^) := GetExtended(Val); // allow JSON number decoding
  end;
  smvBoolean..smvDouble, smvCurrency..smvWideString: begin
    Val := GetJSONField(R,R,@wasString,nil,@ValLen);
    if (Val=nil) or (wasString<>(vIsString in ValueKindAsm)) then begin
      RaiseError('missing or invalid value');
      exit;
    end;
    if (ValueType=smvBoolean) and (PInteger(Val)^=TRUE_LOW) then
      Val := pointer(SmallUInt32UTF8[1]); // normalize 'true' to '1'
    case ValueType of
    smvBoolean, smvEnum, smvSet, smvCardinal:
doint:case SizeInStorage of
      1: PByte(V)^     := GetCardinal(Val);
      2: PWord(V)^     := GetCardinal(Val);
      4: PCardinal(V)^ := GetCardinal(Val);
      8: SetQWord(Val,PQWord(V)^);
      end;
    smvInteger:
      PInteger(V)^ := GetInteger(Val);
    smvInt64:
      if vIsQword in ValueKindAsm then
        SetQWord(Val,PQWord(V)^) else
        SetInt64(Val,PInt64(V)^);
    smvDouble:
      unaligned(PDouble(V)^) := GetExtended(Val);
    smvCurrency:
      PInt64(V)^ := StrToCurr64(Val);
    smvRawUTF8:
      FastSetString(PRawUTF8(V)^,Val,ValLen);
    smvString:
      UTF8DecodeToString(Val,ValLen,PString(V)^);
    smvRawByteString:
      Base64ToBin(PAnsiChar(Val),ValLen,PRawByteString(V)^);
    smvWideString:
      UTF8ToWideString(Val,ValLen,PWideString(V)^);
    else RaiseError('ValueType?');
    end;
  end;
  smvBinary: begin
    Val := GetJSONField(R,R,@wasString,nil,@ValLen);
    if Val=nil then begin
      RaiseError('missing or invalid binary value');
      exit;
    end;
    if wasString then begin // decode hexadecimal string
      if ValLen=SizeInStorage*2 then
        HexDisplayToBin(PAnsiChar(Val),PByte(V),SizeInStorage);
    end else // allow fallback to read plain numbers (e.g. on API upgrade)
      goto doint;
  end;
  smvRecord: begin
    R := RecordLoadJSON(V^,R,ArgTypeInfo);
    if R=nil then
      RaiseError('returned record');
  end;
  {$ifndef NOVARIANTS}
  smvVariant: begin
    R := VariantLoadJSON(PVariant(V)^,R,nil,@DVO);
    if R=nil then
      RaiseError('returned variant');
  end;
  {$endif}
  smvDynArray: begin
    if vIsObjArray in ValueKindAsm then
      ObjArrayClear(V^);
    wrapper.InitFrom(DynArrayWrapper,V^);
    R := wrapper.LoadFromJSON(R);
    if R=nil then
      RaiseError('returned array');
    IgnoreComma(R);
  end;
  end;
end;

procedure TServiceMethodArgument.AddJSON(WR: TTextWriter; V: pointer;
  ObjectOptions: TTextWriterWriteObjectOptions);
var wrapper: TDynArray; // faster than WR.AddDynArrayJSON(ArgTypeInfo,V^)
begin
  if vIsString in ValueKindAsm then
    WR.Add('"');
  case ValueType of
  smvEnum..smvInt64:
  case SizeInStorage of
    1: WR.Add(PByte(V)^);
    2: WR.Add(PWord(V)^);
    4: if ValueType=smvInteger then
         WR.Add(PInteger(V)^) else
         WR.AddU(PCardinal(V)^);
    8: if vIsQword in ValueKindAsm then
         WR.AddQ(PQWord(V)^) else
         WR.Add(PInt64(V)^);
  end;
  smvBoolean:    WR.Add(PBoolean(V)^);
  smvDouble:     WR.AddDouble(unaligned(PDouble(V)^));
  smvDateTime:   WR.AddDateTime(PDateTime(V)^,vIsDateTimeMS in ValueKindAsm);
  smvCurrency:   WR.AddCurr64(PInt64(V)^);
  smvRawUTF8:    WR.AddJSONEscape(PPointer(V)^);
  smvRawJSON:    WR.AddRawJSON(PRawJSON(V)^);
  smvString:     {$ifdef UNICODE}
                 WR.AddJSONEscapeW(pointer(PString(V)^));
                 {$else}
                 WR.AddJSONEscapeAnsiString(PString(V)^);
                 {$endif}
  smvRawByteString: WR.WrBase64(PPointer(V)^,length(PRawBytestring(V)^),false);
  smvWideString: WR.AddJSONEscapeW(PPointer(V)^);
  smvBinary:     if not IsZeroSmall(V,SizeInStorage) then // leave "" for zero
                   WR.AddBinToHexDisplayLower(V,SizeInStorage);
  smvObject:     WR.WriteObject(PPointer(V)^,ObjectOptions);
  smvInterface:  WR.AddShort('null'); // or written by InterfaceWrite()
  smvRecord:     WR.AddRecordJSON(V^,ArgTypeInfo);
  smvDynArray: if vIsObjArray in ValueKindAsm then
                 WR.AddObjArrayJSON(V^,ObjectOptions) else begin
                 wrapper.InitFrom(DynArrayWrapper,V^);
                 WR.AddDynArrayJSON(wrapper);
               end;
  {$ifndef NOVARIANTS}
  smvVariant: WR.AddVariant(PVariant(V)^,twJSONEscape);
  {$endif}
  end;
  if vIsString in ValueKindAsm then
    WR.Add('"',',') else
    WR.Add(',');
end;

procedure TServiceMethodArgument.AsJson(var DestValue: RawUTF8; V: pointer);
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  case ValueType of // some direct conversion of simple types
  smvBoolean:
    DestValue := BOOL_UTF8[PBoolean(V)^];
  smvEnum..smvInt64:
  case SizeInStorage of
    1: UInt32ToUtf8(PByte(V)^,DestValue);
    2: UInt32ToUtf8(PWord(V)^,DestValue);
    4: if ValueType=smvInteger then
         Int32ToUtf8(PInteger(V)^,DestValue) else
         UInt32ToUtf8(PCardinal(V)^,DestValue);
    8: if vIsQword in ValueKindAsm then
         UInt64ToUtf8(PQword(V)^,DestValue) else
         Int64ToUtf8(PInt64(V)^,DestValue);
  end;
  smvDouble:
    DoubleToStr(unaligned(PDouble(V)^),DestValue);
  smvCurrency:
    Curr64ToStr(PInt64(V)^,DestValue);
  smvRawJSON:
    DestValue := PRawUTF8(V)^;
  else begin // use generic AddJSON() method for complex "..." content
    W := TJSONSerializer.CreateOwnedStream(temp);
    try
      AddJSON(W,V);
      W.SetText(DestValue);
    finally
      W.Free;
    end;
  end;
  end;
end;

procedure TServiceMethodArgument.AddJSONEscaped(WR: TTextWriter; V: pointer);
var W: TTextWriter;
begin
  if ValueType in [smvBoolean..smvCurrency,smvInterface] then // no need to escape those
    AddJSON(WR,V) else begin
    W := WR.InternalJSONWriter;
    AddJSON(W,V);
    WR.AddJSONEscape(W);
  end;
end;

procedure TServiceMethodArgument.AddValueJSON(WR: TTextWriter; const Value: RawUTF8);
begin
  if vIsString in ValueKindAsm then begin
    WR.Add('"');
    WR.AddJSONEscape(pointer(Value));
    WR.Add('"',',');
  end else begin
    WR.AddString(Value);
    WR.Add(',');
  end;
end;

procedure TServiceMethodArgument.AddDefaultJSON(WR: TTextWriter);
begin
  case ValueType of
  smvBoolean:   WR.AddShort('false,');
  smvObject:    WR.AddShort('null,'); // may raise an error on the client side
  smvInterface: WR.AddShort('0,');
  smvDynArray:  WR.AddShort('[],');
  smvRecord:   begin
    WR.AddVoidRecordJSON(ArgTypeInfo);
    WR.Add(',');
  end;
  {$ifndef NOVARIANTS}
  smvVariant: WR.AddShort('null,');
  {$endif}
  else
    if vIsString in ValueKindAsm then
      WR.AddShort('"",') else
      WR.AddShort('0,');
  end;
end;

{$ifndef NOVARIANTS}

procedure TServiceMethodArgument.AsVariant(var DestValue: variant; V: pointer;
  Options: TDocVariantOptions);
var tmp: RawUTF8;
begin
  case ValueType of // some direct conversion of simple types
  smvBoolean:
    DestValue := PBoolean(V)^;
  smvEnum..smvInt64:
  case SizeInStorage of
    1: DestValue := PByte(V)^;
    2: DestValue := PWord(V)^;
    4: if ValueType=smvInteger then
         DestValue := PInteger(V)^ else
         DestValue := PCardinal(V)^;
    8: if vIsQword in ValueKindAsm then
         DestValue := PQWord(V)^ else
         DestValue := PInt64(V)^;
  end;
  smvDouble, smvDateTime:
    DestValue := unaligned(PDouble(V)^);
  smvCurrency:
    DestValue := PCurrency(V)^;
  smvRawUTF8:
    RawUTF8ToVariant(PRawUTF8(V)^,DestValue);
  smvString: begin
    StringToUTF8(PString(V)^,tmp);
    RawUTF8ToVariant(tmp,DestValue);
  end;
  smvWideString: begin
    RawUnicodeToUtf8(PPointer(V)^,length(PWideString(V)^),tmp);
    RawUTF8ToVariant(tmp,DestValue);
  end;
  smvVariant:
    DestValue := PVariant(V)^;
  else begin // use generic AddJSON() method
    AsJson(tmp,V);
    VariantLoadJSON(DestValue,pointer(tmp),nil,@Options);
  end;
  end;
end;

procedure TServiceMethodArgument.AddAsVariant(var Dest: TDocVariantData; V: pointer);
var tmp: variant;
begin
  AsVariant(tmp,V,Dest.Options);
  if dvoIsArray in Dest.Options then
    Dest.AddItem(tmp) else
    Dest.AddValue(ShortStringToAnsi7String(ParamName^),tmp);
end;

procedure TServiceMethodArgument.FixValueAndAddToObject(const Value: variant;
  var DestDoc: TDocVariantData);
var tempCopy: variant;
begin
  tempCopy := Value;
  FixValue(tempCopy);
  DestDoc.AddValue(ShortStringToAnsi7String(ParamName^),tempCopy);
end;

procedure TServiceMethodArgument.FixValue(var Value: variant);
var enum: Int64;
    obj: TObject;
    arr: pointer;
    dyn: TDynArray;
    rec: TByteDynArray;
    json: RawUTF8;
begin
  case ValueType of
  smvEnum:
    if VariantToInt64(Value,enum) then
      Value := PTypeInfo(ArgTypeInfo)^.EnumBaseType^.GetEnumNameOrd(enum)^;
  smvSet:
    if VariantToInt64(Value,enum) then
      Value := PTypeInfo(ArgTypeInfo)^.SetEnumType^.GetSetNameAsDocVariant(enum);
  smvObject: begin
    obj := ArgTypeInfo^.ClassCreate;
    try
      if DocVariantToObject(_Safe(Value)^,obj) then
        Value := _ObjFast(obj,[woEnumSetsAsText]);
    finally
      obj.Free;
    end;
  end;
  smvDynArray:
    if _Safe(Value)^.Kind=dvArray then begin
      arr := nil;
      dyn.InitFrom(DynArrayWrapper,arr);
      try
        VariantSaveJSON(Value,twJSONEscape,json);
        dyn.LoadFromJSON(pointer(json));
        json := dyn.SaveToJSON(true);
        _Json(json,Value,JSON_OPTIONS_FAST);
      finally
        dyn.Clear;
      end;
    end;
  smvRecord:
    if _Safe(Value)^.Kind=dvObject then begin
      SetLength(rec,ArgTypeInfo^.RecordType^.Size);
      try
        VariantSaveJSON(Value,twJSONEscape,json);
        RecordLoadJSON(rec[0],pointer(json),ArgTypeInfo);
        json := RecordSaveJSON(rec[0],ArgTypeInfo,true);
        _Json(json,Value,JSON_OPTIONS_FAST);
      finally
        RecordClear(rec[0],ArgTypeInfo);
      end;
    end;
  end;
end;

{$endif NOVARIANTS}


{ TAutoCreateFields }

type // use AutoTable VMT entry to store a cache of the needed fields RTTI
  TAutoCreateFields = class
  public
    ClassesCount: integer;
    ObjArraysCount: integer;
    Classes: array of record
      Offset: cardinal;
      Instance: TClassInstance;
    end;
    ObjArraysOffset: TCardinalDynArray;
    InterfacesOffset: TCardinalDynArray;
    constructor Create(aClass: TClass);
  end;

constructor TAutoCreateFields.Create(aClass: TClass);
var i: integer;
    P: PPropInfo;
begin
  repeat
    for i := 1 to InternalClassPropInfo(aClass,P) do begin
      case P^.PropType^.Kind of
      tkClass: begin
        if (P^.SetProc<>0) or not P^.GetterIsField then
          raise EModelException.CreateUTF8('%.%: % is an auto-created instance '+
            'so should not have any "write" defined',[aClass,P^.Name,P^.PropType^.Name]);
        SetLength(Classes,ClassesCount+1);
        with Classes[ClassesCount] do begin
          Offset := PtrUInt(P^.GetterAddr(nil));
          Instance.Init(P^.PropType^.ClassType^.ClassType);
        end;
        inc(ClassesCount);
      end;
      tkDynArray:
        if (ObjArraySerializers.Find(P^.TypeInfo)<>nil)
           and P^.GetterIsField then begin
          SetLength(ObjArraysOffset,ObjArraysCount+1);
          ObjArraysOffset[ObjArraysCount] := PtrUInt(P^.GetterAddr(nil));
          inc(ObjArraysCount);
        end;
      tkInterface:
        if P^.GetterIsField then
          AddInteger(TIntegerDynArray(InterfacesOffset),PtrUInt(P^.GetterAddr(nil)));
      end;
      P := P^.Next;
    end;
    aClass := GetClassParent(aClass);
  until aClass=TObject;
end;

function SetAutoCreateFields(PVMT: pointer; c: TClass): TAutoCreateFields;
begin
  EnterCriticalSection(vmtAutoTableLock); // protect from concurrent access
  try
    result := PPointer(PVMT)^;
    if result=nil then begin
      // first time access: compute RTTI cache
      result := TAutoCreateFields.Create(c);
      // store the RTTI cache into the AutoTable VMT entry of this class
      PatchCodePtrUInt(pointer(PVMT),PtrUInt(result),true);
      GarbageCollectorFreeAndNil(PVMT^,result);
    end;
  finally
    LeaveCriticalSection(vmtAutoTableLock);
  end;
end;

procedure AutoCreateFields(self: TObject);
var fields: TAutoCreateFields;
    PVMT: PPointer;
    i: integer;
begin
  PVMT := pointer(PPtrInt(self)^+vmtAutoTable);
  fields := PVMT^;
  if fields=nil then
    fields := SetAutoCreateFields(PVMT,PClass(self)^) else
    if PClass(fields)^<>TAutoCreateFields then
      raise EModelException.CreateUTF8('%.AutoTable VMT entry already set',[self]);
  // auto-create published persistent class instances
  for i := 0 to fields.ClassesCount-1 do
    with fields.Classes[i] do
      PObject(PtrUInt(self)+Offset)^ := Instance.CreateNew;
end;

function AutoDestroyFields(self: TObject): TAutoCreateFields;
  {$ifdef HASINLINENOTX86}inline;{$endif}
var i: integer;
begin
  result := PPointer(PPtrInt(self)^+vmtAutoTable)^;
  if result=nil then
    exit; // may happen in a weird finalization code
  // auto-release published persistent class instances
  for i := 0 to result.ClassesCount-1 do
    FreeAndNil(PObject(PtrUInt(self)+result.Classes[i].Offset)^);
  // auto-release published T*ObjArray instances
  for i := 0 to result.ObjArraysCount-1 do
    ObjArrayClear(pointer(PtrUInt(self)+result.ObjArraysOffset[i])^);
end;


{ TPersistentAutoCreateFields }

constructor TPersistentAutoCreateFields.Create;
begin
  AutoCreateFields(self);
  inherited Create; // always call the virtual constructor
end;

destructor TPersistentAutoCreateFields.Destroy;
begin
  AutoDestroyFields(self);
  inherited Destroy;
end;


{ TSynAutoCreateFields }

{$ifdef FPC_OR_PUREPASCAL}
constructor TSynAutoCreateFields.Create;
begin
  AutoCreateFields(self);
  inherited Create; // always call the virtual constructor
end;
{$else}
class function TSynAutoCreateFields.NewInstance: TObject;
asm
        push    eax  // class
        mov     eax, [eax].vmtInstanceSize
        push    eax  // size
        call    System.@GetMem
        pop     edx  // size
        push    eax  // self
        mov     cl, 0
        call    dword ptr[FillcharFast]
        pop     eax  // self
        pop     edx  // class
        mov     [eax], edx // store VMT
        push    eax
        call    AutoCreateFields
        pop     eax
end; // ignore vmtIntfTable for this class hierarchy (won't implement interfaces)
{$endif}

destructor TSynAutoCreateFields.Destroy;
begin
  AutoDestroyFields(self);
  inherited Destroy;
end;

procedure TSynAutoCreateFields.AfterLoad;
begin
end;


{ TSynAutoCreateFieldsLocked }

constructor TSynAutoCreateFieldsLocked.Create;
begin
  inherited Create;
  fSafe.Init;
end;

destructor TSynAutoCreateFieldsLocked.Destroy;
begin
  inherited Destroy;
  fSafe.Done;
end;

procedure TSynAutoCreateFieldsLocked.Lock;
begin
  if self<>nil then
    fSafe.Lock;
end;

procedure TSynAutoCreateFieldsLocked.UnLock;
begin
  if self<>nil then
    fSafe.UnLock;
end;


{ TInterfacedObjectAutoCreateFields }

constructor TInterfacedObjectAutoCreateFields.Create;
begin
  AutoCreateFields(self);
  inherited Create; // always call the virtual constructor
end;

destructor TInterfacedObjectAutoCreateFields.Destroy;
begin
  AutoDestroyFields(self);
  inherited Destroy;
end;


{ TInjectableAutoCreateFields }

constructor TInjectableAutoCreateFields.Create;
var Inject: IAutoCreateFieldsResolve;
begin
  AutoCreateFields(self);
  inherited Create; // overriden method will inject its dependencies (DI/IoC)
  if TryResolve(TypeInfo(IAutoCreateFieldsResolve),Inject) then
    Inject.SetProperties(self);
end;

destructor TInjectableAutoCreateFields.Destroy;
begin
  AutoDestroyFields(self);
  inherited Destroy;
end;


{ TSynJsonFileSettings }

function TSynJsonFileSettings.LoadFromJson(var aJson: RawUTF8): boolean;
begin
  result := JSONSettingsToObject(aJson, self);
end;

function TSynJsonFileSettings.LoadFromFile(const aFileName: TFileName): boolean;
begin
  fFileName := aFileName;
  fInitialJsonContent := StringFromFile(aFileName);
  result := LoadFromJson(fInitialJsonContent);
end;

procedure TSynJsonFileSettings.SaveIfNeeded;
var
  saved: RawUTF8;
begin
  if (self = nil) or (fFileName = '') then
    exit;
  saved := ObjectToJSON(self, SETTINGS_WRITEOPTIONS);
  if saved = fInitialJsonContent then
    exit;
  FileFromString(saved, fFileName);
  fInitialJsonContent := saved;
end;


{$ifndef LVCL}

{ TInterfacedCollection }

constructor TInterfacedCollection.Create;
begin
  inherited Create(GetClass);
end;


{ TCollectionItemAutoCreateFields }

constructor TCollectionItemAutoCreateFields.Create(Collection: TCollection);
begin
  AutoCreateFields(self);
  inherited Create(Collection);
end;

destructor TCollectionItemAutoCreateFields.Destroy;
begin
  AutoDestroyFields(self);
  inherited Destroy;
end;

{$endif LVCL}


{ TRawUTF8ObjectCacheSettings }

constructor TRawUTF8ObjectCacheSettings.Create;
begin
  inherited Create;
  // release after 2 minutes of inactivity by default
  fTimeOutMS := 2 * 60 * 1000;
  // 1 second periodicity of purge is small enough to be painless
  fPurgePeriodMS := 1000;
end;


{ TRawUTF8ObjectCache }

constructor TRawUTF8ObjectCache.Create(aOwner: TRawUTF8ObjectCacheList;
  const aKey: RawUTF8);
begin
  inherited Create;
  fOwner := aOwner;
  fKey := aKey;
  fOwner.Log('%.Create(%)', [ClassType, fKey]);
  fTimeoutMS := fOwner.fSettings.TimeOutMS;
end;

destructor TRawUTF8ObjectCache.Destroy;
begin
  fOwner.Log('%.Destroy %', [ClassType, fKey]);
  CacheClear;
  inherited Destroy;
end;

procedure TRawUTF8ObjectCache.CacheSet;
begin // gives some addition TTL time
  fTimeoutTix := GetTickCount64 + fTimeoutMS;
end;

procedure TRawUTF8ObjectCache.CacheClear;
begin
  fTimeoutTix := 0; // indicates no service is available
end;

function TRawUTF8ObjectCache.Resolve(const aInterface: TGUID; out Obj): boolean;
begin
  if Assigned(fOwner.OnKeyResolve) then
    result := fOwner.OnKeyResolve(aInterface,fKey,Obj) else
    result := false;
end;


{ TRawUTF8ObjectCacheList }

constructor TRawUTF8ObjectCacheList.Create(aClass: TRawUTF8ObjectCacheClass;
  aSettings: TRawUTF8ObjectCacheSettings; aLog: TSynLogFamily; aLogEvent: TSynLogInfo;
  const aOnKeyResolve: TOnKeyResolve);
begin
  inherited Create([fObjectsOwned,fNoDuplicate,fCaseSensitive]);
  fClass := aClass;
  fSettings := aSettings;
  if (fClass = nil) or (fClass = TRawUTF8ObjectCache) or (fSettings = nil) then
    raise ESynException.CreateUTF8('%.Create(nil)', [self]);
  if (fSettings.PurgePeriodMS > 0) and (fSettings.TimeOutMS > 0) then
    fNextPurgeTix := GetTickCount64 + fSettings.PurgePeriodMS;
  fLog := aLog;
  fLogEvent := aLogEvent;
  fOnKeyResolve := aOnKeyResolve;
  fPurgeForceList := TRawUTF8List.Create([fCaseSensitive]);
end;

destructor TRawUTF8ObjectCacheList.Destroy;
begin
  inherited Destroy;
  fPurgeForceList.Free;
end;

procedure TRawUTF8ObjectCacheList.Log(const TextFmt: RawUTF8; const TextArgs: array of const;
  Level: TSynLogInfo);
begin
  {$ifdef WITHLOG}
  if (self=nil) or (fLog=nil) then
    exit;
  if Level=sllNone then
    Level := fLogEvent;
  fLog.SynLog.Log(Level, TextFmt, TextArgs, self);
  {$endif}
end;

function TRawUTF8ObjectCacheList.NewObjectCache(const Key: RawUTF8): TRawUTF8ObjectCache;
begin
  result := fClass.Create(self, Key);
end;

procedure TRawUTF8ObjectCacheList.TryPurge;
begin
  fSafe.Lock;
  try
    if ((fNextPurgeTix <> 0) and (GetTickCount64 > fNextPurgeTix)) or
       (fPurgeForceList.Count > 0) then
      DoPurge;
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8ObjectCacheList.AddToPurge(const Key: RawUTF8);
var i: PtrInt;
begin
  fSafe.Lock;
  try
    i := IndexOf(Key);
    if i>=0 then
      fPurgeForceList.Add(Key);
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8ObjectCacheList.ForceCacheClear;
var i: integer;
    cache: TRawUTF8ObjectCache;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  fSafe.Lock;
  try
    {$ifdef WITHLOG}
    log := fLog.SynLog.Enter('ForceCacheClear of % entries',[fCount],self);
    {$endif}
    for i := 0 to fCount - 1 do begin
      cache := TRawUTF8ObjectCache(fObjects[i]);
      cache.fSafe.Lock;
      try
        cache.CacheClear;
      finally
        cache.fSafe.UnLock;
      end;
    end;
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8ObjectCacheList.DoPurge;
var tix: Int64;
    i,n: integer;
    purged: RawUTF8;
    cache: TRawUTF8ObjectCache;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
  procedure InternalPurge(nochecktimeout: boolean);
  begin // test again the timeout after acquiring the TRawUTF8ObjectCache lock
    try
      cache.Safe.Lock;
      if nochecktimeout or ((cache.fTimeoutTix > 0) and (tix > cache.fTimeoutTix)) then begin
        {$ifdef WITHLOG}
        if log = nil then
          log := fLog.SynLog.Enter('DoPurge(%)', [fClass], self);
        {$endif}
        cache.CacheClear;
        purged := purged + ' ' + cache.fKey;
      end;
    finally
      cache.Safe.UnLock;
    end;
  end;
begin // called within fSafe.Lock
  tix := GetTickCount64;
  try
    n := fPurgeForceList.Count;
    if n > 0 then begin
      for i := 0 to n - 1 do begin
        cache := GetObjectFrom(fPurgeForceList.Strings[i]);
        InternalPurge(true);
      end;
      fPurgeForceList.Clear;
    end;
    for i := 0 to fCount - 1 do begin
      cache := TRawUTF8ObjectCache(fObjects[i]);
      if (cache.fTimeoutTix > 0) and (tix > cache.fTimeoutTix) then
        InternalPurge({checktimeout=}true);
    end;
    {$ifdef WITHLOG}
    if log <> nil then
      log.Log(fLogEvent, '%.ReleaseServices:% - count=%', [fClass, purged, fCount], self);
    {$endif}
  finally
    fNextPurgeTix := tix + fSettings.PurgePeriodMS;
  end;
end;

function TRawUTF8ObjectCacheList.GetLocked(const Key: RawUTF8;
  out cache: TRawUTF8ObjectCache; onlyexisting: boolean): boolean;
begin
  result := false;
  if Key = '' then
    exit;
  fSafe.Lock;
  try
    if ((fNextPurgeTix <> 0) and (GetTickCount64 > fNextPurgeTix)) or
       (fPurgeForceList.Count > 0) then
      DoPurge;  // inline TryPurge within the locked list
    cache := GetObjectFrom(Key);
    if cache = nil then begin
      if onlyexisting then begin
        Log('GetLocked(%): onlyexisting=true -> no new %', [Key, fClass]);
        exit;
      end;
      cache := NewObjectCache(Key);
      if cache = nil then begin
        Log('GetLocked: Invalid key - NewObjectCache(%) returned no %', [Key, fClass]);
        exit;
      end;
      AddObjectUnique(Key,@cache);
      Log('GetLocked: Added %[%] - count=%', [fClass, Key, fCount])
    end
    else if cache.fTimeOutTix = 0 then
      Log('GetLocked: Using blank %[%]', [fClass, Key])
    else
      Log('GetLocked: Using %[%] with timeout in % ms',
        [fClass, Key, cache.fTimeOutTix - GetTickCount64]);
    cache.fSafe.Lock;
    result := true;
  finally
    fSafe.UnLock;
  end;
end;


{ TAlgoDeflate }

type // implements the AlgoDeflate global variable
  TAlgoDeflate = class(TAlgoCompressWithNoDestLen)
  protected
    fDeflateLevel: integer;
    function RawProcess(src,dst: pointer; srcLen,dstLen,dstMax: integer;
      process: TAlgoCompressWithNoDestLenProcess): integer;  override;
  public
    constructor Create; override;
    function AlgoID: byte; override;
    function AlgoCompressDestLen(PlainLen: integer): integer; override;
  end;

constructor TAlgoDeflate.Create;
begin
  inherited Create;
  fDeflateLevel := 6;
end;

function TAlgoDeflate.AlgoID: byte;
begin
  result := 2;
end;

function TAlgoDeflate.RawProcess(src,dst: pointer; srcLen,dstLen,dstMax: integer;
  process: TAlgoCompressWithNoDestLenProcess): integer;
begin
  case process of
  doCompress:
    result := SynZip.CompressMem(src,dst,srcLen,dstLen,fDeflateLevel);
  doUnCompress, doUncompressPartial:
    result := SynZip.UnCompressMem(src,dst,srcLen,dstLen);
  else
    result := 0;
  end;
end;

function TAlgoDeflate.AlgoCompressDestLen(PlainLen: integer): integer;
begin
  result := PlainLen+256+PlainLen shr 3;
end;


{ TAlgoDeflateFast }

type // implements the AlgoDeflateFast global variable
  TAlgoDeflateFast = class(TAlgoDeflate)
  public
    constructor Create; override;
    function AlgoID: byte; override;
  end;

function TAlgoDeflateFast.AlgoID: byte;
begin
  result := 3;
end;

constructor TAlgoDeflateFast.Create;
begin
  inherited Create;
  fDeflateLevel := 1;
end;


{ TServiceMethod }

function TServiceMethod.ArgIndex(ArgName: PUTF8Char; ArgNameLen: integer;
  Input: boolean): integer;
begin
  if ArgNameLen>0 then
    if Input then begin
      for result := ArgsInFirst to ArgsInLast do
        with Args[result] do
        if IdemPropName(ParamName^,ArgName,ArgNameLen) then
          if ValueDirection in [smdConst,smdVar] then
            exit else // found
            break; // right name, but wrong direction
    end else
    for result := ArgsOutFirst to ArgsOutLast do
      with Args[result] do
      if IdemPropName(ParamName^,ArgName,ArgNameLen) then
        if ValueDirection in [smdVar,smdOut,smdResult] then
          exit else // found
          break; // right name, but wrong direction
  result := -1;
end;

function TServiceMethod.ArgNext(var arg: integer; Input: boolean): boolean;
begin
  result := true;
  inc(arg);
  if Input then
    while arg<=ArgsInLast do
      if Args[arg].ValueDirection in [smdConst,smdVar] then
        exit else
        inc(arg) else
    while arg<=ArgsOutLast do
      if Args[arg].ValueDirection in [smdVar,smdOut,smdResult] then
        exit else
        inc(arg);
  result := false;
end;

function TServiceMethod.ArgsArrayToObject(P: PUTF8Char; Input: boolean): RawUTF8;
var i: integer;
    W: TTextWriter;
    Value: PUTF8Char;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    W.Add('{');
    if (P=nil) or (P^<>'[') then
      P := nil else
      inc(P);
    for i := 1 to length(Args)-1 do
    if P=nil then
      break else
      with Args[i] do begin
        if Input then begin
          if ValueDirection in [smdOut,smdResult] then
            continue;
        end else
          if ValueDirection=smdConst then
            continue;
        W.AddPropName(ParamName^);
        P := GotoNextNotSpace(P);
        Value := P;
        P := GotoEndJSONItem(P);
        if P^=',' then
          inc(P); // include ending ','
        W.AddNoJsonEscape(Value,P-Value);
      end;
    W.CancelLastComma;
    W.Add('}');
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TServiceMethod.ArgsCommandLineToObject(P: PUTF8Char;
  Input, RaiseExceptionOnUnknownParam: boolean): RawUTF8;
var i: integer;
    W: TTextWriter;
    B: PUTF8Char;
    arginfo: PServiceMethodArgument;
    arg, value: RawUTF8;
    ok: boolean;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    W.Add('{');
    while (P<>nil) and GetNextFieldProp(P,arg) and (P<>nil) and (arg<>'') do begin
      ok := true;
      i := ArgIndex(pointer(arg),length(arg),Input);
      if i<0 then
        if RaiseExceptionOnUnknownParam then
          raise EServiceException.CreateUTF8('Unexpected [%] parameter for %',
            [arg,InterfaceDotMethodName]) else
          ok := false;
      arginfo := @Args[i];
      if ok then
        W.AddPropName(arginfo^.ParamName^);
      if not (P^ in [':','=']) then
        raise EServiceException.CreateUTF8('"%" parameter has no = for %',
          [arg,InterfaceDotMethodName]);
      P := GotoNextNotSpace(P+1);
      if P^ in ['"','[','{'] then begin // name='"value"' or name='{somejson}'
        B := P;
        P := GotoEndJSONItem(P);
        if P = nil then
          raise EServiceException.CreateUTF8('%= parameter has invalid content for %',
            [arg,InterfaceDotMethodName]);
        if not ok then
          continue;
        W.AddNoJSONEscape(B,P-B);
      end else begin // name=value
        GetNextItem(P,' ',value);
        if not ok then
          continue;
        if arginfo^.ValueType=smvDynArray then // write [value] or ["value"]
          W.Add('[');
        if arginfo^.ValueKindAsm*[vIsString,vIsDynArrayString]<>[] then
          W.AddJSONString(value) else
          W.AddNoJSONEscape(pointer(value),length(value));
        if arginfo^.ValueType=smvDynArray then
          W.Add(']');
      end;
      W.Add(',');
    end;
    W.CancelLastComma;
    W.Add('}');
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TServiceMethod.ArgsNames(Input: Boolean): TRawUTF8DynArray;
var a,n: integer;
begin
  result := nil;
  if Input then begin
    SetLength(result,ArgsInputValuesCount);
    n := 0;
    for a := ArgsInFirst to ArgsInLast do
      if Args[a].ValueDirection in [smdConst,smdVar] then begin
        ShortStringToAnsi7String(Args[a].ParamName^,result[n]);
        inc(n);
      end;
  end else begin
    SetLength(result,ArgsOutputValuesCount);
    n := 0;
    for a := ArgsOutFirst to ArgsOutLast do
      if Args[a].ValueDirection in [smdVar,smdOut,smdResult] then begin
        ShortStringToAnsi7String(Args[a].ParamName^,result[n]);
        inc(n);
      end;
  end;
end;

{$ifndef NOVARIANTS}

procedure TServiceMethod.ArgsStackAsDocVariant(const Values: TPPointerDynArray;
  out Dest: TDocVariantData; Input: Boolean);
var a: integer;
begin
  if Input then begin
    Dest.InitFast(ArgsInputValuesCount,dvObject);
    for a := ArgsInFirst to ArgsInLast do
      if Args[a].ValueDirection in [smdConst,smdVar] then
        Args[a].AddAsVariant(Dest,Values[a]);
  end else begin
    Dest.InitFast(ArgsOutputValuesCount,dvObject);
    for a := ArgsOutFirst to ArgsOutLast do
      if Args[a].ValueDirection in [smdVar,smdOut,smdResult] then
        Args[a].AddAsVariant(Dest,Values[a]);
  end;
end;

procedure TServiceMethod.ArgsValuesAsDocVariant(Kind: TServiceMethodParamsDocVariantKind;
  out Dest: TDocVariantData; const Values: TVariantDynArray; Input: boolean;
  Options: TDocVariantOptions);
begin
  case Kind of
  pdvObject, pdvObjectFixed: begin
    Dest.InitObjectFromVariants(ArgsNames(Input),Values,Options);
    if Kind=pdvObjectFixed then
      ArgsAsDocVariantFix(Dest,Input);
  end;
  pdvArray:
    Dest.InitArrayFromVariants(Values,Options);
  else
    Dest.Init(Options);
  end;
end;

procedure TServiceMethod.ArgsAsDocVariantObject(const ArgsParams: TDocVariantData;
  var ArgsObject: TDocVariantData; Input: boolean);
var a,n: integer;
begin
  if (ArgsParams.Count=0) or (ArgsParams.Kind<>dvArray) then
    exit;
  if ArgsObject.Kind=dvUndefined then
    ArgsObject.Init(ArgsParams.Options);
  ArgsObject.Capacity := ArgsObject.Count+ArgsParams.Count;
  n := 0;
  if Input then begin
    if ArgsParams.Count=integer(ArgsInputValuesCount) then
      for a := ArgsInFirst to ArgsInLast do
        if Args[a].ValueDirection in [smdConst,smdVar] then begin
          ArgsObject.AddValue(ShortStringToAnsi7String(Args[a].ParamName^),
            ArgsParams.Values[n]);
          inc(n);
        end;
  end else begin
    if ArgsParams.Count=integer(ArgsOutputValuesCount) then
      for a := ArgsOutFirst to ArgsOutLast do
        if Args[a].ValueDirection in [smdVar,smdOut,smdResult] then begin
          ArgsObject.AddValue(ShortStringToAnsi7String(Args[a].ParamName^),
            ArgsParams.Values[n]);
          inc(n);
        end;
  end;
end;

procedure TServiceMethod.ArgsAsDocVariantFix(var ArgsObject: TDocVariantData;
  Input: boolean);
var a,ndx: integer;
    doc: TDocVariantData;
begin
  if ArgsObject.Count>0 then
  case ArgsObject.Kind of
  dvObject:
  for a := 0 to ArgsObject.Count-1 do begin
    ndx := ArgIndex(pointer(ArgsObject.Names[a]),length(ArgsObject.Names[a]),Input);
    if ndx>=0 then
      Args[ndx].FixValue(ArgsObject.Values[a]);
  end;
  dvArray:
    if Input then begin
      if ArgsObject.Count<>integer(ArgsInputValuesCount) then
        exit;
      doc.Init(ArgsObject.Options);
      for a := ArgsInFirst to ArgsInLast do
        if Args[a].ValueDirection in [smdConst,smdVar] then
          Args[a].FixValueAndAddToObject(ArgsObject.Values[doc.Count],doc);
      ArgsObject := doc;
    end else begin
      if ArgsObject.Count<>integer(ArgsOutputValuesCount) then
        exit;
      doc.Init(ArgsObject.Options);
      for a := ArgsOutFirst to ArgsOutLast do
        if Args[a].ValueDirection in [smdVar,smdOut,smdResult] then
          Args[a].FixValueAndAddToObject(ArgsObject.Values[doc.Count],doc);
      ArgsObject := doc;
    end;
  end;
end;

{$endif NOVARIANTS}


{ TServiceMethodExecute }

constructor TServiceMethodExecute.Create(aMethod: PServiceMethod);
var a: integer;
begin
  with aMethod^ do begin
    if ArgsUsedCount[smvv64]>0 then
      SetLength(fInt64s,ArgsUsedCount[smvv64]);
    if ArgsUsedCount[smvvObject]>0 then
      SetLength(fObjects,ArgsUsedCount[smvvObject]);
    if ArgsUsedCount[smvvInterface]>0 then
      SetLength(fInterfaces,ArgsUsedCount[smvvInterface]);
    if ArgsUsedCount[smvvRecord]>0 then
      SetLength(fRecords,ArgsUsedCount[smvvRecord]);
    if ArgsUsedCount[smvvDynArray]>0 then
      SetLength(fDynArrays,ArgsUsedCount[smvvDynArray]);
    SetLength(fValues,length(Args));
    for a := ArgsManagedFirst to ArgsManagedLast do
    with Args[a] do
      case ValueType of
      smvDynArray:
        with fDynArrays[IndexVar] do
          Wrapper.InitFrom(DynArrayWrapper,Value);
      smvRecord:
        SetLength(fRecords[IndexVar],ArgTypeInfo^.RecordType^.Size);
      {$ifndef NOVARIANTS}
      smvVariant:
        SetLength(fRecords[IndexVar],SizeOf(Variant));
      {$endif}
      end;
  end;
  fMethod := aMethod;
end;

destructor TServiceMethodExecute.Destroy;
begin
  fTempTextWriter.Free;
  inherited Destroy;
end;

procedure TServiceMethodExecute.AddInterceptor(const Hook: TServiceMethodExecuteEvent);
begin
  MultiEventAdd(fOnExecute,TMethod(Hook));
end;

procedure TServiceMethodExecute.BeforeExecute;
var a: integer;
    Value: PPointer;
begin
  with fMethod^ do begin
    if ArgsUsedCount[smvvRawUTF8]>0 then
      SetLength(fRawUTF8s,ArgsUsedCount[smvvRawUTF8]);
    if ArgsUsedCount[smvvString]>0 then
      SetLength(fStrings,ArgsUsedCount[smvvString]);
    if ArgsUsedCount[smvvWideString]>0 then
      SetLength(fWideStrings,ArgsUsedCount[smvvWideString]);
    if fAlreadyExecuted then begin
      if ArgsUsedCount[smvvObject]>0 then
        FillCharFast(
          fObjects,ArgsUsedCount[smvvObject]*SizeOf(TObject),0);
      if ArgsUsedCount[smvv64]>0 then
        FillCharFast(fInt64s,ArgsUsedCount[smvv64]*SizeOf(Int64),0);
      if ArgsUsedCount[smvvInterface]>0 then
        FillCharFast(fInterfaces,ArgsUsedCount[smvvInterface]*SizeOf(pointer),0);
    end;
    Value := @fValues[1];
    for a := 1 to high(Args) do
    with Args[a] do begin
      case ValueVar of
      smvv64:
        Value^ := @fInt64s[IndexVar];
      smvvRawUTF8:
        Value^ := @fRawUTF8s[IndexVar];
      smvvString:
        Value^ := @fStrings[IndexVar];
      smvvWideString:
        Value^ := @fWideStrings[IndexVar];
      smvvObject: begin
        Value^ := @fObjects[IndexVar];
        PPointer(Value^)^ := ArgTypeInfo^.ClassCreate;
      end;
      smvvInterface:
        Value^ := @fInterfaces[IndexVar];
      smvvRecord: begin
        Value^ := pointer(fRecords[IndexVar]);
        if fAlreadyExecuted then
          FillCharFast(Value^^,ArgTypeInfo^.RecordType^.Size,0);
      end;
      smvvDynArray:
        Value^ := @fDynArrays[IndexVar].Value;
      else raise EInterfaceFactoryException.CreateUTF8('I%.%:% ValueType=%',
        [InterfaceDotMethodName,ParamName^,ArgTypeName^,ord(ValueType)]);
      end;
      inc(Value);
    end;
    if optInterceptInputOutput in Options then begin
      Input.InitFast(ArgsInputValuesCount,dvObject);
      Output.InitFast(ArgsOutputValuesCount,dvObject);
    end;
  end;
  fAlreadyExecuted := true;
end;

procedure TServiceMethodExecute.RawExecute(const Instances: PPointerArray;
  InstancesLast: integer);
var Value: pointer;
    a,i,e: integer;
    call: TCallMethodArgs;
    Stack: packed array[0..MAX_EXECSTACK-1] of byte;
begin
  FillCharFast(call,SizeOf(call),0);
  with fMethod^ do begin
    // create the stack and register content
    {$ifdef CPUX86}
    call.StackAddr := PtrInt(@Stack[0]);
    call.StackSize := ArgsSizeInStack;
    {$ifndef MSWINDOWS} // ensure always aligned by 16 bytes on POSIX
    while call.StackSize and 15<>0 do
      inc(call.StackSize,PTRSIZ); // needed for Darwin and Linux i386
    {$endif MSWINDOWS}
    {$else}
    {$ifdef CPUINTEL}
    call.StackSize := ArgsSizeInStack shr 3;
    // ensure stack aligned on 16 bytes (paranoid)
    if call.StackSize and 1 <> 0 then
      inc(call.StackSize);
    // stack is filled reversed (RTL)
    call.StackAddr := PtrInt(@Stack[call.StackSize*8-8]);
    {$else}
    // stack is filled normally (LTR)
    call.StackAddr := PtrInt(@Stack[0]);
    {$ifdef CPUAARCH64}
    call.StackSize := ArgsSizeInStack shr 3;
    // ensure stack aligned on 16 bytes (mandatory: needed for correct low level asm)
    if call.StackSize and 1 <> 0 then
      inc(call.StackSize);
    {$else}
    call.StackSize := ArgsSizeInStack shr 2;
    {$endif CPUAARCH64}
    {$endif CPUINTEL}
    {$endif CPUX86}
    for a := 1 to length(Args)-1 do
    with Args[a] do begin
      Value := fValues[a];
      if (ValueDirection<>smdConst) or
         (ValueType in [smvRecord{$ifndef NOVARIANTS},smvVariant{$endif}]) then begin
          // pass by reference
          if (RegisterIdent=0) and (FPRegisterIdent=0) and (SizeInStack>0) then
            MoveFast(Value,Stack[InStackOffset],SizeInStack) else begin
            if RegisterIdent>0 then
              call.ParamRegs[RegisterIdent] := PtrInt(Value);
            if FPRegisterIdent>0 then
              raise EInterfaceFactoryException.CreateUTF8('Unexpected % FPReg=%',
                [ParamName^,FPRegisterIdent]); // should never happen
          end;
        end
        else begin
          // pass by value
          if (RegisterIdent=0) AND (FPRegisterIdent=0) AND (SizeInStack>0) then
            MoveFast(Value^,Stack[InStackOffset],SizeInStack) else begin
            if (RegisterIdent>0) then begin
              call.ParamRegs[RegisterIdent] := PPtrInt(Value)^;
              {$ifdef CPUARM}
              // for e.g. INT64 on 32-bit ARM systems; these are also passed in the normal registers
              if SizeInStack>PTRSIZ then
                call.ParamRegs[RegisterIdent+1] := PPtrInt(Value+PTRSIZ)^;
              {$endif}
            end;
            {$ifndef CPUX86}
            if FPRegisterIdent>0 then
              call.FPRegs[FPRegisterIdent] := unaligned(PDouble(Value)^);
            {$endif}
            if (RegisterIdent>0) and (FPRegisterIdent>0) then
              raise EInterfaceFactoryException.CreateUTF8('Unexpected % reg=% FP=%',
                [ParamName^,RegisterIdent,FPRegisterIdent]); // should never happen
          end;
        end;
    end;
    // execute the method
    for i := 0 to InstancesLast do begin
      // handle method execution interception
      fCurrentStep := smsBefore;
      if fOnExecute<>nil then begin
        if (Input.Count=0) and (optInterceptInputOutput in Options) then
          ArgsStackAsDocVariant(fValues,fInput,true);
        for e := 0 to length(fOnExecute)-1 do
        try
          fOnExecute[e](self,smsBefore);
        except // ignore any exception during interception
        end;
      end;
      // prepare the low-level call context for the asm stub
      //Pass the Self (also named $this)
      call.ParamRegs[PARAMREG_FIRST] := PtrInt(Instances[i]);
      call.method := PPtrIntArray(PPointer(Instances[i])^)^[ExecutionMethodIndex];
      if ArgsResultIndex>=0 then
        call.resKind := Args[ArgsResultIndex].ValueType else
        call.resKind := smvNone;
      // launch the asm stub in the expected execution context
      try
        {$ifndef LVCL}
        if (optExecInMainThread in Options) and
           (GetCurrentThreadID<>MainThreadID) then
          BackgroundExecuteCallMethod(@call,nil) else
        {$endif}
        if optExecInPerInterfaceThread in Options then
          if Assigned(BackgroundExecutionThread) then
            BackgroundExecuteCallMethod(@call,BackgroundExecutionThread) else
            raise EInterfaceFactoryException.Create('optExecInPerInterfaceThread'+
              ' with BackgroundExecutionThread=nil') else
          CallMethod(call);
        if (ArgsResultIndex>=0) and (Args[ArgsResultIndex].ValueVar=smvv64) then
          PInt64Rec(fValues[ArgsResultIndex])^ := call.res64;
        // handle method execution interception
        fCurrentStep := smsAfter;
        if fOnExecute<>nil then begin
          if (Output.Count=0) and (optInterceptInputOutput in Options) then
            ArgsStackAsDocVariant(fValues,fOutput,false);
          for e := 0 to length(fOnExecute)-1 do
          try
            fOnExecute[e](self,smsAfter);
          except // ignore any exception during interception
          end;
        end;
      except // also intercept any error during method execution
        on Exc: Exception do begin
          fCurrentStep := smsError;
          if fOnExecute<>nil then begin
            fLastException := Exc;
            for e := 0 to length(fOnExecute)-1 do
            try
              fOnExecute[e](self,smsError);
            except // ignore any exception during interception
            end;
            fLastException := nil;
          end;
          if (InstancesLast=0) and not (optIgnoreException in Options) then
            raise; // single caller expects exception to be propagated
          if fExecutedInstancesFailed=nil then // multiple Instances[] execution
            SetLength(fExecutedInstancesFailed,InstancesLast+1);
          fExecutedInstancesFailed[i] := ObjectToJSONDebug(Exc);
        end;
      end;
    end;
  end;
end;

function TServiceMethodExecute.TempTextWriter: TJSONSerializer;
begin
  if fTempTextWriter=nil then begin
    fTempTextWriter := TJSONSerializer.CreateOwnedStream;
    fTempTextWriter.fCustomOptions := fTempTextWriter.fCustomOptions +
      [twoForceJSONExtended,twoIgnoreDefaultInRecord]; // shorter
  end;
  result := fTempTextWriter;
end;

procedure TServiceMethodExecute.AfterExecute;
var i,a: integer;
begin
  Finalize(fRawUTF8s);
  Finalize(fStrings);
  Finalize(fWideStrings);
  with fMethod^ do
  if ArgsManagedFirst>=0 then begin
    for i := 0 to ArgsUsedCount[smvvObject]-1 do
      fObjects[i].Free;
    for i := 0 to ArgsUsedCount[smvvInterface]-1 do
      IUnknown(fInterfaces[i]) := nil;
    for i := 0 to ArgsUsedCount[smvvDynArray]-1 do
      fDynArrays[i].Wrapper.Clear; // will handle T*ObjArray, and set Value^=nil
    if fRecords<>nil then begin
      i := 0;
      for a := ArgsManagedFirst to ArgsManagedLast do
      with Args[a] do
      case ValueType of
      smvRecord: begin
        RecordClear(fRecords[i][0],ArgTypeInfo);
        inc(i);
      end;
      {$ifndef NOVARIANTS}
      smvVariant: begin
        VarClear(PVariant(fRecords[i])^); // fast, even for simple types
        inc(i);
      end;
      {$endif}
      end;
    end;
  end;
end;

function TServiceMethodExecute.ExecuteJsonCallback(Instance: pointer;
  const params: RawUTF8; output: PRawUTF8): boolean;
var tmp: TSynTempBuffer;
    fake: TInterfacedObjectFake;
    WR: TTextWriter;
    n: integer;
begin
  result := false;
  if Instance=nil then
    exit;
  if (PCardinal(PPointer(PPointer(Instance)^)^)^=
      PCardinal(@TInterfacedObjectFake.FakeQueryInterface)^) then begin
    fake := TInterfacedObjectFake(Instance).SelfFromInterface;
    if Assigned(fake.fInvoke) then begin
      // call SOA/fake interface? -> bypass all JSON marshalling
      if (output=nil) and (fMethod^.ArgsOutputValuesCount>0) then
        exit; // ensure a function has a TOnAsynchRedirectResult callback
      result := fake.fInvoke(fMethod^,params,output,nil,nil,nil);
      exit;
    end;
  end;
  n := length(params);
  tmp.Init(n+2);
  try
    PAnsiChar(tmp.buf)[0] := '[';
    MoveFast(pointer(params)^,PAnsiChar(tmp.buf)[1],n);
    PWord(PAnsiChar(tmp.buf)+n+1)^ := ord(']'); // ']'#0
    if output<>nil then begin
      WR := TempTextWriter;
      WR.CancelAll;
    end else
      if fMethod^.ArgsOutputValuesCount>0 then
        exit else // ensure a function has a TOnAsynchRedirectResult callback
        WR := nil;
    result := ExecuteJson([Instance],tmp.buf,WR);
    if WR<>nil then
      WR.SetText(output^);
  finally
    tmp.Done;
  end;
end;

function TServiceMethodExecute.ExecuteJsonFake(Instance: pointer; params: PUTF8Char): boolean;
var tmp: RawUTF8;
    len: integer;
begin
  result := false;
  if not Assigned(TInterfacedObjectFake(Instance).fInvoke) then
    exit;
  if params<>nil then begin
    if params^<>'[' then
      exit;
    inc(params);
    len := StrLen(params);
    if params[len-1]=']' then
      dec(len);
    FastSetString(tmp,params,len);
  end;
  result := TInterfacedObjectFake(Instance).fInvoke(fMethod^,tmp,nil,nil,nil,nil);
end;

function TServiceMethodExecute.ExecuteJson(const Instances: array of pointer;
  Par: PUTF8Char; Res: TTextWriter; Error: PShortString; ResAsJSONObject: boolean): boolean;
var a,a1: integer;
    Val, Name: PUTF8Char;
    NameLen: integer;
    EndOfObject: AnsiChar;
    opt: array[{smdVar=}boolean] of TTextWriterWriteObjectOptions;
    ParObjValuesUsed: boolean;
    ParObjValues: array[0..MAX_METHOD_ARGS-1] of PUTF8Char;
begin
  result := false;
  BeforeExecute;
  with fMethod^ do
  try
    // validate input parameters
    ParObjValuesUsed := false;
    if (ArgsInputValuesCount<>0) and (Par<>nil) then begin
      if Par^ in [#1..' '] then repeat inc(Par) until not(Par^ in [#1..' ']);
      case Par^ of
      '[': // input arguments as a JSON array , e.g. '[1,2,"three"]' (default)
        inc(Par);
      '{': begin // retrieve parameters values from JSON object
        repeat inc(Par) until not(Par^ in [#1..' ']);
        if Par<>'}' then begin
          ParObjValuesUsed := true;
          FillCharFast(ParObjValues,(ArgsInLast+1)*SizeOf(pointer),0); // := nil
          a1 := ArgsInFirst;
          repeat
            Name := GetJSONPropName(Par,@NameLen);
            if Name=nil then
              exit; // invalid JSON object in input
            Val := Par;
            Par := GotoNextJSONItem(Par,1,@EndOfObject);
            for a := a1 to ArgsInLast do
            with Args[a] do
            if ValueDirection<>smdOut then
              if IdemPropName(ParamName^,Name,NameLen) then begin
                ParObjValues[a] := Val; // fast redirection, without allocation
                if a=a1 then
                  inc(a1); // enable optimistic O(1) search for in-order input
                break;
              end;
          until (Par=nil) or (EndOfObject='}');
        end;
        Par := nil;
      end;
      else if PInteger(Par)^=NULL_LOW then
        Par := nil else
        exit; // only support JSON array or JSON object as input
      end;
    end;
    // decode input parameters (if any) in f*[]
    if (Par=nil) and not ParObjValuesUsed then begin
      if (ArgsInputValuesCount>0) and (optErrorOnMissingParam in Options) then
        exit; // paranoid setting
    end else
      for a := ArgsInFirst to ArgsInLast do
      with Args[a] do
      if ValueDirection<>smdOut then begin
        if ParObjValuesUsed then
          if ParObjValues[a]=nil then // missing parameter in input JSON
            if optErrorOnMissingParam in Options then
              exit else
              continue else // ignore and leave void value by default
            Par := ParObjValues[a] else // value to be retrieved from JSON object
          if Par=nil then
            break; // premature end of ..] (ParObjValuesUsed=false)
        case ValueType of
        smvInterface:
          if Assigned(OnCallback) then
            OnCallback(Par,ArgTypeInfo,fInterfaces[IndexVar]) else
            raise EInterfaceFactoryException.CreateUTF8('OnCallback=nil for %(%: %)',
              [InterfaceDotMethodName,ParamName^,ArgTypeName^]);
        smvDynArray: begin
          Par := fDynArrays[IndexVar].Wrapper.LoadFromJSON(Par);
          if Par=nil then
            exit;
          IgnoreComma(Par);
        end;
        else
          if not FromJSON(InterfaceDotMethodName,Par,fValues[a],Error
            {$ifndef NOVARIANTS},JSON_OPTIONS[optVariantCopiedByReference in Options]{$endif}) then
            exit;
        end;
      end;
    // execute the method, using prepared values in f*[]
    RawExecute(@Instances[0],high(Instances));
    // send back any result
    if Res<>nil then begin
      // handle custom content (not JSON array/object answer)
      if ArgsResultIsServiceCustomAnswer then
        with PServiceCustomAnswer(fValues[ArgsResultIndex])^ do
        if Header<>'' then begin
          fServiceCustomAnswerHead := Header;
          Res.ForceContent(Content);
          if Status=0 then // Values[]=@Records[] is filled with 0 by default
            fServiceCustomAnswerStatus := HTTP_SUCCESS else
            fServiceCustomAnswerStatus := Status;
          Result := true;
          exit;
        end;
      // write the '{"result":[...' array or object
      opt[{smdVar=}false] := DEFAULT_WRITEOPTIONS[optDontStoreVoidJSON in Options];
      opt[{smdVar=}true] := []; // let var params override void/default values
      for a := ArgsOutFirst to ArgsOutLast do
      with Args[a] do
      if ValueDirection in [smdVar,smdOut,smdResult] then begin
        if ResAsJSONObject then
          Res.AddPropName(ParamName^);
        case ValueType of
        smvDynArray: begin
          if vIsObjArray in ValueKindAsm then
            Res.AddObjArrayJSON(fValues[a]^,opt[ValueDirection=smdVar]) else
            Res.AddDynArrayJSON(fDynArrays[IndexVar].Wrapper);
          Res.Add(',');
        end;
        else AddJSON(Res,fValues[a],opt[ValueDirection=smdVar]);
        end;
      end;
      Res.CancelLastComma;
    end;
    Result := true;
  finally
    AfterExecute;
  end;
end;


{ TSQLRecordServiceLog }

class procedure TSQLRecordServiceLog.InitializeTable(
  Server: TSQLRestServer; const FieldName: RawUTF8;
  Options: TSQLInitializeTableOptions);
begin
  inherited;
  if FieldName='' then
    Server.CreateSQLMultiIndex(Self,['Method','MicroSec'],false);
end;


{ TSQLRecordServiceNotifications }

class procedure TSQLRecordServiceNotifications.InitializeTable(
  Server: TSQLRestServer; const FieldName: RawUTF8;
  Options: TSQLInitializeTableOptions);
begin
  inherited;
  if (FieldName='') or (FieldName='Sent') then
    Server.CreateSQLMultiIndex(Self,['Sent'],false);
end;

class function TSQLRecordServiceNotifications.LastEventsAsObjects(Rest: TSQLRest;
  LastKnownID: TID; Limit: integer; Service: TInterfaceFactory; out Dest: TDocVariantData;
  const MethodName: RawUTF8; IDAsHexa: boolean): boolean;
var res: TSQLRecordServiceNotifications;
begin
  res := CreateAndFillPrepare(Rest,'ID > ? order by ID limit %',[Limit],
    [LastKnownID],'ID,Method,Input');
  try
    if res.FillTable.RowCount > 0 then begin
      res.SaveFillInputsAsObjects(Service,Dest,MethodName,IDAsHexa);
      result := true;
    end else
      result := false;
  finally
    res.Free;
  end;
end;

function TSQLRecordServiceNotifications.SaveInputAsObject(Service: TInterfaceFactory;
  const MethodName: RawUTF8; IDAsHexa: boolean): variant;
var m: integer;
begin
  VarClear(result);
  with TDocVariantData(result) do
    if IDAsHexa then
      InitObject(['ID',Int64ToHex(fID),MethodName,Method],JSON_OPTIONS_FAST) else
      InitObject(['ID',fID,MethodName,Method],JSON_OPTIONS_FAST);
  m := Service.FindMethodIndex(Method);
  if m>=0 then
    Service.Methods[m].ArgsAsDocVariantObject(_Safe(fInput)^,TDocVariantData(result),true);
end;

procedure TSQLRecordServiceNotifications.SaveFillInputsAsObjects(Service: TInterfaceFactory;
  out Dest: TDocVariantData; const MethodName: RawUTF8; IDAsHexa: boolean);
begin
  Dest.InitFast(FillTable.RowCount,dvArray);
  while FillOne do
    Dest.AddItem(SaveInputAsObject(Service,MethodName,IDAsHexa));
end;


{ TServiceContainerClient }

function TServiceContainerClient.Info(aTypeInfo: PTypeInfo): TServiceFactory;
begin
  result := inherited Info(aTypeInfo);
  if (result=nil) and not fDisableAutoRegisterAsClientDriven then
    result := AddInterface(aTypeInfo,sicClientDriven);
end;

function TServiceContainerClient.CallBackUnRegister(const Callback: IInvokable): boolean;
begin
  if Assigned(Callback) then
    result := (fRest as TSQLRestClientURI).fFakeCallbacks.UnRegister(pointer(Callback)) else
    result := false;
end;


{ TInterfacedCallback }

constructor TInterfacedCallback.Create(aRest: TSQLRest; const aGUID: TGUID);
begin
  inherited Create;
  fRest := aRest;
  fInterface := aGUID;
end;

procedure TInterfacedCallback.CallbackRestUnregister;
var Obj: pointer; // to avoid unexpected (recursive) Destroy call
begin
  if (fRest<>nil) and (fRest.Services<>nil) and not IsNullGUID(fInterface) then
    if GetInterface(fInterface,Obj) then begin
      fRest.Services.CallBackUnRegister(IInvokable(Obj));
      dec(fRefCount); // GetInterface() did increase the refcount
      fRest := nil; // notify once
    end;
end;

destructor TInterfacedCallback.Destroy;
begin
  CallbackRestUnregister;
  inherited Destroy;
end;


{ TBlockingCallback }

constructor TBlockingCallback.Create(aTimeOutMs: integer;
   aRest: TSQLRest; const aGUID: TGUID);
begin
  inherited Create(aRest,aGUID);
  fProcess := TBlockingProcess.Create(aTimeOutMs,fSafe);
end;

destructor TBlockingCallback.Destroy;
begin
  FreeAndNil(fProcess);
  inherited Destroy;
end;

procedure TBlockingCallback.CallbackFinished(aRestForLog: TSQLRest;
  aServerUnregister: boolean);
begin
  if fProcess.NotifyFinished then begin
    {$ifdef WITHLOG}
    if aRestForLog<>nil then
      aRestForLog.LogClass.Add.Log(sllTrace,self);
    {$endif}
    if aServerUnregister then
      CallbackRestUnregister;
  end;
end;

function TBlockingCallback.WaitFor: TBlockingEvent;
begin
  result := fProcess.WaitFor;
end;

function TBlockingCallback.Reset: boolean;
begin
  result := fProcess.Reset;
end;

function TBlockingCallback.GetEvent: TBlockingEvent;
begin
  result := fProcess.Event;
end;


{ TServiceRecordVersionCallback }

constructor TServiceRecordVersionCallback.Create(aSlave: TSQLRestServer;
  aMaster: TSQLRestClientURI; aTable: TSQLRecordClass; aOnNotify: TOnBatchWrite);
begin
  if aSlave=nil then
    raise EServiceException.CreateUTF8('%.Create(%): Slave=nil',[self,aTable]);
  fSlave := aSlave;
  fRecordVersionField := aTable.RecordProps.RecordVersionField;
  if fRecordVersionField=nil then
    raise EServiceException.CreateUTF8('%.Create: % has no TRecordVersion field',
      [self,aTable]);
  fTableDeletedIDOffset := Int64(fSlave.Model.GetTableIndexExisting(aTable))
    shl SQLRECORDVERSION_DELETEID_SHIFT;
  inherited Create(aMaster,IServiceRecordVersionCallback);
  fTable := aTable;
  fOnNotify := aOnNotify;
end;

procedure TServiceRecordVersionCallback.SetCurrentRevision(
  const Revision: TRecordVersion; Event: TSQLOccasion);
begin
  if (Revision<fSlave.fRecordVersionMax) or
     ((Revision=fSlave.fRecordVersionMax) and (Event<>soInsert)) then
    raise EServiceException.CreateUTF8('%.SetCurrentRevision(%) on %: previous was %',
      [self,Revision,fTable,fSlave.fRecordVersionMax]);
  fSlave.fRecordVersionMax := Revision;
end;

procedure TServiceRecordVersionCallback.Added(const NewContent: RawJSON);
var rec: TSQLRecord;
    fields: TSQLFieldBits;
begin
  rec := fTable.Create;
  try
    rec.FillFrom(NewContent,@fields);
    if fBatch=nil then
      fSlave.Add(rec,true,true,true) else
      fBatch.Add(rec,true,true,fields,true);
    SetCurrentRevision(fRecordVersionField.PropInfo.GetInt64Prop(rec),soInsert);
    if Assigned(fOnNotify) then
      fOnNotify(fBatch,soInsert,fTable,rec.IDValue,rec,fields);
  finally
    rec.Free;
  end;
end;

procedure TServiceRecordVersionCallback.Updated(const ModifiedContent: RawJSON);
var rec: TSQLRecord;
    fields: TSQLFieldBits;
begin
  rec := fTable.Create;
  try
    rec.FillFrom(ModifiedContent,@fields);
    if fBatch=nil then
      fSlave.Update(rec,fields,true) else
      fBatch.Update(rec,fields,true);
    SetCurrentRevision(fRecordVersionField.PropInfo.GetInt64Prop(rec),soUpdate);
    if Assigned(fOnNotify) then
      fOnNotify(fBatch,soUpdate,fTable,rec.IDValue,rec,fields);
  finally
    rec.Free;
  end;
end;

procedure TServiceRecordVersionCallback.Deleted(const ID: TID;
  const Revision: TRecordVersion);
var del: TSQLRecordTableDeleted;
begin
  del := TSQLRecordTableDeleted.Create;
  try
    del.IDValue := fTableDeletedIDOffset+Revision;
    del.Deleted := ID;
    if fBatch=nil then
    try
      fSlave.fAcquireExecution[execORMWrite].fSafe.Lock;
      fSlave.fRecordVersionDeleteIgnore := true;
      fSlave.Add(del,true,true,true);
      fSlave.Delete(fTable,ID);
    finally
      fSlave.fRecordVersionDeleteIgnore := false;
      fSlave.fAcquireExecution[execORMWrite].Safe.UnLock;
    end else begin
      fBatch.Add(del,true,true);
      fBatch.Delete(fTable,ID);
    end;
    SetCurrentRevision(Revision,soDelete);
    if Assigned(fOnNotify) then
      fOnNotify(fBatch,soDelete,fTable,ID,nil,[]);
  finally
    del.Free;
  end;
end;

procedure TServiceRecordVersionCallback.CurrentFrame(isLast: boolean);
procedure Error(const msg: RawUTF8);
begin
  fRest.InternalLog('%.CurrentFrame(%) on %: %',[self,isLast,fTable,msg],sllError);
end;
begin
  if isLast then begin
    if fBatch=nil then
      Error('unexpected last frame');
  end else
    if fBatch<>nil then
      Error('previous active BATCH -> send pending');
  if fBatch<>nil then
  try
    fSlave.fAcquireExecution[execORMWrite].fSafe.Lock;
    fSlave.fRecordVersionDeleteIgnore := true;
    fSlave.BatchSend(fBatch);
  finally
    fSlave.fRecordVersionDeleteIgnore := false;
    fSlave.fAcquireExecution[execORMWrite].Safe.UnLock;
    FreeAndNil(fBatch);
  end;
  if not isLast then
    fBatch := TSQLRestBatch.Create(fSlave,nil,10000);
end;

destructor TServiceRecordVersionCallback.Destroy;
var timeOut: Int64;
begin
  try
    if fBatch<>nil then begin
      timeOut := GetTickCount64+2000;
      repeat
        SleepHiRes(1); // allow 2 seconds to process all pending frames
        if fBatch=nil then
          exit;
      until GetTickCount64>timeOut;
      fSlave.InternalLog('%.Destroy on %: active BATCH',[self,fTable],sllError);
      fSlave.BatchSend(fBatch);
      fBatch.Free;
    end;
  finally
    inherited Destroy;
  end;
end;


{ TServiceFactoryClient }

function TServiceFactoryClient.CreateFakeInstance: TInterfacedObject;
var notify: TOnFakeInstanceDestroy;
    id: RawUTF8;
begin
  if fInstanceCreation=sicClientDriven then
    notify := NotifyInstanceDestroyed else
    notify := nil;
  result := TInterfacedObjectFakeClient.Create(self,Invoke,notify);
  if not fDelayedInstance and (fInstanceCreation=sicClientDriven) and
     InternalInvoke(SERVICE_PSEUDO_METHOD[imInstance],'',@id) then
    // thread-safe initialization of the fClientDrivenID
    TInterfacedObjectFakeClient(result).fClientDrivenID := GetCardinal(pointer(id));
end;

type
  TServiceFactoryClientNotificationThread = class(TSQLRestThread)
  protected
    fClient: TServiceFactoryClient;
    fRemote: TSQLRestClientURI;
    fRetryPeriodSeconds: Integer;
    procedure InternalExecute; override;
    procedure ProcessPendingNotification;
    function GetPendingCountFromDB: Int64;
  public
    constructor Create(aClient: TServiceFactoryClient; aRemote: TSQLRestClientURI;
      aRetryPeriodSeconds: Integer); reintroduce;
  end;

constructor TServiceFactoryClientNotificationThread.Create(
  aClient: TServiceFactoryClient; aRemote: TSQLRestClientURI; aRetryPeriodSeconds: Integer);
begin
  fClient := aClient; // cross-platform may run Execute as soon as Create is called
  if (fClient=nil) or (fClient.fSendNotificationsRest=nil) or
     (fClient.fSendNotificationsLogClass=nil) then
    raise EServiceException.CreateUTF8('%.Create(fClient.fSendNotifications=nil)',[self]);
  if aRetryPeriodSeconds<=0 then
    fRetryPeriodSeconds := 1 else
    fRetryPeriodSeconds := aRetryPeriodSeconds;
  if aRemote=nil then
    fRemote := fClient.fClient else
    fRemote := aRemote;
  inherited Create(fClient.fClient,false,false);
end;

function TServiceFactoryClientNotificationThread.GetPendingCountFromDB: Int64;
begin
  if not fClient.fSendNotificationsRest.OneFieldValue(
      fClient.fSendNotificationsLogClass,'count(*)','Sent is null',[],[],result) then
    result := 0;
end;

procedure TServiceFactoryClientNotificationThread.ProcessPendingNotification;
var pending: TSQLRecordServiceNotifications;
    params,error: RawUTF8;
    client: cardinal;
    pendings,count: integer;
    timer: TPrecisionTimer;
begin // one at a time, since InternalInvoke() is the bottleneck
  pending := fClient.fSendNotificationsLogClass.Create(
    fClient.fSendNotificationsRest,'Sent is null order by id limit 1');
  try
    if pending.IDValue=0 then begin
      pendings := GetPendingCountFromDB;
      fSafe.LockedInt64[0] := pendings;
      if pendings=0 then
        exit else
        raise EServiceException.CreateUTF8(
          '%.ProcessPendingNotification pending=% with no DB row',[self,pendings]);
    end;
    pendings := fSafe.LockedInt64[0];
    timer.Start;
    VariantSaveJson(pending.Input,twJSONEscape,params);
    if (params<>'') and (params[1]='[') then
      params := copy(params,2,length(params)-2); // trim [..] for URI call
    client := pending.Session;
    if not fClient.InternalInvoke(pending.Method,params,nil,@error,@client,nil,fRemote) then begin
      if _Safe(pending.fOutput)^.GetAsInteger('errorcount',count) then
        inc(count) else
        count := 1;
      VarClear(pending.fOutput);
      TDocVariantData(pending.fOutput).InitObject(['errorcount',count,
        'lasterror',error,'lasttime',NowUTCToString(true,'T'),
        'lastelapsed',timer.Stop],JSON_OPTIONS_FAST_EXTENDED);
      fClient.fSendNotificationsRest.Update(pending,'Output',true);
      raise EServiceException.CreateUTF8(
        '%.ProcessPendingNotification failed for %(%) [ID=%,pending=%] on %: %',
        [self,pending.Method,params,pending.IDValue,pendings,fRemote,error]);
    end;
    fClient.fClient.InternalLog('ProcessPendingNotification %(%) in % [ID=%,pending=%]',
      [pending.Method,params,timer.Stop,pending.IDValue,pendings]);
    pending.Sent := TimeLogNowUTC;
    pending.MicroSec := timer.LastTimeInMicroSec;
    fClient.fSendNotificationsRest.Update(pending,'MicroSec,Sent',true);
    fSafe.LockedInt64Increment(0,-1);
  finally
    pending.Free;
  end;
end;

procedure TServiceFactoryClientNotificationThread.InternalExecute;
var delay: integer;
begin
  fSafe.LockedInt64[0] := GetPendingCountFromDB;
  delay := 50;
  while not Terminated do begin
    while fSafe.LockedInt64[0]>0 do
    try
      ProcessPendingNotification;
      delay := 0;
      if Terminated then
        exit;
    except
      SleepOrTerminated(fRetryPeriodSeconds*1000); // wait before retry
    end;
    if Terminated then
      exit;
    if delay<50 then
      inc(delay);
    SleepHiRes(delay);
  end;
end;

function TServiceFactoryClient.Invoke(const aMethod: TServiceMethod;
  const aParams: RawUTF8; aResult: PRawUTF8; aErrorMsg: PRawUTF8;
  aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer): boolean;
  procedure SendNotificationsLog;
  var pending: TSQLRecordServiceNotifications;
      json: RawUTF8;
  begin
    pending := fSendNotificationsLogClass.Create;
    try
      pending.Method := aMethod.URI;
      json := '['+aParams+']';
      TDocVariantData(pending.fInput).InitJSONInPlace(pointer(json),JSON_OPTIONS_FAST_EXTENDED);
      if (aClientDrivenID<>nil) and (aClientDrivenID^<>0) then begin
        pending.Session := aClientDrivenID^;
        fSendNotificationsRest.Add(pending,'Method,Input,Session');
      end else
        fSendNotificationsRest.Add(pending,'Method,Input');
    finally
      pending.Free;
    end;
  end;
begin
  if (fSendNotificationsRest<>nil) and (aMethod.ArgsOutputValuesCount=0) then begin
    SendNotificationsLog;
    if fSendNotificationsThread<>nil then
      TServiceFactoryClientNotificationThread(fSendNotificationsThread).
        Safe.LockedInt64Increment(0,1);
    result := true;
  end else
    result := InternalInvoke(
      aMethod.URI,aParams,aResult,aErrorMsg,aClientDrivenID,aServiceCustomAnswer);
end;

class function TServiceFactoryClient.GetErrorMessage(status: integer): RawUTF8;
begin
  case status of
    HTTP_UNAVAILABLE: result := 'Check the communication parameters and network config';
    HTTP_NOTIMPLEMENTED: result := 'Server not reachable or broken connection';
    HTTP_NOTALLOWED: result := 'Method forbidden for this User group';
    HTTP_UNAUTHORIZED: result := 'No active session';
    HTTP_FORBIDDEN: result := 'Security error';
    HTTP_NOTACCEPTABLE: result := 'Invalid input parameters';
    HTTP_NOTFOUND: result := 'Network problem or request timeout';
    else result := '';
  end;
end;

function TServiceFactoryClient.InternalInvoke(const aMethod: RawUTF8;
  const aParams: RawUTF8; aResult: PRawUTF8; aErrorMsg: PRawUTF8;
  aClientDrivenID: PCardinal; aServiceCustomAnswer: PServiceCustomAnswer;
  aClient: TSQLRestClientURI): boolean;
var baseuri,uri,sent,resp,clientDrivenID,head,error,ct: RawUTF8;
    Values: array[0..1] of TValuePUTF8Char;
    status,m: integer;
    service: PServiceMethod;
    ctxt: TSQLRestServerURIContextClientInvoke;
    withinput: boolean;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    p: RawUTF8;
    {$endif}
  procedure DoClientCall;
  begin
    uri := baseuri;
    fRest.ServicesRouting.ClientSideInvoke(uri,ctxt,aMethod,aParams,clientDrivenID,sent,head);
    if service<>nil then begin // ParamsAsJSONObject won't apply to _signature_ e.g.
      if fParamsAsJSONObject and (clientDrivenID='') then
        sent := service^.ArgsArrayToObject(Pointer(sent),true);
      if fNonBlockWithoutAnswer and (head='') and (Service^.ArgsOutputValuesCount=0) then
        aClient.CallbackNonBlockingSetHeader(head);
    end;
    status := aClient.URI(uri,'POST',@resp,@head,@sent).Lo;
  end;
begin
  result := false;
  if Self=nil then
    exit;
  if fClient=nil then
    fClient := fRest as TSQLRestClientURI;
  if aClient=nil then
    aClient := fClient;
  if (aClientDrivenID<>nil) and (aClientDrivenID^>0) then
    UInt32ToUTF8(aClientDrivenID^,clientDrivenID);
  m := fInterface.FindMethodIndex(aMethod);
  if m<0 then
    service := nil else
    service := @fInterface.Methods[m];
  withinput := ((service=nil) or ([smdConst,smdVar]*service^.HasSPIParams=[])) and
    not(optNoLogInput in fExecution[m].Options);
  {$ifdef WITHLOG}
  if withinput then
    p := aParams; // include non-sensitive input in log
  log := fRest.LogClass.Enter('InternalInvoke I%.%(%) %',
    [fInterfaceURI,aMethod,p,clientDrivenID],self);
  {$endif}
  // call remote server according to current routing scheme
  if fForcedURI<>'' then
    baseuri := fForcedURI else
    if fRest.Services.ExpectMangledURI then
      baseuri := aClient.Model.Root+'/'+fInterfaceMangledURI else
      baseuri := aClient.Model.Root+'/'+fInterfaceURI;
  ctxt := [];
  if (service<>nil) and not ParamsAsJSONObject and service^.ArgsInputIsOctetStream then
    include(ctxt,csiAsOctetStream);
  DoClientCall;
  if (status=HTTP_UNAUTHORIZED) and (clientDrivenID<>'') and
     (fInstanceCreation=sicClientDriven) and (aClientDrivenID<>nil) then begin
    {$ifdef WITHLOG}
    if log<>nil then
      log.Log(sllClient,'% -> try to recreate ClientDrivenID',[resp],self);
    {$endif}
    clientDrivenID := '';
    aClientDrivenID^ := 0;
    DoClientCall;
  end;
  // decode result
  if aServiceCustomAnswer=nil then begin
    // handle errors at REST level
    if not StatusCodeIsSuccess(status) then begin
      if aErrorMsg<>nil then begin
        if resp='' then begin
          StatusCodeToErrorMessage(status,resp);
          error := GetErrorMessage(status);
          if error<>'' then
            error := ' - '+error;
          if not withinput then
            sent := ''; // exclude sensitive input in error text
          aErrorMsg^ := FormatUTF8('URI % % returned status ''%'' (%%)',
            [uri,sent,resp,status,error]);
        end else
          aErrorMsg^ := resp;
      end;
      exit; // leave result=false
    end;
    // decode JSON object
    {$ifdef WITHLOG}
    if (log<>nil) and (resp<>'') and not(optNoLogOutput in fExecution[m].Options) and
       ((service=nil) or ([smdConst,smdVar]*service^.HasSPIParams=[])) then
      with fRest.fLogFamily do
        if sllServiceReturn in Level then
          log.Log(sllServiceReturn,resp,self,MAX_SIZE_RESPONSE_LOG);
    {$endif WITHLOG}
    if fResultAsJSONObject then begin
      if aResult<>nil then
        aResult^ := resp;
      if aClientDrivenID<>nil then
        aClientDrivenID^ := 0;
    end else
    if (resp<>'') and (aClientDrivenID=nil) and
       not IdemPChar(GotoNextNotSpace(pointer(resp)),'{"RESULT":') then begin
      if aResult<>nil then
        aResult^ := resp; // e.g. when client retrieves the contract
    end else begin
      if (JSONDecode(pointer(resp),['result','id'],@Values,true)=nil) or
         (Values[0].Value=nil) then begin // no "result":... layout
        if aErrorMsg<>nil then begin
          UniqueRawUTF8ZeroToTilde(resp,1 shl 10);
          aErrorMsg^ := 'Invalid returned JSON content: expects {result:...}, got '+resp;
        end;
        exit; // leave result=false
      end;
      if aResult<>nil then
        Values[0].ToUTF8(aResult^);
      if (aClientDrivenID<>nil) and (Values[1].Value<>nil) then // keep ID if no "id":...
        aClientDrivenID^ := Values[1].ToCardinal;
    end;
  end else begin
    // custom answer returned in TServiceCustomAnswer
    {$ifdef WITHLOG}
    if (log<>nil) and (resp<>'') then
      with fRest.fLogFamily do
        if sllServiceReturn in Level then begin
          FindNameValue(head,HEADER_CONTENT_TYPE_UPPER,ct);
          if (resp[1] in ['[','{','"']) and IdemPChar(pointer(ct), JSON_CONTENT_TYPE_UPPER) then
            log.Log(sllServiceReturn,resp,self,MAX_SIZE_RESPONSE_LOG) else
            log.Log(sllServiceReturn,'TServiceCustomAnswer=% % len=% %',
              [status,ct,length(resp),EscapeToShort(resp)],self);
        end;
    {$endif WITHLOG}
    aServiceCustomAnswer^.Status := status;
    aServiceCustomAnswer^.Header := head;
    aServiceCustomAnswer^.Content := resp;
    // no "id" field returned, but aClientDrivenID^ should not change
  end;
  result := true;
end;

procedure TServiceFactoryClient.NotifyInstanceDestroyed(aClientDrivenID: cardinal);
begin
  if aClientDrivenID<>0 then
    InternalInvoke(SERVICE_PSEUDO_METHOD[imFree],'',nil,nil,@aClientDrivenID);
end;

constructor TServiceFactoryClient.Create(aRest: TSQLRest;
  aInterface: PTypeInfo; aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8);
var Error, RemoteContract: RawUTF8;
begin
  // extract interface RTTI and create fake interface (and any shared instance)
  if not aRest.InheritsFrom(TSQLRestClientURI) then
    EServiceException.CreateUTF8('%.Create(): % interface needs a Client connection',
      [self,aInterface^.Name]);
  if fClient=nil then
    fClient := TSQLRestClientURI(aRest);
  inherited Create(aRest,aInterface,aInstanceCreation,aContractExpected);
  // initialize a shared instance (if needed)
  case fInstanceCreation of
  sicShared,sicPerSession,sicPerUser,sicPerGroup,sicPerThread: begin
    // the instance shall remain active during the whole client session
    fSharedInstance := CreateFakeInstance;
    TInterfacedObjectFake(fSharedInstance)._AddRef; // force stay alive
  end;
  end;
  // check if this interface is supported on the server
  if PosEx(SERVICE_CONTRACT_NONE_EXPECTED,ContractExpected)=0 then begin
    if not InternalInvoke(SERVICE_PSEUDO_METHOD[imContract],
       TSQLRestClientURI(fRest).fServicePublishOwnInterfaces,@RemoteContract,@Error) then
      raise EServiceException.CreateUTF8('%.Create(): I% interface or % routing not '+
        'supported by server [%]',[self,fInterfaceURI,fRest.ServicesRouting,Error]);
    if ('['+ContractExpected+']'<>RemoteContract) and
       ('{"contract":'+ContractExpected+'}'<>RemoteContract) then
      raise EServiceException.CreateUTF8('%.Create(): server''s I% contract '+
        'differs from client''s: expected [%], received % - you may need to '+
        'upgrade your % client to match % server expectations',
        [self,fInterfaceURI,ContractExpected,RemoteContract,
         ExeVersion.Version.DetailedOrVoid,fClient.fSessionVersion]);
  end;
end;

destructor TServiceFactoryClient.Destroy;
begin
  FreeAndNil(fSendNotificationsThread);
  if fSharedInstance<>nil then
  with TInterfacedObjectFake(fSharedInstance) do
    if fRefCount<>1 then
      raise EServiceException.CreateUTF8('%.Destroy with RefCount=%: you must release '+
        'I% interface (setting := nil) before Client.Free',[self,fRefCount,fInterfaceURI]) else
      _Release; // bonne nuit les petits
  inherited;
end;

function TServiceFactoryClient.RetrieveSignature: RawUTF8;
begin
  result := '';
  if InternalInvoke(SERVICE_PSEUDO_METHOD[imSignature],'',@result) and
     (result<>'') then
    if result[1]='[' then
      result := copy(result,2,length(result)-2) else
    if IdemPChar(pointer(result),'{"SIGNATURE":') then
      result := copy(result,14,length(result)-14);
end;

function TServiceFactoryClient.Get(out Obj): Boolean;
var O: TInterfacedObjectFake;
begin
  result := false;
  if Self=nil then
    exit;
  case fInstanceCreation of
  sicShared, sicPerSession, sicPerUser, sicPerGroup, sicPerThread:
    O := TInterfacedObjectFake(fSharedInstance);
  sicSingle, sicClientDriven:
    O := TInterfacedObjectFake(CreateFakeInstance);
  else exit;
  end;
  if O=nil then
    exit;
  pointer(Obj) := @O.fVTable;
  O._AddRef;
  result := true;
end;

procedure TServiceFactoryClient.StoreNotifications(aRest: TSQLRest;
  aLogClass: TSQLRecordServiceNotificationsClass);
var c: TClass;
begin
  if (aRest=fSendNotificationsRest) and (aLogClass=fSendNotificationsLogClass) then
    exit;
  fSendNotificationsRest := aRest;
  fSendNotificationsLogClass := aLogClass;
  if aRest=nil then
    c := nil else
    c := aRest.ClassType;
  fClient.InternalLog('%.StoreNotifications(%,%) for I%',
    [ClassType,c,aLogClass,fInterfaceURI]);
end;

procedure TServiceFactoryClient.SendNotifications(aRest: TSQLRest;
  aLogClass: TSQLRecordServiceNotificationsClass;
  aRetryPeriodSeconds: Integer; aRemote: TSQLRestClientURI);
begin
  if (self=nil) or (aRest=nil) or (aLogClass=nil) then
    raise EServiceException.CreateUTF8('%.SendNotifications invalid call',[self]);
  if fSendNotificationsThread<>nil then
    if (aRest=fSendNotificationsRest) and (aLogClass=fSendNotificationsLogClass) then begin
      fClient.InternalLog('%.SendNotifications(%,%) I% twice -> ignored',
        [ClassType,aRest.ClassType,aLogClass,fInterfaceURI],sllInfo);
      exit;
    end else
      raise EServiceException.CreateUTF8('%.SendNotifications twice',[self]);
  StoreNotifications(aRest,aLogClass);
  fSendNotificationsThread :=
    TServiceFactoryClientNotificationThread.Create(self,aRemote,aRetryPeriodSeconds);
end;

function TServiceFactoryClient.SendNotificationsPending: integer;
begin
  if (self=nil) or (fSendNotificationsThread=nil) then
    result := 0 else
    result := TServiceFactoryClientNotificationThread(fSendNotificationsThread).
      GetPendingCountFromDB;
end;

procedure TServiceFactoryClient.SendNotificationsWait(aTimeOutSeconds: integer);
var timeOut: Int64;
    {$ifdef WITHLOG}
    log: ISynLog; // for Enter auto-leave to work with FPC
    {$endif}
begin
  if SendNotificationsPending=0 then
    exit;
  {$ifdef WITHLOG}
  log := fClient.LogClass.Enter;
  {$endif}
  timeOut := GetTickCount64+aTimeOutSeconds*1000;
  repeat
    SleepHiRes(5);
    if SendNotificationsPending=0 then
      exit;
  until GetTickCount64>timeOut;
end;

procedure TServiceFactoryClient.SetOptions(const aMethod: array of RawUTF8;
  aOptions: TServiceMethodOptions; aAction: TServiceMethodOptionsAction);
var o: TServiceMethodOption;
begin
  for o := low(o) to high(o) do
    if (o in aOptions) and not (o in [optNoLogInput..optErrorOnMissingParam]) then
      raise EServiceException.CreateUTF8('%.SetOptions(%) not supported',
        [self,GetEnumName(TypeInfo(TServiceMethodOption),ord(o))^]);
  ExecutionAction(aMethod,aOptions,aAction);
end;

function ObjectFromInterface(const aValue: IInterface): TObject;
{$ifndef HASINTERFACEASTOBJECT}
type
  TObjectFromInterfaceStub = packed record
    Stub: cardinal;
    case integer of
    0: (ShortJmp: shortint);
    1: (LongJmp:  longint)
  end;
  PObjectFromInterfaceStub = ^TObjectFromInterfaceStub;
{$endif}
begin
  if aValue<>nil then
    {$ifdef HASINTERFACEASTOBJECT}
    result := aValue as TObject else // slower but always working
    {$else}
    with PObjectFromInterfaceStub(PPointer(PPointer(aValue)^)^)^ do
    case Stub of // address of VMT[0] entry, i.e. QueryInterface
      $04244483: begin
        result := pointer(PtrInt(aValue)+ShortJmp);
        exit;
      end;
      $04244481: begin
        result := pointer(PtrInt(aValue)+LongJmp);
        exit;
      end;
      else // recognize TInterfaceFactory.CreateFakeInstance() stub/mock
      if Stub=PCardinal(@TInterfacedObjectFake.FakeQueryInterface)^ then begin
        result := TInterfacedObjectFake(pointer(aValue)).SelfFromInterface;
        exit;
      end else begin
        result := nil;
        exit;
      end;
    end else
    {$endif}
    result := nil;
end;

function ObjectFromInterfaceImplements(const aValue: IInterface;
  const aInterface: TGUID): boolean;
var obj: TObject;
begin
  obj := ObjectFromInterface(aValue);
  if obj=nil then
    result := false else
    result := obj.GetInterfaceEntry(aInterface)<>nil;
end;

procedure SetWeak(aInterfaceField: PIInterface; const aValue: IInterface);
begin
  PPointer(aInterfaceField)^ := Pointer(aValue);
end;

type
  TSetWeakZeroInstance = class(TObjectListHashed)
  protected
    fInstance: TObject;
  public
    constructor Create(aObject: TObject; aReference: pointer);
    destructor Destroy; override;
    property Instance: TObject read fInstance;
  end;

  TSetWeakZeroClass = class(TObjectListPropertyHashed)
  protected
    fHookedFreeInstance: PtrUInt;
    fLock: TRTLCriticalSection;
    procedure HookedFreeInstance;
  public
    constructor Create(aClass: TClass);
    destructor Destroy; override;
    function Find(aObject: TObject): TSetWeakZeroInstance;
    function FindOrAdd(aObject: TObject; aReference: pointer): TSetWeakZeroInstance;
  end;


{ TSetWeakZeroInstance }

constructor TSetWeakZeroInstance.Create(aObject: TObject; aReference: pointer);
var wasAdded: boolean;
begin
  inherited Create(false);
  fInstance := aObject;
  Add(aReference,wasAdded);
  //assert(IndexOf(aReference)>=0);
end;

destructor TSetWeakZeroInstance.Destroy;
var i: integer;
begin
  for i := 0 to Count-1 do
    PPointer(List[i])^ := nil;
  inherited;
end;


{ TSetWeakZeroClass }

function WeakZeroClassSubProp(aObject: TObject): TObject;
begin
  result := TSetWeakZeroInstance(aObject).fInstance;
end;

constructor TSetWeakZeroClass.Create(aClass: TClass);
var PVMT: ^TObject;
    P: PPtrUInt;
begin
  inherited Create(@WeakZeroClassSubProp);
  PVMT := pointer(PtrInt(PtrUInt(aClass))+vmtAutoTable);
  if PVMT^=nil then begin
    EnterCriticalSection(vmtAutoTableLock); // protect from concurrent access
    try
      if PVMT^=nil then begin
        PatchCodePtrUInt(pointer(PVMT),PtrUInt(self),true); // LeaveUnprotected=true
        GarbageCollectorFreeAndNil(PVMT^,self); // set to nil at finalization
      end;
    finally
      LeaveCriticalSection(vmtAutoTableLock);
    end;
  end;
  if (PVMT^<>nil) and (PVMT^<>self) then
    if TClass(PPointer(PVMT^)^)=TSQLRecordProperties then
      GarbageCollectorFreeAndNil(  // set to nil at finalization
        TSQLRecordProperties(PVMT^).fWeakZeroClass,self) else
      raise EORMException.CreateUTF8('%.Create: %.AutoTable VMT entry already used',[self,aClass]);
  InitializeCriticalSection(fLock);
  EnterCriticalSection(fLock);
  {$WARN SYMBOL_DEPRECATED OFF}
  P := pointer(PtrInt(PtrUInt(aClass))+vmtFreeInstance);
  {$WARN SYMBOL_DEPRECATED ON}
  fHookedFreeInstance := P^;
  PatchCodePtrUInt(P,PtrUInt(@TSetWeakZeroClass.HookedFreeInstance));
end;

destructor TSetWeakZeroClass.Destroy;
begin
  DeleteCriticalSection(fLock);
  inherited;
end;

function EnterWeakZeroClass(aObject: TObject; CreateIfNonExisting: boolean): TSetWeakZeroClass;
 {$ifdef HASINLINENOTX86}inline;{$endif}
begin
  result := PPointer(PPtrInt(aObject)^+vmtAutoTable)^;
  if (result<>nil) and (TClass(PPointer(result)^)=TSQLRecordProperties) then
    result := TSetWeakZeroClass(TSQLRecordProperties(pointer(result)).fWeakZeroClass);
  if result<>nil then
    EnterCriticalSection(result.fLock) else
    if CreateIfNonExisting then
      result := TSetWeakZeroClass.Create(PPointer(aObject)^);
end;

type
  TSimpleMethodCall = procedure(self: TObject);

procedure TSetWeakZeroClass.HookedFreeInstance;
begin
  with EnterWeakZeroClass(self,false) do begin // if hooked -> never nil
    try
      Delete(self);
    finally
      LeaveCriticalSection(fLock);
    end;
    TSimpleMethodCall(fHookedFreeInstance)(self);
  end;
end;

function TSetWeakZeroClass.Find(aObject: TObject): TSetWeakZeroInstance;
var i: integer;
begin
  i := IndexOf(aObject); // search List[i].fInstance=aObject
  if i>=0 then
    result := TSetWeakZeroInstance(List[i]) else
    result := nil;
end;

function TSetWeakZeroClass.FindOrAdd(aObject: TObject; aReference: pointer): TSetWeakZeroInstance;
var wasAdded: boolean;
    i: integer;
begin
  i := inherited Add(aObject,wasAdded);
  if wasAdded then begin
    result := TSetWeakZeroInstance.Create(aObject,aReference);
    List[i] := result;
    //assert(IndexOf(aObject)>=0);
  end else begin
    result := TSetWeakZeroInstance(List[i]);
    result.Add(aReference,wasAdded);
  end;
  //assert(result.IndexOf(aReference)>=0);
  //assert(result.fInstance=aObject);
end;

procedure SetWeakZero(aObject: TObject; aObjectInterfaceField: PIInterface;
  const aValue: IInterface);
var aObjectWeakClass, aObjectInterfaceWeakClass: TSetWeakZeroClass;
    aObjectInterfaceObject, aValueObject: TObject;
begin
  if (aObjectInterfaceField=nil) or (aObject=nil) or (aObjectInterfaceField^=aValue) then
    exit;
  aObjectWeakClass := EnterWeakZeroClass(aObject,false);
  try
    if aObjectInterfaceField^<>nil then begin
      if aValue=nil then
        aObjectWeakClass.Delete(TObject(aObjectInterfaceField));
      aObjectInterfaceObject := ObjectFromInterface(aObjectInterfaceField^);
      if aObjectInterfaceObject<>nil then begin
        aObjectInterfaceWeakClass := EnterWeakZeroClass(aObjectInterfaceObject,false);
        if aObjectInterfaceWeakClass<>nil then
        try
          aObjectInterfaceWeakClass.Find(aObjectInterfaceObject).Delete(TObject(aObjectInterfaceField));
        finally
          LeaveCriticalSection(aObjectInterfaceWeakClass.fLock);
        end;
      end;
      SetWeak(aObjectInterfaceField,nil);
      if aValue=nil then
        exit;
    end;
    if aObjectWeakClass=nil then // for faster Delete() just above
      aObjectWeakClass := TSetWeakZeroClass.Create(PPointer(aObject)^);
    aObjectWeakClass.FindOrAdd(aObject,aObjectInterfaceField);
    aValueObject := ObjectFromInterface(aValue);
    if aValueObject<>nil then
      with EnterWeakZeroClass(aValueObject,true) do
      try
        FindOrAdd(aValueObject,aObjectInterfaceField);
      finally
        LeaveCriticalSection(fLock);
      end;
    SetWeak(aObjectInterfaceField,aValue);
  finally
    if aObjectWeakClass<>nil then
      LeaveCriticalSection(aObjectWeakClass.fLock);
  end;
end;

{$ifdef ISDELPHIXE}
procedure TWeakZeroInterfaceHelper.SetWeak0(aObjectInterfaceField: PIInterface;
  const aValue: IInterface);
begin
  SetWeakZero(self,aObjectInterfaceField,aValue);
end;
{$endif}

function ObjArraySearch(const aSQLRecordObjArray; aID: TID): TSQLRecord;
var i: integer;
    a: TSQLRecordObjArray absolute aSQLRecordObjArray;
    r: PSQLRecord;
begin
  r := pointer(a);
  for i := 1 to length(a) do begin
    result := r^;
    if result.fID=aID then
      exit;
    inc(r);
  end;
  result := nil;
end;

procedure ObjArrayRecordIDs(const aSQLRecordObjArray; out result: TInt64DynArray);
var
  i, n: PtrInt;
  a: TSQLRecordObjArray absolute aSQLRecordObjArray;
begin
  n := length(a);
  SetLength(result,n);
  for i := 0 to n-1 do
    result[i] := a[i].fID;
end;

procedure ObjArrayCopy(const aSourceObjArray; var aDestObjArray;
  aDestObjArrayClear: boolean);
var s: TObjectDynArray absolute aSourceObjArray;
    d: TObjectDynArray absolute aDestObjArray;
    slen,dlen: integer;
    i: PtrInt;
    dinst: TClassInstance;
    o: TObject;
begin
  if aDestObjArrayClear and (d<>nil) then
    ObjArrayClear(d);
  slen := length(s);
  if slen=0 then
    exit;
  dlen := length(d);
  SetLength(d,dlen+slen);
  DInst.ItemClass := nil;
  for i := 0 to slen-1 do
    if s[i]<>nil then begin // inlined CopyObject()
      if DInst.ItemClass<>PClass(s[i])^ then
        DInst.Init(PClass(s[i])^); // very unlikely to change
      o := DInst.CreateNew;
      CopyObject(s[i],o);
      d[dlen+i] := o;
    end;
end;

procedure InterfaceArrayDeleteAfterException(var aInterfaceArray;
  const aItemIndex: integer; aLog: TSynLogFamily; const aLogMsg: RawUTF8;
  aInstance: TObject);
begin
  try
    {$ifdef WITHLOG}
    aLog.SynLog.Log(sllWarning,'InterfaceArrayDeleteAfterException % (index=%)',
      [aLogMsg,aItemIndex],aInstance);
    {$endif}
    InterfaceArrayDelete(aInterfaceArray,aItemIndex);
  except
    on E: Exception do
      aLog.SynLog.Log(sllDebug,'Callback % unstability at deletion: %',
        [aLogMsg,E],aInstance);
  end;
end;

procedure SetThreadNameWithLog(ThreadID: TThreadID; const Name: RawUTF8);
begin
  {$ifdef WITHLOG}
  if (SetThreadNameLog<>nil) and (ThreadID=GetCurrentThreadId) then
    SetThreadNameLog.Add.LogThreadName(Name);
  {$endif}
  SetThreadNameDefault(ThreadID,Name);
end;

initialization
  pointer(@SQLFieldTypeComp[sftAnsiText]) := @AnsiIComp;
  pointer(@SQLFieldTypeComp[sftUTF8Custom]) := @AnsiIComp;
  pointer(@SQLFieldTypeComp[sftObject]) := @StrComp;
  {$ifndef NOVARIANTS}
  pointer(@SQLFieldTypeComp[sftVariant]) := @StrComp;
  pointer(@SQLFieldTypeComp[sftNullable]) := @StrComp;
  {$endif NOVARIANTS}
  {$ifndef USENORMTOUPPER}
  pointer(@SQLFieldTypeComp[sftUTF8Text]) := @AnsiIComp;
  {$endif}
  {$ifdef MSWINDOWS} // don't change the main process name under Linux
  SetThreadNameDefault(GetCurrentThreadID,'Main Thread');
  {$endif}
  SetThreadNameInternal := SetThreadNameWithLog;
  StatusCodeToErrorMessage := StatusCodeToErrorMsgBasic;
  GarbageCollectorFreeAndNil(JSONCustomParsers,TSynDictionary.Create(
    TypeInfo(TClassDynArray),TypeInfo(TJSONCustomParsers)));
  DefaultTextWriterSerializer := TJSONSerializer;
  TJSONSerializer.RegisterObjArrayForJSON(
    [TypeInfo(TSQLModelRecordPropertiesObjArray),TSQLModelRecordProperties]);
  TJSONSerializer.RegisterCustomJSONSerializerFromText(
    [TypeInfo(TServicesPublishedInterfaces),_TServicesPublishedInterfaces,
     TypeInfo(TSQLRestServerURI),_TSQLRestServerURI]);
  SynCommons.DynArrayIsObjArray := InternalIsObjArray;
  InitializeCriticalSection(GlobalInterfaceResolutionLock);
  InitializeCriticalSection(vmtAutoTableLock);
  TInterfaceResolverInjected.RegisterGlobal(TypeInfo(IAutoLocker),TAutoLocker);
  TInterfaceResolverInjected.RegisterGlobal(TypeInfo(ILockedDocVariant),TLockedDocVariant);
  assert(SizeOf(TServiceMethod)and 3=0,'wrong padding');
  AlgoDeflate := TAlgoDeflate.Create;
  AlgoDeflateFast := TAlgoDeflateFast.Create;
  TSQLRestServerFullMemory.RegisterClassNameForDefinition;
  {$ifdef MSWINDOWS}
  TSQLRestClientURINamedPipe.RegisterClassNameForDefinition;
  TSQLRestClientURIMessage.RegisterClassNameForDefinition;
  {$endif}
  {$ifdef GSSAPIAUTH}
  LoadGSSAPI;
  {$endif}

finalization
  FinalizeGlobalInterfaceResolution;
end.